3ec579f5e1
That version has my patches for the problems that Utility.PosixFiles was working around, so am able to get rid of that module now. This will later allow bringing back the custom-setup stanza in the cabal file. It will need to depend on unix-compat 0.5 on all OS's, which I'm not ready to do yet. This commit was sponsored by Nick Daly on Patreon.
124 lines
4.1 KiB
Haskell
124 lines
4.1 KiB
Haskell
{- Temporary files and directories.
|
|
-
|
|
- Copyright 2010-2013 Joey Hess <id@joeyh.name>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
|
|
|
module Utility.Tmp where
|
|
|
|
import System.IO
|
|
import Control.Monad.IfElse
|
|
import System.FilePath
|
|
import System.Directory
|
|
import Control.Monad.IO.Class
|
|
import System.PosixCompat.Files
|
|
#ifndef mingw32_HOST_OS
|
|
import System.Posix.Temp (mkdtemp)
|
|
#endif
|
|
|
|
import Utility.Exception
|
|
import Utility.FileSystemEncoding
|
|
|
|
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 :: (MonadMask m, MonadIO m) => (FilePath -> v -> m ()) -> FilePath -> v -> m ()
|
|
viaTmp a file content = bracketIO 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
|
|
liftIO $ hClose h
|
|
a tmpfile content
|
|
liftIO $ 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 :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
|
|
withTmpDir template a = do
|
|
topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
|
|
#ifndef mingw32_HOST_OS
|
|
-- Use mkdtemp to create a temp directory securely in /tmp.
|
|
bracket
|
|
(liftIO $ mkdtemp $ topleveltmpdir </> template)
|
|
removeTmpDir
|
|
a
|
|
#else
|
|
withTmpDirIn topleveltmpdir template a
|
|
#endif
|
|
|
|
{- Runs an action with a tmp directory located within a specified directory,
|
|
- then removes the tmp directory and all its contents. -}
|
|
withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
|
|
withTmpDirIn tmpdir template = bracketIO create removeTmpDir
|
|
where
|
|
create = do
|
|
createDirectoryIfMissing True tmpdir
|
|
makenewdir (tmpdir </> template) (0 :: Int)
|
|
makenewdir t n = do
|
|
let dir = t ++ "." ++ show n
|
|
catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do
|
|
createDirectory dir
|
|
return dir
|
|
|
|
{- Deletes the entire contents of the the temporary directory, if it
|
|
- exists. -}
|
|
removeTmpDir :: MonadIO m => FilePath -> m ()
|
|
removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ 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 tmpdir
|
|
return ()
|
|
#else
|
|
removeDirectoryRecursive tmpdir
|
|
#endif
|
|
|
|
{- 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
|