summaryrefslogtreecommitdiff
path: root/libraries
diff options
context:
space:
mode:
authorSimon Marlow <simonmar@microsoft.com>2006-05-04 08:45:05 +0000
committerSimon Marlow <simonmar@microsoft.com>2006-05-04 08:45:05 +0000
commit13ed68918315d8b4af25d396f157aa8f33bfdb30 (patch)
tree9cbd67eafdd906f3e7ecdb9e0cd1494830e47c94 /libraries
parent6d442b33e08f147818db1af0e9d6d89a6f48982d (diff)
downloadhaskell-13ed68918315d8b4af25d396f157aa8f33bfdb30.tar.gz
writeFile: close the file on error
Suggested by Ross Paterson, via Neil Mitchell
Diffstat (limited to 'libraries')
-rw-r--r--libraries/base/System/IO.hs28
1 files changed, 22 insertions, 6 deletions
diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs
index 5fd8ac50d8..201bb226be 100644
--- a/libraries/base/System/IO.hs
+++ b/libraries/base/System/IO.hs
@@ -294,12 +294,9 @@ 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 name str = do
- hdl <- openFile name WriteMode
- hPutStr hdl str
- hClose hdl
+writeFile :: FilePath -> String -> IO ()
+writeFile f txt = bracket (openFile f WriteMode) hClose
+ (\hdl -> hPutStr hdl txt)
-- | The computation 'appendFile' @file str@ function appends the string @str@,
-- to the file @file@.
@@ -408,3 +405,22 @@ hSetBinaryMode _ _ = return ()
-- It follows that an attempt to write to a file (using 'writeFile', for
-- example) that was earlier opened by 'readFile' will usually result in
-- failure with 'System.IO.Error.isAlreadyInUseError'.
+
+-- -----------------------------------------------------------------------------
+-- Utils
+
+-- Copied here to avoid recursive dependency with Control.Exception
+bracket
+ :: IO a -- ^ computation to run first (\"acquire resource\")
+ -> (a -> IO b) -- ^ computation to run last (\"release resource\")
+ -> (a -> IO c) -- ^ computation to run in-between
+ -> IO c -- returns the value from the in-between computation
+bracket before after thing =
+ block (do
+ a <- before
+ r <- catchException
+ (unblock (thing a))
+ (\e -> do { after a; throw e })
+ after a
+ return r
+ )