{- 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 :: 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
	-- Use mkdtemp to create a temp directory securely in /tmp.
	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

{- 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 :: 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

{- Deletes the entire contents of the the temporary directory, if it
 - exists. -}
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
	-- 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