{-# 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 :: Template -> (Template -> m a) -> m a
withTmpDir Template
template Template -> m a
a = do
Template
topleveltmpdir <- IO Template -> m Template
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Template -> m Template) -> IO Template -> m Template
forall a b. (a -> b) -> a -> b
$ Template -> IO Template -> IO Template
forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO Template
"." IO Template
getTemporaryDirectory
#ifndef mingw32_HOST_OS
m Template -> (Template -> m ()) -> (Template -> m a) -> m a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket
(IO Template -> m Template
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Template -> m Template) -> IO Template -> m Template
forall a b. (a -> b) -> a -> b
$ Template -> IO Template
mkdtemp (Template -> IO Template) -> Template -> IO Template
forall a b. (a -> b) -> a -> b
$ Template
topleveltmpdir Template -> Template -> Template
</> Template
template)
Template -> m ()
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 :: Template -> Template -> (Template -> m a) -> m a
withTmpDirIn Template
tmpdir Template
template = IO Template -> (Template -> IO ()) -> (Template -> m a) -> m a
forall (m :: * -> *) v b a.
(MonadMask m, MonadIO m) =>
IO v -> (v -> IO b) -> (v -> m a) -> m a
bracketIO IO Template
create Template -> IO ()
forall (m :: * -> *). MonadIO m => Template -> m ()
removeTmpDir
where
create :: IO Template
create = do
Bool -> Template -> IO ()
createDirectoryIfMissing Bool
True Template
tmpdir
Template -> Int -> IO Template
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 Template -> Template -> Template
forall a. [a] -> [a] -> [a]
++ Template
"." Template -> Template -> Template
forall a. [a] -> [a] -> [a]
++ a -> Template
forall a. Show a => a -> Template
show a
n
IOErrorType
-> (IOException -> IO Template) -> IO Template -> IO Template
forall (m :: * -> *) a.
MonadCatch m =>
IOErrorType -> (IOException -> m a) -> m a -> m a
catchIOErrorType IOErrorType
AlreadyExists (IO Template -> IOException -> IO Template
forall a b. a -> b -> a
const (IO Template -> IOException -> IO Template)
-> IO Template -> IOException -> IO Template
forall a b. (a -> b) -> a -> b
$ Template -> a -> IO Template
makenewdir Template
t (a -> IO Template) -> a -> IO Template
forall a b. (a -> b) -> a -> b
$ a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) (IO Template -> IO Template) -> IO Template -> IO Template
forall a b. (a -> b) -> a -> b
$ do
Template -> IO ()
createDirectory Template
dir
Template -> IO Template
forall (m :: * -> *) a. Monad m => a -> m a
return Template
dir
removeTmpDir :: MonadIO m => FilePath -> m ()
removeTmpDir :: Template -> m ()
removeTmpDir Template
tmpdir = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Template -> IO Bool
doesDirectoryExist Template
tmpdir) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
#if mingw32_HOST_OS
_ <- tryIO $ removeDirectoryRecursive tmpdir
return ()
#else
Template -> IO ()
removeDirectoryRecursive Template
tmpdir
#endif