1{- Temporary directories 2 - 3 - Copyright 2010-2013 Joey Hess <id@joeyh.name> 4 - 5 - License: BSD-2-clause 6 -} 7 8{-# LANGUAGE CPP #-} 9{-# OPTIONS_GHC -fno-warn-tabs #-} 10 11module Utility.Tmp.Dir ( 12 withTmpDir, 13 withTmpDirIn, 14) where 15 16import Control.Monad.IfElse 17import System.FilePath 18import System.Directory 19import Control.Monad.IO.Class 20#ifndef mingw32_HOST_OS 21import System.Posix.Temp (mkdtemp) 22#endif 23 24import Utility.Exception 25import Utility.Tmp (Template) 26 27{- Runs an action with a tmp directory located within the system's tmp 28 - directory (or within "." if there is none), then removes the tmp 29 - directory and all its contents. -} 30withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a 31withTmpDir template a = do 32 topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory 33#ifndef mingw32_HOST_OS 34 -- Use mkdtemp to create a temp directory securely in /tmp. 35 bracket 36 (liftIO $ mkdtemp $ topleveltmpdir </> template) 37 removeTmpDir 38 a 39#else 40 withTmpDirIn topleveltmpdir template a 41#endif 42 43{- Runs an action with a tmp directory located within a specified directory, 44 - then removes the tmp directory and all its contents. -} 45withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a 46withTmpDirIn tmpdir template = bracketIO create removeTmpDir 47 where 48 create = do 49 createDirectoryIfMissing True tmpdir 50 makenewdir (tmpdir </> template) (0 :: Int) 51 makenewdir t n = do 52 let dir = t ++ "." ++ show n 53 catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do 54 createDirectory dir 55 return dir 56 57{- Deletes the entire contents of the the temporary directory, if it 58 - exists. -} 59removeTmpDir :: MonadIO m => FilePath -> m () 60removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do 61#if mingw32_HOST_OS 62 -- Windows will often refuse to delete a file 63 -- after a process has just written to it and exited. 64 -- Because it's crap, presumably. So, ignore failure 65 -- to delete the temp directory. 66 _ <- tryIO $ removeDirectoryRecursive tmpdir 67 return () 68#else 69 removeDirectoryRecursive tmpdir 70#endif 71