c784ef4586
Removed old extensible-exceptions, only needed for very old ghc. Made webdav use Utility.Exception, to work after some changes in DAV's exception handling. Removed Annex.Exception. Mostly this was trivial, but note that tryAnnex is replaced with tryNonAsync and catchAnnex replaced with catchNonAsync. In theory that could be a behavior change, since the former caught all exceptions, and the latter don't catch async exceptions. However, in practice, nothing in the Annex monad uses async exceptions. Grepping for throwTo and killThread only find stuff in the assistant, which does not seem related. Command.Add.undo is changed to accept a SomeException, and things that use it for rollback now catch non-async exceptions, rather than only IOExceptions.
107 lines
3.5 KiB
Haskell
107 lines
3.5 KiB
Haskell
{- Temporary files and directories.
|
|
-
|
|
- Copyright 2010-2013 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Utility.Tmp where
|
|
|
|
import System.IO
|
|
import System.Directory
|
|
import Control.Monad.IfElse
|
|
import System.FilePath
|
|
import Control.Monad.IO.Class
|
|
|
|
import Utility.Exception
|
|
import Utility.FileSystemEncoding
|
|
import Utility.PosixFiles
|
|
|
|
type Template = String
|
|
|
|
{- 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. -}
|
|
viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO ()
|
|
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, h) = do
|
|
_ <- tryIO $ hClose h
|
|
tryIO $ removeFile tmpfile
|
|
use (tmpfile, h) = do
|
|
hClose h
|
|
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. -}
|
|
withTmpFile :: (MonadIO m, MonadMask m) => Template -> (FilePath -> Handle -> m a) -> m a
|
|
withTmpFile template a = do
|
|
tmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
|
|
withTmpFileIn tmpdir template a
|
|
|
|
{- Runs an action with a tmp file located in the specified directory,
|
|
- then removes the file. -}
|
|
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
|
|
remove (name, h) = liftIO $ do
|
|
hClose h
|
|
catchBoolIO (removeFile name >> return True)
|
|
use (name, h) = a name h
|
|
|
|
{- Runs an action with a tmp directory located within the system's tmp
|
|
- directory (or within "." if there is none), then removes the tmp
|
|
- directory and all its contents. -}
|
|
withTmpDir :: Template -> (FilePath -> IO a) -> IO a
|
|
withTmpDir template a = do
|
|
tmpdir <- catchDefaultIO "." getTemporaryDirectory
|
|
withTmpDirIn tmpdir template a
|
|
|
|
{- Runs an action with a tmp directory located within a specified directory,
|
|
- then removes the tmp directory and all its contents. -}
|
|
withTmpDirIn :: FilePath -> Template -> (FilePath -> IO a) -> IO a
|
|
withTmpDirIn tmpdir template = bracket create remove
|
|
where
|
|
remove d = whenM (doesDirectoryExist d) $ do
|
|
#if mingw32_HOST_OS
|
|
-- Windows will often refuse to delete a file
|
|
-- after a process has just written to it and exited.
|
|
-- Because it's crap, presumably. So, ignore failure
|
|
-- to delete the temp directory.
|
|
_ <- tryIO $ removeDirectoryRecursive d
|
|
return ()
|
|
#else
|
|
removeDirectoryRecursive d
|
|
#endif
|
|
create = do
|
|
createDirectoryIfMissing True tmpdir
|
|
makenewdir (tmpdir </> template) (0 :: Int)
|
|
makenewdir t n = do
|
|
let dir = t ++ "." ++ show n
|
|
either (const $ makenewdir t $ n + 1) (const $ return dir)
|
|
=<< tryIO (createDirectory dir)
|
|
|
|
{- It's not safe to use a FilePath of an existing file as the template
|
|
- for openTempFile, because if the FilePath is really long, the tmpfile
|
|
- will be longer, and may exceed the maximum filename length.
|
|
-
|
|
- This generates a template that is never too long.
|
|
- (Well, it allocates 20 characters for use in making a unique temp file,
|
|
- anyway, which is enough for the current implementation and any
|
|
- likely implementation.)
|
|
-}
|
|
relatedTemplate :: FilePath -> FilePath
|
|
relatedTemplate f
|
|
| len > 20 = truncateFilePath (len - 20) f
|
|
| otherwise = f
|
|
where
|
|
len = length f
|