File: Temp.hs

package info (click to toggle)
haskell-temporary 1.3-5
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 84 kB
  • sloc: haskell: 215; makefile: 2
file content (214 lines) | stat: -rw-r--r-- 8,554 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
{-# LANGUAGE CPP, ScopedTypeVariables #-}
-- | Functions to create temporary files and directories.
--
-- Most functions come in two flavours: those that create files/directories
-- under the system standard temporary directory and those that use the
-- user-supplied directory.
--
-- The functions that create files/directories under the system standard
-- temporary directory will return canonical absolute paths (see
-- 'getCanonicalTemporaryDirectory'). The functions use the user-supplied
-- directory do not canonicalize the returned path.
--
-- The action inside 'withTempFile' or 'withTempDirectory' is allowed to
-- remove the temporary file/directory if it needs to.
--
-- == Templates and file names
--
-- The treatment of templates differs somewhat for files vs directories.
--
-- For files, the template has form @name.ext@, and a random number will be
-- placed between between the name and the extension to yield a unique file
-- name, e.g.  @name1804289383846930886.ext@.
--
-- For directories, no extension is recognized.
-- A random hexadecimal string (whose length depends on the system's word
-- size) is appended to the end of the template.
-- For instance,
-- the directory template @dir@ may result in a directory named
-- @dir-e4bd89e5d00acdee@.
--
-- You shouldn't rely on the specific form of file or directory names
-- generated by the library; it has changed in the past and may change in the future.
module System.IO.Temp (
    withSystemTempFile, withSystemTempDirectory,
    withTempFile, withTempDirectory,
    openNewBinaryFile,
    createTempDirectory,
    writeTempFile, writeSystemTempFile,
    emptyTempFile, emptySystemTempFile,
    -- * Re-exports from System.IO
    openTempFile,
    openBinaryTempFile,
    -- * Auxiliary functions
    getCanonicalTemporaryDirectory
  ) where

import qualified Control.Monad.Catch as MC

import Control.Monad.IO.Class
import Data.Bits -- no import list: we use different functions
                 -- depending on the base version
#if !MIN_VERSION_base(4,8,0)
import Data.Word (Word)
#endif
import System.Directory
import System.IO (Handle, hClose, openTempFile, openBinaryTempFile,
       openBinaryTempFileWithDefaultPermissions, hPutStr)
import System.IO.Error        (isAlreadyExistsError)
import System.FilePath        ((</>))
import System.Random
#ifdef mingw32_HOST_OS
import System.Directory       ( createDirectory )
#else
import qualified System.Posix
#endif
import Text.Printf

-- | Create, open, and use a temporary file in the system standard temporary directory.
--
-- The temp file is deleted after use.
--
-- Behaves exactly the same as 'withTempFile', except that the parent temporary directory
-- will be that returned by 'getCanonicalTemporaryDirectory'.
withSystemTempFile :: (MonadIO m, MC.MonadMask m) =>
                      String   -- ^ File name template
                   -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file
                   -> m a
withSystemTempFile template action = liftIO getCanonicalTemporaryDirectory >>= \tmpDir -> withTempFile tmpDir template action

-- | Create and use a temporary directory in the system standard temporary directory.
--
-- Behaves exactly the same as 'withTempDirectory', except that the parent temporary directory
-- will be that returned by 'getCanonicalTemporaryDirectory'.
withSystemTempDirectory :: (MonadIO m, MC.MonadMask m) =>
                           String   -- ^ Directory name template
                        -> (FilePath -> m a) -- ^ Callback that can use the directory
                        -> m a
withSystemTempDirectory template action = liftIO getCanonicalTemporaryDirectory >>= \tmpDir -> withTempDirectory tmpDir template action


-- | Create, open, and use a temporary file in the given directory.
--
-- The temp file is deleted after use.
withTempFile :: (MonadIO m, MC.MonadMask m) =>
                FilePath -- ^ Parent directory to create the file in
             -> String   -- ^ File name template
             -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file
             -> m a
withTempFile tmpDir template action =
  MC.bracket
    (liftIO (openTempFile tmpDir template))
    (\(name, handle) -> liftIO (hClose handle >> ignoringIOErrors (removeFile name)))
    (uncurry action)

-- | Create and use a temporary directory inside the given directory.
--
-- The directory is deleted after use.
withTempDirectory :: (MC.MonadMask m, MonadIO m) =>
                     FilePath -- ^ Parent directory to create the directory in
                  -> String   -- ^ Directory name template
                  -> (FilePath -> m a) -- ^ Callback that can use the directory
                  -> m a
withTempDirectory targetDir template =
  MC.bracket
    (liftIO (createTempDirectory targetDir template))
    (liftIO . ignoringIOErrors . removeDirectoryRecursive)

-- | Create a unique new file, write (text mode) a given data string to it,
--   and close the handle again. The file will not be deleted automatically,
--   and only the current user will have permission to access the file.
--
-- @since 1.2.1
writeTempFile :: FilePath    -- ^ Parent directory to create the file in
              -> String      -- ^ File name template
              -> String      -- ^ Data to store in the file
              -> IO FilePath -- ^ Path to the (written and closed) file
writeTempFile targetDir template content = MC.bracket
    (openTempFile targetDir template)
    (\(_, handle) -> hClose handle)
    (\(filePath, handle) -> hPutStr handle content >> return filePath)

-- | Like 'writeTempFile', but use the system directory for temporary files.
--
-- @since 1.2.1
writeSystemTempFile :: String      -- ^ File name template
                    -> String      -- ^ Data to store in the file
                    -> IO FilePath -- ^ Path to the (written and closed) file
writeSystemTempFile template content
    = getCanonicalTemporaryDirectory >>= \tmpDir -> writeTempFile tmpDir template content

-- | Create a unique new empty file. (Equivalent to 'writeTempFile' with empty data string.)
--   This is useful if the actual content is provided by an external process.
--
-- @since 1.2.1
emptyTempFile :: FilePath    -- ^ Parent directory to create the file in
              -> String      -- ^ File name template
              -> IO FilePath -- ^ Path to the (written and closed) file
emptyTempFile targetDir template = MC.bracket
    (openTempFile targetDir template)
    (\(_, handle) -> hClose handle)
    (\(filePath, _) -> return filePath)

-- | Like 'emptyTempFile', but use the system directory for temporary files.
--
-- @since 1.2.1
emptySystemTempFile :: String      -- ^ File name template
                    -> IO FilePath -- ^ Path to the (written and closed) file
emptySystemTempFile template
    = getCanonicalTemporaryDirectory >>= \tmpDir -> emptyTempFile tmpDir template


ignoringIOErrors :: MC.MonadCatch m => m () -> m ()
ignoringIOErrors ioe = ioe `MC.catch` (\e -> const (return ()) (e :: IOError))

-- | Like 'openBinaryTempFile', but uses 666 rather than 600 for the
-- permissions.
--
-- Equivalent to 'openBinaryTempFileWithDefaultPermissions'.
openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle)
openNewBinaryFile = openBinaryTempFileWithDefaultPermissions

