X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FIO.hs;h=0179d8df5e19c531593e35cb4be1e45c1a14b2f3;hb=4b26136ab82fb1ff12e49477c4833a9586d368c5;hp=201bb226be6e75b3da79ff5ae0449cc7f55e82e8;hpb=9856777164f36906b953f3796eea0b8851100b01;p=haskell-directory.git

diff --git a/System/IO.hs b/System/IO.hs
index 201bb22..0179d8d 100644
--- a/System/IO.hs
+++ b/System/IO.hs
@@ -36,6 +36,7 @@ module System.IO (
 
     -- ** Opening files
 
+    withFile,
     openFile,		       -- :: FilePath -> IOMode -> IO Handle
     IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
 
@@ -144,18 +145,17 @@ module System.IO (
 
     -- * Binary input and output
 
+    withBinaryFile,
     openBinaryFile,	       -- :: FilePath -> IOMode -> IO Handle
     hSetBinaryMode,	       -- :: Handle -> Bool -> IO ()
-#if !defined(__NHC__)
     hPutBuf,		       -- :: Handle -> Ptr a -> Int -> IO ()
     hGetBuf,		       -- :: Handle -> Ptr a -> Int -> IO Int
-#endif
 #if !defined(__NHC__) && !defined(__HUGS__)
     hPutBufNonBlocking,	       -- :: Handle -> Ptr a -> Int -> IO Int
     hGetBufNonBlocking,	       -- :: Handle -> Ptr a -> Int -> IO Int
 #endif
 
-    -- * Temporary files
+    -- * Temporary files (not portable: GHC only)
 
 #ifdef __GLASGOW_HASKELL__
     openTempFile,
@@ -179,6 +179,7 @@ import Hugs.IO
 import Hugs.IOExts
 import Hugs.IORef
 import Hugs.Prelude	( throw, Exception(NonTermination) )
+import Control.Exception ( bracket )
 import System.IO.Unsafe	( unsafeInterleaveIO )
 #endif
 
@@ -214,11 +215,13 @@ import IO
   , hIsOpen, hIsClosed        -- :: Handle -> IO Bool
   , hIsReadable, hIsWritable  -- :: Handle -> IO Bool
   , hIsSeekable               -- :: Handle -> IO Bool
+  , bracket
 
   , IO ()
   , FilePath                  -- :: String
   )
-import NHC.IOExtras (fixIO)
+import NHC.IOExtras (fixIO, hPutBuf, hGetBuf)
+import NHC.FFI (Ptr)
 #endif
 
 -- -----------------------------------------------------------------------------
@@ -295,8 +298,7 @@ readFile name	=  openFile name ReadMode >>= hGetContents
 -- | The computation 'writeFile' @file str@ function writes the string @str@,
 -- to the file @file@.
 writeFile :: FilePath -> String -> IO ()
-writeFile f txt = bracket (openFile f WriteMode) hClose
-			  (\hdl -> hPutStr hdl txt) 
+writeFile f txt = withFile f WriteMode (\ hdl -> hPutStr hdl txt)
 
 -- | The computation 'appendFile' @file str@ function appends the string @str@,
 -- to the file @file@.
@@ -308,10 +310,7 @@ writeFile f txt = bracket (openFile f WriteMode) hClose
 -- > main = appendFile "squares" (show [(x,x*x) | x <- [0,0.1..2]])
 
 appendFile      :: FilePath -> String -> IO ()
-appendFile name str = do
-    hdl <- openFile name AppendMode
-    hPutStr hdl str
-    hClose hdl
+appendFile f txt = withFile f AppendMode (\ hdl -> hPutStr hdl txt)
 
 -- | The 'readLn' function combines 'getLine' and 'readIO'.
 
@@ -364,6 +363,20 @@ hPrint		:: Show a => Handle -> a -> IO ()
 hPrint hdl 	=  hPutStrLn hdl . show
 #endif /* !__NHC__ */
 
+-- | @'withFile' name mode act@ opens a file using 'openFile' and passes
+-- the resulting handle to the computation @act@.  The handle will be
+-- closed on exit from 'withFile', whether by normal termination or by
+-- raising an exception.
+withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
+withFile name mode = bracket (openFile name mode) hClose
+
+-- | @'withBinaryFile' name mode act@ opens a file using 'openBinaryFile'
+-- and passes the resulting handle to the computation @act@.  The handle
+-- will be closed on exit from 'withBinaryFile', whether by normal
+-- termination or by raising an exception.
+withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
+withBinaryFile name mode = bracket (openBinaryFile name mode) hClose
+
 -- ---------------------------------------------------------------------------
 -- fixIO
 
@@ -409,6 +422,7 @@ hSetBinaryMode _ _ = return ()
 -- -----------------------------------------------------------------------------
 -- Utils
 
+#ifdef __GLASGOW_HASKELL__
 -- Copied here to avoid recursive dependency with Control.Exception
 bracket 
 	:: IO a		-- ^ computation to run first (\"acquire resource\")
@@ -424,3 +438,4 @@ bracket before after thing =
     after a
     return r
  )
+#endif