temporary 1.1.2.5 → 1.3
raw patch · 7 files changed
Files
- CHANGELOG.md +23/−0
- Distribution/Compat/Exception.hs +0/−49
- Distribution/Compat/TempFile.hs +0/−209
- LICENSE +6/−1
- System/IO/Temp.hs +191/−56
- temporary.cabal +41/−19
- tests/test.hs +111/−0
+ CHANGELOG.md view
@@ -0,0 +1,23 @@+## 1.3++* Generated directory names are now based on random hex strings rather than PIDs.++ This got a major version bump as a courtesy to users who may depend on the+ specific form of generated names, but that form is not part of the API+ contract and should not be depended upon.++## 1.2.1.1++* Improve the docs++## 1.2.1++* Limit support to GHC 7.0++* Add new functions: `writeTempFile,` `writeSystemTempFile,` `emptyTempFile,` `emptySystemTempFile`+* Make sure that system* functions return canonicalized paths+* Modernize the code base, add tests and documentation++## 1.2.0.4++* Update maintainership information+* Fix the docs
− Distribution/Compat/Exception.hs
@@ -1,49 +0,0 @@-{-# OPTIONS -cpp #-}--- OPTIONS required for ghc-6.4.x compat, and must appear first-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -cpp #-}-{-# OPTIONS_NHC98 -cpp #-}-{-# OPTIONS_JHC -fcpp #-}--#if !(defined(__HUGS__) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 610))-#define NEW_EXCEPTION-#endif--module Distribution.Compat.Exception- (onException, catchIO, catchExit, throwIOIO)- where--import System.Exit-import qualified Control.Exception as Exception--onException :: IO a -> IO b -> IO a-#ifdef NEW_EXCEPTION-onException = Exception.onException-#else-onException io what = io `Exception.catch` \e -> do what- Exception.throw e-#endif--throwIOIO :: Exception.IOException -> IO a-#ifdef NEW_EXCEPTION-throwIOIO = Exception.throwIO-#else-throwIOIO = Exception.throwIO . Exception.IOException-#endif--catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a-#ifdef NEW_EXCEPTION-catchIO = Exception.catch-#else-catchIO = Exception.catchJust Exception.ioErrors-#endif--catchExit :: IO a -> (ExitCode -> IO a) -> IO a-#ifdef NEW_EXCEPTION-catchExit = Exception.catch-#else-catchExit = Exception.catchJust exitExceptions- where exitExceptions (Exception.ExitException ee) = Just ee- exitExceptions _ = Nothing-#endif-
− Distribution/Compat/TempFile.hs
@@ -1,209 +0,0 @@-{-# OPTIONS -cpp #-}--- OPTIONS required for ghc-6.4.x compat, and must appear first-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -cpp #-}-{-# OPTIONS_NHC98 -cpp #-}-{-# OPTIONS_JHC -fcpp #-}--- #hide-module Distribution.Compat.TempFile (- openTempFile,- openBinaryTempFile,- openNewBinaryFile,- createTempDirectory,- ) where---import System.FilePath ((</>))-import Foreign.C (eEXIST)--#if __NHC__ || __HUGS__-import System.IO (openFile, openBinaryFile,- Handle, IOMode(ReadWriteMode))-import System.Directory (doesFileExist)-import System.FilePath ((<.>), splitExtension)-import System.IO.Error (try, isAlreadyExistsError)-#else-import System.IO (Handle, openTempFile, openBinaryTempFile)-import Data.Bits ((.|.))-import System.Posix.Internals (c_open, c_close, o_CREAT, o_EXCL, o_RDWR,- o_BINARY, o_NONBLOCK, o_NOCTTY)-import System.IO.Error (isAlreadyExistsError)-#if __GLASGOW_HASKELL__ >= 706-import Control.Exception (try)-#else-import System.IO.Error (try)-#endif-#if __GLASGOW_HASKELL__ >= 611-import System.Posix.Internals (withFilePath)-#else-import Foreign.C (withCString)-#endif-import Foreign.C (CInt)-#if __GLASGOW_HASKELL__ >= 611-import GHC.IO.Handle.FD (fdToHandle)-#else-import GHC.Handle (fdToHandle)-#endif-import Distribution.Compat.Exception (onException)-#endif-import Foreign.C (getErrno, errnoToIOError)--#if __NHC__-import System.Posix.Types (CPid(..))-foreign import ccall unsafe "getpid" c_getpid :: IO CPid-#else-import System.Posix.Internals (c_getpid)-#endif--#ifdef mingw32_HOST_OS-import System.Directory ( createDirectory )-#else-import qualified System.Posix-#endif---- --------------------------------------------------------------- * temporary files--- ---------------------------------------------------------------- This is here for Haskell implementations that do not come with--- System.IO.openTempFile. This includes nhc-1.20, hugs-2006.9.--- TODO: Not sure about jhc--#if __NHC__ || __HUGS__--- use a temporary filename that doesn't already exist.--- NB. *not* secure (we don't atomically lock the tmp file we get)-openTempFile :: FilePath -> String -> IO (FilePath, Handle)-openTempFile tmp_dir template- = do x <- getProcessID- findTempName x- where- (templateBase, templateExt) = splitExtension template- findTempName :: Int -> IO (FilePath, Handle)- findTempName x- = do let path = tmp_dir </> (templateBase ++ "-" ++ show x) <.> templateExt- b <- doesFileExist path- if b then findTempName (x+1)- else do hnd <- openFile path ReadWriteMode- return (path, hnd)--openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)-openBinaryTempFile tmp_dir template- = do x <- getProcessID- findTempName x- where- (templateBase, templateExt) = splitExtension template- findTempName :: Int -> IO (FilePath, Handle)- findTempName x- = do let path = tmp_dir </> (templateBase ++ show x) <.> templateExt- b <- doesFileExist path- if b then findTempName (x+1)- else do hnd <- openBinaryFile path ReadWriteMode- return (path, hnd)--openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle)-openNewBinaryFile = openBinaryTempFile--getProcessID :: IO Int-getProcessID = fmap fromIntegral c_getpid-#else--- This is a copy/paste of the openBinaryTempFile definition, but--- if uses 666 rather than 600 for the permissions. The base library--- needs to be changed to make this better.-openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle)-openNewBinaryFile dir template = do- pid <- c_getpid- findTempName pid- where- -- We split off the last extension, so we can use .foo.ext files- -- for temporary files (hidden on Unix OSes). Unfortunately we're- -- below filepath in the hierarchy here.- (prefix,suffix) =- case break (== '.') $ reverse template of- -- First case: template contains no '.'s. Just re-reverse it.- (rev_suffix, "") -> (reverse rev_suffix, "")- -- Second case: template contains at least one '.'. Strip the- -- dot from the prefix and prepend it to the suffix (if we don't- -- do this, the unique number will get added after the '.' and- -- thus be part of the extension, which is wrong.)- (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)- -- Otherwise, something is wrong, because (break (== '.')) should- -- always return a pair with either the empty string or a string- -- beginning with '.' as the second component.- _ -> error "bug in System.IO.openTempFile"-- oflags = rw_flags .|. o_EXCL .|. o_BINARY--#if __GLASGOW_HASKELL__ < 611- withFilePath = withCString-#endif-- findTempName x = do- fd <- withFilePath filepath $ \ f ->- c_open f oflags 0o666- if fd < 0- then do- errno <- getErrno- if errno == eEXIST- then findTempName (x+1)- else ioError (errnoToIOError "openNewBinaryFile" errno Nothing (Just dir))- else do- -- TODO: We want to tell fdToHandle what the filepath is,- -- as any exceptions etc will only be able to report the- -- fd currently- h <--#if __GLASGOW_HASKELL__ >= 609- fdToHandle fd-#elif __GLASGOW_HASKELL__ <= 606 && defined(mingw32_HOST_OS)- -- fdToHandle is borked on Windows with ghc-6.6.x- openFd (fromIntegral fd) Nothing False filepath- ReadWriteMode True-#else- fdToHandle (fromIntegral fd)-#endif- `onException` c_close fd- return (filepath, h)- where- filename = prefix ++ show x ++ suffix- filepath = dir `combine` filename-- -- FIXME: bits copied from System.FilePath- combine a b- | null b = a- | null a = b- | last a == pathSeparator = a ++ b- | otherwise = a ++ [pathSeparator] ++ b---- FIXME: Should use filepath library-pathSeparator :: Char-#ifdef mingw32_HOST_OS-pathSeparator = '\\'-#else-pathSeparator = '/'-#endif---- FIXME: Copied from GHC.Handle-std_flags, output_flags, rw_flags :: CInt-std_flags = o_NONBLOCK .|. o_NOCTTY-output_flags = std_flags .|. o_CREAT-rw_flags = output_flags .|. o_RDWR-#endif--createTempDirectory :: FilePath -> String -> IO FilePath-createTempDirectory dir template = do- pid <- c_getpid- findTempName pid- where- findTempName x = do- let dirpath = dir </> template ++ show x- r <- try $ mkPrivateDir dirpath- case r of- Right _ -> return dirpath- Left e | isAlreadyExistsError e -> findTempName (x+1)- | otherwise -> ioError e--mkPrivateDir :: String -> IO ()-#ifdef mingw32_HOST_OS-mkPrivateDir s = createDirectory s-#else-mkPrivateDir s = System.Posix.createDirectory s 0o700-#endif
LICENSE view
@@ -1,4 +1,9 @@-Copyright (c) 2008, Maximilian Bolingbroke+Copyright+ (c) 2003-2006, Isaac Jones+ (c) 2005-2009, Duncan Coutts+ (c) 2008, Maximilian Bolingbroke+ ... and other contributors+ All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted
System/IO/Temp.hs view
@@ -1,79 +1,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,- module Distribution.Compat.TempFile+ openNewBinaryFile,+ createTempDirectory,+ writeTempFile, writeSystemTempFile,+ emptyTempFile, emptySystemTempFile,+ -- * Re-exports from System.IO+ openTempFile,+ openBinaryTempFile,+ -- * Auxiliary functions+ getCanonicalTemporaryDirectory ) where --- NB: this module was extracted directly from "Distribution/Simple/Utils.hs"--- in a Cabal tree whose most recent commit was on Sun Oct 10 22:00:26------ The files in the Distribution/Compat tree are exact copies of the corresponding--- file in the Cabal checkout.---import qualified Control.Exception as Exception+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--import Distribution.Compat.TempFile-+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 and use a temporary directory in the system standard temporary directory.+-- | Create, open, and use a temporary file in the system standard temporary directory. ----- Behaves exactly the same as 'withTempDirectory', except that the parent temporary directory--- will be that returned by 'getTemporaryDirectory'.-withSystemTempFile :: String -- ^ File name template. See 'openTempFile'.- -> (FilePath -> Handle -> IO a) -- ^ Callback that can use the file- -> IO a-withSystemTempFile template action = getTemporaryDirectory >>= \tmpDir -> withTempFile tmpDir template action+-- 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 'getTemporaryDirectory'.-withSystemTempDirectory :: String -- ^ Directory name template. See 'openTempFile'.- -> (FilePath -> IO a) -- ^ Callback that can use the directory- -> IO a-withSystemTempDirectory template action = getTemporaryDirectory >>= \tmpDir -> withTempDirectory tmpDir template action+-- 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 --- | Use a temporary filename that doesn't already exist.------ Creates a new temporary file inside the given directory, making use of the--- template. The temp file is deleted after use. For example:------ > withTempFile "src" "sdist." $ \tmpFile hFile -> do ...+-- | Create, open, and use a temporary file in the given directory. ----- The @tmpFlie@ will be file in the given directory, e.g.--- @src/sdist.342@.-withTempFile :: FilePath -- ^ Temp dir to create the file in- -> String -- ^ File name template. See 'openTempFile'.- -> (FilePath -> Handle -> IO a) -- ^ Callback that can use the file- -> IO a+-- 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 =- Exception.bracket- (openTempFile tmpDir template)- (\(name, handle) -> hClose handle >> ignoringIOErrors (removeFile name))+ MC.bracket+ (liftIO (openTempFile tmpDir template))+ (\(name, handle) -> liftIO (hClose handle >> ignoringIOErrors (removeFile name))) (uncurry action) --- | Create and use a temporary directory.+-- | Create and use a temporary directory inside the given directory. ----- Creates a new temporary directory inside the given directory, making use--- of the template. The temp directory is deleted after use. For example:+-- 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. ----- > withTempDirectory "src" "sdist." $ \tmpDir -> do ...+-- @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. ----- The @tmpDir@ will be a new subdirectory of the given directory, e.g.--- @src/sdist.342@.-withTempDirectory :: FilePath -- ^ Temp directory to create the directory in- -> String -- ^ Directory name template. See 'openTempFile'.- -> (FilePath -> IO a) -- ^ Callback that can use the directory- -> IO a-withTempDirectory targetDir template =- Exception.bracket- (createTempDirectory targetDir template)- (ignoringIOErrors . removeDirectoryRecursive)+-- @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 -ignoringIOErrors :: IO () -> IO ()-ignoringIOErrors ioe = ioe `Exception.catch` (\e -> const (return ()) (e :: IOError))+-- | 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
temporary.cabal view
@@ -1,28 +1,50 @@ name: temporary-version: 1.1.2.5-cabal-version: >= 1.6-synopsis: Portable temporary file and directory support for Windows and Unix, based on code from Cabal-description: The functions for creating temporary files and directories in the base library are quite limited. The unixutils- package contains some good ones, but they aren't portable to Windows.-- This library just repackages the Cabal implementations of its own temporary file and folder functions so that- you can use them without linking against Cabal or depending on it being installed.+version: 1.3+cabal-version: >= 1.10+synopsis: Portable temporary file and directory support+description: Functions for creating temporary files and directories. category: System, Utils license: BSD3 license-file: LICENSE-copyright: (c) 2003-2006, Isaac Jones- (c) 2005-2009, Duncan Coutts-author: Isaac Jones <ijones@syntaxpolice.org>- Duncan Coutts <duncan@haskell.org>-maintainer: Max Bolingbroke <batterseapower@hotmail.com>-homepage: http://www.github.com/batterseapower/temporary+maintainer: Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>, Roman Cheplyaka <roma@ro-che.info>+homepage: https://github.com/feuerbach/temporary build-type: Simple+extra-source-files: CHANGELOG.md +source-repository head+ type: git+ location: git://github.com/feuerbach/temporary.git+ Library+ default-language:+ Haskell2010 exposed-modules: System.IO.Temp- other-modules: Distribution.Compat.Exception- Distribution.Compat.TempFile- build-depends: base >= 3 && < 6, filepath >= 1.1 && < 1.4, directory >= 1.0 && < 1.3-+ build-depends: base >= 3 && < 10, filepath >= 1.1, directory >= 1.0,+ transformers >= 0.2.0.0, exceptions >= 0.6, random >= 1.1+ -- note: the transformers dependency is needed for MonadIO+ -- on older GHCs; on newer ones, it is included in base.+ ghc-options: -Wall+ if !os(windows)- build-depends: unix >= 2.3 && < 2.8+ build-depends: unix >= 2.3++test-suite test+ default-language:+ Haskell2010+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ tests+ main-is:+ test.hs+ ghc-options: -threaded -with-rtsopts=-N2+ build-depends:+ base >= 4.3 && < 5+ , directory+ , tasty+ , tasty-hunit+ , temporary+ , filepath+ , base-compat+ if !os(windows)+ build-depends: unix >= 2.3
+ tests/test.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE CPP #-}+import Test.Tasty+import Test.Tasty.HUnit++import Control.Monad+import Control.Concurrent+import Control.Concurrent.MVar+import Control.Exception+import System.Directory+import System.IO+import System.FilePath+import System.Environment.Compat+import Data.Bits+import Data.List+import GHC.IO.Handle+#ifndef mingw32_HOST_OS+import System.Posix.Files+#endif++import System.IO.Temp++main = do+ -- force single-thread execution, because changing TMPDIR in one of the+ -- tests may leak to the other tests+ setEnv "TASTY_NUM_THREADS" "1"+#ifndef mingw32_HOST_OS+ setFileCreationMask 0+#endif+ sys_tmp_dir <- getCanonicalTemporaryDirectory++ defaultMain $ testGroup "Tests"+ [ testCase "openNewBinaryFile" $ do+ (fp, fh) <- openNewBinaryFile sys_tmp_dir "test.txt"+ let fn = takeFileName fp+ assertBool ("Does not match template: " ++ fn) $+ ("test" `isPrefixOf` fn) && (".txt" `isSuffixOf` fn)+ assertBool (fp ++ " is not in the right directory " ++ sys_tmp_dir) $+ takeDirectory fp `equalFilePath` sys_tmp_dir+ hClose fh+ assertBool "File does not exist" =<< doesFileExist fp+#ifndef mingw32_HOST_OS+ status <- getFileStatus fp+ fileMode status .&. 0o777 @?= 0o666 +#endif+ removeFile fp+ , testCase "withSystemTempFile" $ do+ (fp, fh) <- withSystemTempFile "test.txt" $ \fp fh -> do+ let fn = takeFileName fp+ assertBool ("Does not match template: " ++ fn) $+ ("test" `isPrefixOf` fn) && (".txt" `isSuffixOf` fn)+ assertBool (fp ++ " is not in the right directory " ++ sys_tmp_dir) $+ takeDirectory fp `equalFilePath` sys_tmp_dir+ assertBool "File not open" =<< hIsOpen fh+ hPutStrLn fh "hi"+ assertBool "File does not exist" =<< doesFileExist fp+#ifndef mingw32_HOST_OS+ status <- getFileStatus fp+ fileMode status .&. 0o777 @?= 0o600+#endif+ return (fp, fh)+ assertBool "File still exists" . not =<< doesFileExist fp+ assertBool "File not closed" =<< hIsClosed fh+ , testCase "withSystemTempDirectory" $ do+ fp <- withSystemTempDirectory "test.dir" $ \fp -> do+ let fn = takeFileName fp+ assertBool ("Does not match template: " ++ fn) $+ ("test.dir" `isPrefixOf` fn)+ assertBool (fp ++ " is not in the right directory " ++ sys_tmp_dir) $+ takeDirectory fp `equalFilePath` sys_tmp_dir+ assertBool "Directory does not exist" =<< doesDirectoryExist fp+#ifndef mingw32_HOST_OS+ status <- getFileStatus fp+ fileMode status .&. 0o777 @?= 0o700+#endif+ return fp+ assertBool "Directory still exists" . not =<< doesDirectoryExist fp+ , testCase "writeSystemTempFile" $ do+ fp <- writeSystemTempFile "blah.txt" "hello"+ str <- readFile fp+ "hello" @?= str+ removeFile fp+ , testCase "emptySystemTempFile" $ do+ fp <- emptySystemTempFile "empty.txt"+ assertBool "File doesn't exist" =<< doesFileExist fp+ removeFile fp+ , testCase "withSystemTempFile returns absolute path" $ do+ bracket_ (setEnv "TMPDIR" ".") (unsetEnv "TMPDIR") $ do+ withSystemTempFile "temp.txt" $ \fp _ ->+ assertBool "Not absolute" $ isAbsolute fp+ , testCase "withSystemTempDirectory is not interrupted" $ do+ -- this mvar is both a channel to pass the name of the directory+ -- and a signal that we finished creating files and are ready+ -- to be killed+ mvar1 <- newEmptyMVar+ -- this mvar signals that the withSystemTempDirectory function+ -- returned and we can check whether the directory has survived+ mvar2 <- newEmptyMVar+ threadId <- forkIO $+ (withSystemTempDirectory "temp.test." $ \dir -> do+ replicateM_ 100 $ emptyTempFile dir "file.xyz"+ putMVar mvar1 dir+ threadDelay $ 10^6+ ) `finally` (putMVar mvar2 ())+ dir <- readMVar mvar1+ -- start sending exceptions+ replicateM_ 10 $ forkIO $ killThread threadId+ -- wait for the thread to finish+ readMVar mvar2+ -- check whether the directory was successfully removed+ assertBool "Directory was not removed" . not =<< doesDirectoryExist dir+ ]