1{-# LANGUAGE CPP, ScopedTypeVariables #-}
2-- | Functions to create temporary files and directories.
3--
4-- Most functions come in two flavours: those that create files/directories
5-- under the system standard temporary directory and those that use the
6-- user-supplied directory.
7--
8-- The functions that create files/directories under the system standard
9-- temporary directory will return canonical absolute paths (see
10-- 'getCanonicalTemporaryDirectory'). The functions use the user-supplied
11-- directory do not canonicalize the returned path.
12--
13-- The action inside 'withTempFile' or 'withTempDirectory' is allowed to
14-- remove the temporary file/directory if it needs to.
15--
16-- == Templates and file names
17--
18-- The treatment of templates differs somewhat for files vs directories.
19--
20-- For files, the template has form @name.ext@, and a random number will be
21-- placed between between the name and the extension to yield a unique file
22-- name, e.g.  @name1804289383846930886.ext@.
23--
24-- For directories, no extension is recognized.
25-- A random hexadecimal string (whose length depends on the system's word
26-- size) is appended to the end of the template.
27-- For instance,
28-- the directory template @dir@ may result in a directory named
29-- @dir-e4bd89e5d00acdee@.
30--
31-- You shouldn't rely on the specific form of file or directory names
32-- generated by the library; it has changed in the past and may change in the future.
33module System.IO.Temp (
34    withSystemTempFile, withSystemTempDirectory,
35    withTempFile, withTempDirectory,
36    openNewBinaryFile,
37    createTempDirectory,
38    writeTempFile, writeSystemTempFile,
39    emptyTempFile, emptySystemTempFile,
40    -- * Re-exports from System.IO
41    openTempFile,
42    openBinaryTempFile,
43    -- * Auxiliary functions
44    getCanonicalTemporaryDirectory
45  ) where
46
47import qualified Control.Monad.Catch as MC
48
49import Control.Monad.IO.Class
50import Data.Bits -- no import list: we use different functions
51                 -- depending on the base version
52#if !MIN_VERSION_base(4,8,0)
53import Data.Word (Word)
54#endif
55import System.Directory
56import System.IO (Handle, hClose, openTempFile, openBinaryTempFile,
57       openBinaryTempFileWithDefaultPermissions, hPutStr)
58import System.IO.Error        (isAlreadyExistsError)
59import System.FilePath        ((</>))
60import System.Random
61#ifdef mingw32_HOST_OS
62import System.Directory       ( createDirectory )
63#else
64import qualified System.Posix
65#endif
66import Text.Printf
67
68-- | Create, open, and use a temporary file in the system standard temporary directory.
69--
70-- The temp file is deleted after use.
71--
72-- Behaves exactly the same as 'withTempFile', except that the parent temporary directory
73-- will be that returned by 'getCanonicalTemporaryDirectory'.
74withSystemTempFile :: (MonadIO m, MC.MonadMask m) =>
75                      String   -- ^ File name template
76                   -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file
77                   -> m a
78withSystemTempFile template action = liftIO getCanonicalTemporaryDirectory >>= \tmpDir -> withTempFile tmpDir template action
79
80-- | Create and use a temporary directory in the system standard temporary directory.
81--
82-- Behaves exactly the same as 'withTempDirectory', except that the parent temporary directory
83-- will be that returned by 'getCanonicalTemporaryDirectory'.
84withSystemTempDirectory :: (MonadIO m, MC.MonadMask m) =>
85                           String   -- ^ Directory name template
86                        -> (FilePath -> m a) -- ^ Callback that can use the directory
87                        -> m a
88withSystemTempDirectory template action = liftIO getCanonicalTemporaryDirectory >>= \tmpDir -> withTempDirectory tmpDir template action
89
90
91-- | Create, open, and use a temporary file in the given directory.
92--
93-- The temp file is deleted after use.
94withTempFile :: (MonadIO m, MC.MonadMask m) =>
95                FilePath -- ^ Parent directory to create the file in
96             -> String   -- ^ File name template
97             -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file
98             -> m a
99withTempFile tmpDir template action =
100  MC.bracket
101    (liftIO (openTempFile tmpDir template))
102    (\(name, handle) -> liftIO (hClose handle >> ignoringIOErrors (removeFile name)))
103    (uncurry action)
104
105-- | Create and use a temporary directory inside the given directory.
106--
107-- The directory is deleted after use.
108withTempDirectory :: (MC.MonadMask m, MonadIO m) =>
109                     FilePath -- ^ Parent directory to create the directory in
110                  -> String   -- ^ Directory name template
111                  -> (FilePath -> m a) -- ^ Callback that can use the directory
112                  -> m a
113withTempDirectory targetDir template =
114  MC.bracket
115    (liftIO (createTempDirectory targetDir template))
116    (liftIO . ignoringIOErrors . removeDirectoryRecursive)
117
118-- | Create a unique new file, write (text mode) a given data string to it,
119--   and close the handle again. The file will not be deleted automatically,
120--   and only the current user will have permission to access the file.
121--
122-- @since 1.2.1
123writeTempFile :: FilePath    -- ^ Parent directory to create the file in
124              -> String      -- ^ File name template
125              -> String      -- ^ Data to store in the file
126              -> IO FilePath -- ^ Path to the (written and closed) file
127writeTempFile targetDir template content = MC.bracket
128    (openTempFile targetDir template)
129    (\(_, handle) -> hClose handle)
130    (\(filePath, handle) -> hPutStr handle content >> return filePath)
131
132-- | Like 'writeTempFile', but use the system directory for temporary files.
133--
134-- @since 1.2.1
135writeSystemTempFile :: String      -- ^ File name template
136                    -> String      -- ^ Data to store in the file
137                    -> IO FilePath -- ^ Path to the (written and closed) file
138writeSystemTempFile template content
139    = getCanonicalTemporaryDirectory >>= \tmpDir -> writeTempFile tmpDir template content
140
141-- | Create a unique new empty file. (Equivalent to 'writeTempFile' with empty data string.)
142--   This is useful if the actual content is provided by an external process.
143--
144-- @since 1.2.1
145emptyTempFile :: FilePath    -- ^ Parent directory to create the file in
146              -> String      -- ^ File name template
147              -> IO FilePath -- ^ Path to the (written and closed) file
148emptyTempFile targetDir template = MC.bracket
149    (openTempFile targetDir template)
150    (\(_, handle) -> hClose handle)
151    (\(filePath, _) -> return filePath)
152
153-- | Like 'emptyTempFile', but use the system directory for temporary files.
154--
155-- @since 1.2.1
156emptySystemTempFile :: String      -- ^ File name template
157                    -> IO FilePath -- ^ Path to the (written and closed) file
158emptySystemTempFile template
159    = getCanonicalTemporaryDirectory >>= \tmpDir -> emptyTempFile tmpDir template
160
161
162ignoringIOErrors :: MC.MonadCatch m => m () -> m ()
163ignoringIOErrors ioe = ioe `MC.catch` (\e -> const (return ()) (e :: IOError))
164
165-- | Like 'openBinaryTempFile', but uses 666 rather than 600 for the
166-- permissions.
167--
168-- Equivalent to 'openBinaryTempFileWithDefaultPermissions'.
169openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle)
170openNewBinaryFile = openBinaryTempFileWithDefaultPermissions
171
172-- | Create a temporary directory.
173createTempDirectory
174  :: FilePath -- ^ Parent directory to create the directory in
175  -> String -- ^ Directory name template
176  -> IO FilePath
177createTempDirectory dir template = findTempName
178  where
179    findTempName = do
180      x :: Word <- randomIO
181      let dirpath = dir </> template ++ printf "-%.*x" (wordSize `div` 4) x
182      r <- MC.try $ mkPrivateDir dirpath
183      case r of
184        Right _ -> return dirpath
185        Left  e | isAlreadyExistsError e -> findTempName
186                | otherwise              -> ioError e
187
188-- | Word size in bits
189wordSize :: Int
190wordSize =
191#if MIN_VERSION_base(4,7,0)
192 finiteBitSize (undefined :: Word)
193#else
194  bitSize (undefined :: Word)
195#endif
196
197mkPrivateDir :: String -> IO ()
198#ifdef mingw32_HOST_OS
199mkPrivateDir s = createDirectory s
200#else
201mkPrivateDir s = System.Posix.createDirectory s 0o700
202#endif
203
204-- | Return the absolute and canonical path to the system temporary
205-- directory.
206--
207-- >>> setCurrentDirectory "/home/feuerbach/"
208-- >>> setEnv "TMPDIR" "."
209-- >>> getTemporaryDirectory
210-- "."
211-- >>> getCanonicalTemporaryDirectory
212-- "/home/feuerbach"
213getCanonicalTemporaryDirectory :: IO FilePath
214getCanonicalTemporaryDirectory = getTemporaryDirectory >>= canonicalizePath
215