diff options
author | Simon Marlow <simonmar@microsoft.com> | 2006-05-04 08:45:05 +0000 |
---|---|---|
committer | Simon Marlow <simonmar@microsoft.com> | 2006-05-04 08:45:05 +0000 |
commit | 13ed68918315d8b4af25d396f157aa8f33bfdb30 (patch) | |
tree | 9cbd67eafdd906f3e7ecdb9e0cd1494830e47c94 /libraries | |
parent | 6d442b33e08f147818db1af0e9d6d89a6f48982d (diff) | |
download | haskell-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.hs | 28 |
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 + ) |