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