From c244daa32328f478bbf38a79f2fcacb138a1049f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 4 May 2022 11:40:38 -0400 Subject: merge from git-annex --- Utility/Tmp.hs | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) (limited to 'Utility/Tmp.hs') diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs index 5877f68..92bd921 100644 --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -14,6 +14,7 @@ module Utility.Tmp ( withTmpFile, withTmpFileIn, relatedTemplate, + openTmpFileIn, ) where import System.IO @@ -21,6 +22,7 @@ import System.FilePath import System.Directory import Control.Monad.IO.Class import System.PosixCompat.Files hiding (removeLink) +import System.IO.Error import Utility.Exception import Utility.FileSystemEncoding @@ -28,6 +30,18 @@ import Utility.FileMode type Template = String +{- This is the same as openTempFile, except when there is an + - error, it displays the template as well as the directory, + - to help identify what call was responsible. + -} +openTmpFileIn :: FilePath -> String -> IO (FilePath, Handle) +openTmpFileIn dir template = openTempFile dir template + `catchIO` decoraterrror + where + decoraterrror e = throwM $ + let loc = ioeGetLocation e ++ " template " ++ template + in annotateIOError e loc Nothing Nothing + {- Runs an action like writeFile, writing to a temp file first and - then moving it into place. The temp file is stored in the same - directory as the final file to avoid cross-device renames. @@ -43,7 +57,7 @@ viaTmp a file content = bracketIO setup cleanup use template = relatedTemplate (base ++ ".tmp") setup = do createDirectoryIfMissing True dir - openTempFile dir template + openTmpFileIn dir template cleanup (tmpfile, h) = do _ <- tryIO $ hClose h tryIO $ removeFile tmpfile @@ -73,7 +87,7 @@ withTmpFile template a = do withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath -> Handle -> m a) -> m a withTmpFileIn tmpdir template a = bracket create remove use where - create = liftIO $ openTempFile tmpdir template + create = liftIO $ openTmpFileIn tmpdir template remove (name, h) = liftIO $ do hClose h catchBoolIO (removeFile name >> return True) -- cgit v1.2.3