summaryrefslogtreecommitdiff
path: root/src/Utility/Tmp.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Utility/Tmp.hs')
-rw-r--r--src/Utility/Tmp.hs55
1 files changed, 3 insertions, 52 deletions
diff --git a/src/Utility/Tmp.hs b/src/Utility/Tmp.hs
index 6a541cfe..6e04b107 100644
--- a/src/Utility/Tmp.hs
+++ b/src/Utility/Tmp.hs
@@ -1,4 +1,4 @@
-{- Temporary files and directories.
+{- Temporary files.
-
- Copyright 2010-2013 Joey Hess <id@joeyh.name>
-
@@ -11,24 +11,20 @@
module Utility.Tmp where
import System.IO
-import Control.Monad.IfElse
import System.FilePath
import System.Directory
import Control.Monad.IO.Class
-#ifndef mingw32_HOST_OS
-import System.Posix.Temp (mkdtemp)
-#endif
+import System.PosixCompat.Files
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 :: (MonadMask m, MonadIO m) => (FilePath -> String -> m ()) -> FilePath -> String -> m ()
+viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> v -> m ()) -> FilePath -> v -> m ()
viaTmp a file content = bracketIO setup cleanup use
where
(dir, base) = splitFileName file
@@ -62,51 +58,6 @@ withTmpFileIn tmpdir template a = bracket create remove use
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.