1{- Temporary directories
2 -
3 - Copyright 2010-2013 Joey Hess <id@joeyh.name>
4 -
5 - License: BSD-2-clause
6 -}
7
8{-# LANGUAGE CPP #-}
9{-# OPTIONS_GHC -fno-warn-tabs #-}
10
11module Utility.Tmp.Dir (
12	withTmpDir,
13	withTmpDirIn,
14) where
15
16import Control.Monad.IfElse
17import System.FilePath
18import System.Directory
19import Control.Monad.IO.Class
20#ifndef mingw32_HOST_OS
21import System.Posix.Temp (mkdtemp)
22#endif
23
24import Utility.Exception
25import Utility.Tmp (Template)
26
27{- Runs an action with a tmp directory located within the system's tmp
28 - directory (or within "." if there is none), then removes the tmp
29 - directory and all its contents. -}
30withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
31withTmpDir template a = do
32	topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
33#ifndef mingw32_HOST_OS
34	-- Use mkdtemp to create a temp directory securely in /tmp.
35	bracket
36		(liftIO $ mkdtemp $ topleveltmpdir </> template)
37		removeTmpDir
38		a
39#else
40	withTmpDirIn topleveltmpdir template a
41#endif
42
43{- Runs an action with a tmp directory located within a specified directory,
44 - then removes the tmp directory and all its contents. -}
45withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
46withTmpDirIn tmpdir template = bracketIO create removeTmpDir
47  where
48	create = do
49		createDirectoryIfMissing True tmpdir
50		makenewdir (tmpdir </> template) (0 :: Int)
51	makenewdir t n = do
52		let dir = t ++ "." ++ show n
53		catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do
54			createDirectory dir
55			return dir
56
57{- Deletes the entire contents of the the temporary directory, if it
58 - exists. -}
59removeTmpDir :: MonadIO m => FilePath -> m ()
60removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do
61#if mingw32_HOST_OS
62	-- Windows will often refuse to delete a file
63	-- after a process has just written to it and exited.
64	-- Because it's crap, presumably. So, ignore failure
65	-- to delete the temp directory.
66	_ <- tryIO $ removeDirectoryRecursive tmpdir
67	return ()
68#else
69	removeDirectoryRecursive tmpdir
70#endif
71