From fb31e247cb0dea919824f5e3bd9086eef382e4bc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 9 Jun 2014 15:24:05 -0400 Subject: Avoid leaving behind .tmp files when failing in some cases, including importing files to a disk that is full. --- Utility/Tmp.hs | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) (limited to 'Utility/Tmp.hs') diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs index 0dc9f2c05..bed30bb4d 100644 --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -25,13 +25,20 @@ type Template = String - then moving it into place. The temp file is stored in the same - directory as the final file to avoid cross-device renames. -} viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO () -viaTmp a file content = do - let (dir, base) = splitFileName file - createDirectoryIfMissing True dir - (tmpfile, handle) <- openTempFile dir (base ++ ".tmp") - hClose handle - a tmpfile content - rename tmpfile file +viaTmp a file content = bracket setup cleanup use + where + (dir, base) = splitFileName file + template = base ++ ".tmp" + setup = do + createDirectoryIfMissing True dir + openTempFile dir template + cleanup (tmpfile, handle) = do + _ <- tryIO $ hClose handle + tryIO $ removeFile tmpfile + use (tmpfile, handle) = do + hClose handle + a tmpfile content + rename tmpfile file {- Runs an action with a tmp file located in the system's tmp directory - (or in "." if there is none) then removes the file. -} -- cgit v1.2.3