{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Tmp.Dir where
import Control.Monad.IfElse
import System.FilePath
import System.Directory
import Control.Monad.IO.Class
#ifndef mingw32_HOST_OS
import System.Posix.Temp (mkdtemp)
#endif
import Utility.Exception
import Utility.Tmp (Template)
withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
withTmpDir :: forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
Template -> (Template -> m a) -> m a
withTmpDir Template
template Template -> m a
a = do
Template
topleveltmpdir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO Template
"." IO Template
getTemporaryDirectory
#ifndef mingw32_HOST_OS
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Template -> IO Template
mkdtemp forall a b. (a -> b) -> a -> b
$ Template
topleveltmpdir Template -> Template -> Template
</> Template
template)
forall (m :: * -> *). MonadIO m => Template -> m ()
removeTmpDir
Template -> m a
a
#else
withTmpDirIn topleveltmpdir template a
#endif
withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
withTmpDirIn :: forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
Template -> Template -> (Template -> m a) -> m a
withTmpDirIn Template
tmpdir Template
template = forall (m :: * -> *) v b a.
(MonadMask m, MonadIO m) =>
IO v -> (v -> IO b) -> (v -> m a) -> m a
bracketIO IO Template
create forall (m :: * -> *). MonadIO m => Template -> m ()
removeTmpDir
where
create :: IO Template
create = do
Bool -> Template -> IO ()
createDirectoryIfMissing Bool
True Template
tmpdir
forall {a}. (Num a, Show a) => Template -> a -> IO Template
makenewdir (Template
tmpdir Template -> Template -> Template
</> Template
template) (Int
0 :: Int)
makenewdir :: Template -> a -> IO Template
makenewdir Template
t a
n = do
let dir :: Template
dir = Template
t forall a. [a] -> [a] -> [a]
++ Template
"." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Template
show a
n
forall (m :: * -> *) a.
MonadCatch m =>
IOErrorType -> (IOException -> m a) -> m a -> m a
catchIOErrorType IOErrorType
AlreadyExists (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Template -> a -> IO Template
makenewdir Template
t forall a b. (a -> b) -> a -> b
$ a
n forall a. Num a => a -> a -> a
+ a
1) forall a b. (a -> b) -> a -> b
$ do
Template -> IO ()
createDirectory Template
dir
forall (m :: * -> *) a. Monad m => a -> m a
return Template
dir
removeTmpDir :: MonadIO m => FilePath -> m ()
removeTmpDir :: forall (m :: * -> *). MonadIO m => Template -> m ()
removeTmpDir Template
tmpdir = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Template -> IO Bool
doesDirectoryExist Template
tmpdir) forall a b. (a -> b) -> a -> b
$ do
#if mingw32_HOST_OS
_ <- tryIO $ removeDirectoryRecursive tmpdir
return ()
#else
Template -> IO ()
removeDirectoryRecursive Template
tmpdir
#endif