    {- Temporary directories
     -
     - Copyright 2010-2013 Joey Hess <id@joeyh.name>
     -
     - License: BSD-2-clause
     -}

    {-# 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)

    {- Runs an action with a tmp directory located within the system's tmp
     - directory (or within "." if there is none), then removes the tmp
     - directory and all its contents. -}
    withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
    withTmpDir :: Template -> (Template -> m a) -> m a
    withTmpDir template :: Template
    template a :: 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 "." IO Template
    getTemporaryDirectory
    #ifndef mingw32_HOST_OS
    	-- Use mkdtemp to create a temp directory securely in /tmp.
    	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

    {- Runs an action with a tmp directory located within a specified directory,
     - then removes the tmp directory and all its contents. -}
    withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
    withTmpDirIn :: Template -> Template -> (Template -> m a) -> m a
    withTmpDirIn tmpdir :: Template
    tmpdir template :: 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) (0 :: Int)
    	makenewdir :: Template -> a -> IO Template
    makenewdir t :: Template
    t n :: a
    n = do
    		let dir :: Template
    dir = Template
    t Template -> Template -> Template
    forall a. [a] -> [a] -> [a]
    ++ "." 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
    + 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

    {- Deletes the entire contents of the the temporary directory, if it
     - exists. -}
    removeTmpDir :: MonadIO m => FilePath -> m ()
    removeTmpDir :: Template -> m ()
    removeTmpDir tmpdir :: 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
    	-- Windows will often refuse to delete a file
    	-- after a process has just written to it and exited.
    	-- Because it's crap, presumably. So, ignore failure
    	-- to delete the temp directory.
    	_ <- tryIO $ removeDirectoryRecursive tmpdir
    	return ()
    #else
    	Template -> IO ()
    removeDirectoryRecursive Template
    tmpdir
    #endif