-- | Create a temporary directory.
createTempDirectory
  :: FilePath -- ^ Parent directory to create the directory in
  -> String -- ^ Directory name template
  -> IO FilePath
createTempDirectory dir template = findTempName
  where
    findTempName = do
      x :: Word <- randomIO
      let dirpath = dir </> template ++ printf "-%.*x" (wordSize `div` 4) x
      r <- MC.try $ mkPrivateDir dirpath
      case r of
        Right _ -> return dirpath
        Left  e | isAlreadyExistsError e -> findTempName
                | otherwise              -> ioError e

-- | Word size in bits
wordSize :: Int
wordSize =
#if MIN_VERSION_base(4,7,0)
 finiteBitSize (undefined :: Word)
#else
  bitSize (undefined :: Word)
#endif

mkPrivateDir :: String -> IO ()
#ifdef mingw32_HOST_OS
mkPrivateDir s = createDirectory s
#else
mkPrivateDir s = System.Posix.createDirectory s 0o700
#endif

-- | Return the absolute and canonical path to the system temporary
-- directory.
--
-- >>> setCurrentDirectory "/home/feuerbach/"
-- >>> setEnv "TMPDIR" "."
-- >>> getTemporaryDirectory
-- "."
-- >>> getCanonicalTemporaryDirectory
-- "/home/feuerbach"
getCanonicalTemporaryDirectory :: IO FilePath
getCanonicalTemporaryDirectory = getTemporaryDirectory >>= canonicalizePath