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

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