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

{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}

module Utility.Tmp where

import System.IO
import System.FilePath
import System.Directory
import Control.Monad.IO.Class
import System.PosixCompat.Files

import Utility.Exception
import Utility.FileSystemEncoding

type Template = String

{- Runs an action like writeFile, writing to a temp file first and
 - then moving it into place. The temp file is stored in the same
 - directory as the final file to avoid cross-device renames. -}
viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> v -> m ()) -> FilePath -> v -> m ()
viaTmp :: (FilePath -> v -> m ()) -> FilePath -> v -> m ()
viaTmp FilePath -> v -> m ()
a FilePath
file v
content = IO (FilePath, Handle)
-> ((FilePath, Handle) -> IO (Either IOException ()))
-> ((FilePath, Handle) -> m ())
-> m ()
forall (m :: * -> *) v b a.
(MonadMask m, MonadIO m) =>
IO v -> (v -> IO b) -> (v -> m a) -> m a
bracketIO IO (FilePath, Handle)
setup (FilePath, Handle) -> IO (Either IOException ())
cleanup (FilePath, Handle) -> m ()
use
  where
	(FilePath
dir, FilePath
base) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
file
	template :: FilePath
template = FilePath
base FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".tmp"
	setup :: IO (FilePath, Handle)
setup = do
		Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
		FilePath -> FilePath -> IO (FilePath, Handle)
openTempFile FilePath
dir FilePath
template
	cleanup :: (FilePath, Handle) -> IO (Either IOException ())
cleanup (FilePath
tmpfile, Handle
h) = do
		Either IOException ()
_ <- IO () -> IO (Either IOException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h
		IO () -> IO (Either IOException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either IOException a)
tryIO (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeFile FilePath
tmpfile
	use :: (FilePath, Handle) -> m ()
use (FilePath
tmpfile, Handle
h) = do
		IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h
		FilePath -> v -> m ()
a FilePath
tmpfile v
content
		IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
rename FilePath
tmpfile FilePath
file

{- Runs an action with a tmp file located in the system's tmp directory
 - (or in "." if there is none) then removes the file. -}
withTmpFile :: (MonadIO m, MonadMask m) => Template -> (FilePath -> Handle -> m a) -> m a
withTmpFile :: FilePath -> (FilePath -> Handle -> m a) -> m a
withTmpFile FilePath
template FilePath -> Handle -> m a
a = do
	FilePath
tmpdir <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath -> IO FilePath
forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO FilePath
"." IO FilePath
getTemporaryDirectory
	FilePath -> FilePath -> (FilePath -> Handle -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> FilePath -> (FilePath -> Handle -> m a) -> m a
withTmpFileIn FilePath
tmpdir FilePath
template FilePath -> Handle -> m a
a

{- Runs an action with a tmp file located in the specified directory,
 - then removes the file. -}
withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath -> Handle -> m a) -> m a
withTmpFileIn :: FilePath -> FilePath -> (FilePath -> Handle -> m a) -> m a
withTmpFileIn FilePath
tmpdir FilePath
template FilePath -> Handle -> m a
a = m (FilePath, Handle)
-> ((FilePath, Handle) -> m Bool)
-> ((FilePath, Handle) -> m a)
-> m a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket m (FilePath, Handle)
create (FilePath, Handle) -> m Bool
forall (m :: * -> *). MonadIO m => (FilePath, Handle) -> m Bool
remove (FilePath, Handle) -> m a
use
  where
	create :: m (FilePath, Handle)
create = IO (FilePath, Handle) -> m (FilePath, Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FilePath, Handle) -> m (FilePath, Handle))
-> IO (FilePath, Handle) -> m (FilePath, Handle)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO (FilePath, Handle)
openTempFile FilePath
tmpdir FilePath
template
	remove :: (FilePath, Handle) -> m Bool
remove (FilePath
name, Handle
h) = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
		Handle -> IO ()
hClose Handle
h
		IO Bool -> IO Bool
forall (m :: * -> *). MonadCatch m => m Bool -> m Bool
catchBoolIO (FilePath -> IO ()
removeFile FilePath
name IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
	use :: (FilePath, Handle) -> m a
use (FilePath
name, Handle
h) = FilePath -> Handle -> m a
a FilePath
name Handle
h

{- It's not safe to use a FilePath of an existing file as the template
 - for openTempFile, because if the FilePath is really long, the tmpfile
 - will be longer, and may exceed the maximum filename length.
 -
 - This generates a template that is never too long.
 - (Well, it allocates 20 characters for use in making a unique temp file,
 - anyway, which is enough for the current implementation and any
 - likely implementation.)
 -}
relatedTemplate :: FilePath -> FilePath
relatedTemplate :: FilePath -> FilePath
relatedTemplate FilePath
f
	| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20 = Int -> FilePath -> FilePath
truncateFilePath (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
20) FilePath
f
	| Bool
otherwise = FilePath
f
  where
	len :: Int
len = FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
f