1{-# LANGUAgE CPP #-}
2-- | Temporary file and directory support.
3--
4-- Strongly inspired by\/stolen from the <https://github.com/feuerbach/temporary> package.
5--
6-- @since 0.1.0.0
7module UnliftIO.Temporary
8  ( withSystemTempFile
9  , withSystemTempDirectory
10  , withTempFile
11  , withTempDirectory
12  ) where
13
14import Control.Monad.IO.Unlift
15import Control.Monad (liftM)
16import UnliftIO.Exception
17import System.Directory
18import System.IO (Handle, openTempFile, hClose)
19import System.IO.Error
20import System.Posix.Internals (c_getpid)
21import System.FilePath ((</>))
22
23#ifdef mingw32_HOST_OS
24import System.Directory       ( createDirectory )
25#else
26import qualified System.Posix
27#endif
28
29-- | Create and use a temporary file in the system standard temporary directory.
30--
31-- Behaves exactly the same as 'withTempFile', except that the parent temporary directory
32-- will be that returned by 'getCanonicalTemporaryDirectory'.
33--
34-- @since 0.1.0.0
35withSystemTempFile :: MonadUnliftIO m =>
36                      String   -- ^ File name template. See 'openTempFile'.
37                   -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file
38                   -> m a
39withSystemTempFile template action = liftIO getCanonicalTemporaryDirectory >>= \tmpDir -> withTempFile tmpDir template action
40
41-- | Create and use a temporary directory in the system standard temporary directory.
42--
43-- Behaves exactly the same as 'withTempDirectory', except that the parent temporary directory
44-- will be that returned by 'getCanonicalTemporaryDirectory'.
45--
46-- @since 0.1.0.0
47withSystemTempDirectory :: MonadUnliftIO m =>
48                           String   -- ^ Directory name template. See 'openTempFile'.
49                        -> (FilePath -> m a) -- ^ Callback that can use the directory.
50                        -> m a
51withSystemTempDirectory template action = liftIO getCanonicalTemporaryDirectory >>= \tmpDir -> withTempDirectory tmpDir template action
52
53
54-- | Use a temporary filename that doesn't already exist.
55--
56-- Creates a new temporary file inside the given directory, making use of the
57-- template. The temp file is deleted after use. For example:
58--
59-- > withTempFile "src" "sdist." $ \tmpFile hFile -> do ...
60--
61-- The @tmpFile@ will be file in the given directory, e.g.
62-- @src/sdist.342@.
63--
64-- @since 0.1.0.0
65withTempFile :: MonadUnliftIO m =>
66                FilePath -- ^ Temp dir to create the file in.
67             -> String   -- ^ File name template. See 'openTempFile'.
68             -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file.
69             -> m a
70withTempFile tmpDir template action =
71  bracket
72    (liftIO (openTempFile tmpDir template))
73    (\(name, handle') -> liftIO (hClose handle' >> ignoringIOErrors (removeFile name)))
74    (uncurry action)
75
76-- | Create and use a temporary directory.
77--
78-- Creates a new temporary directory inside the given directory, making use
79-- of the template. The temp directory is deleted after use. For example:
80--
81-- > withTempDirectory "src" "sdist." $ \tmpDir -> do ...
82--
83-- The @tmpDir@ will be a new subdirectory of the given directory, e.g.
84-- @src/sdist.342@.
85--
86-- @since 0.1.0.0
87withTempDirectory :: MonadUnliftIO m =>
88                     FilePath -- ^ Temp directory to create the directory in.
89                  -> String   -- ^ Directory name template. See 'openTempFile'.
90                  -> (FilePath -> m a) -- ^ Callback that can use the directory.
91                  -> m a
92withTempDirectory targetDir template =
93  bracket
94    (liftIO (createTempDirectory targetDir template))
95    (liftIO . ignoringIOErrors . removeDirectoryRecursive)
96
97-- | Return the absolute and canonical path to the system temporary
98-- directory.
99--
100-- >>> setCurrentDirectory "/home/feuerbach/"
101-- >>> setEnv "TMPDIR" "."
102-- >>> getTemporaryDirectory
103-- "."
104-- >>> getCanonicalTemporaryDirectory
105-- "/home/feuerbach"
106getCanonicalTemporaryDirectory :: IO FilePath
107getCanonicalTemporaryDirectory = getTemporaryDirectory >>= canonicalizePath
108
109-- | Create a temporary directory. See 'withTempDirectory'.
110createTempDirectory
111  :: FilePath -- ^ Temp directory to create the directory in.
112  -> String -- ^ Directory name template.
113  -> IO FilePath
114createTempDirectory dir template = do
115  pid <- c_getpid
116  findTempName pid
117  where
118    findTempName x = do
119      let dirpath = dir </> template ++ show x
120      r <- try $ mkPrivateDir dirpath
121      case r of
122        Right _ -> return dirpath
123        Left  e | isAlreadyExistsError e -> findTempName (x+1)
124                | otherwise              -> ioError e
125
126
127mkPrivateDir :: String -> IO ()
128#ifdef mingw32_HOST_OS
129mkPrivateDir s = createDirectory s
130#else
131mkPrivateDir s = System.Posix.createDirectory s 0o700
132#endif
133
134ignoringIOErrors :: MonadUnliftIO m => m () -> m ()
135ignoringIOErrors = liftM (const ()) . tryIO -- yes, it's just void, but for pre-AMP GHCs
136