    {- 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 :: forall (m :: * -> *) v.
    (MonadMask m, MonadIO m) =>
    (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 a. IO a -> m a
    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 a. IO a -> m a
    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 :: forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    FilePath -> (FilePath -> Handle -> m a) -> m a
    withTmpFile FilePath
    template FilePath -> Handle -> m a
    a = do
    	FilePath
    tmpdir <- IO FilePath -> m FilePath
    forall a. IO a -> m a
    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 :: 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 = 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 a. IO a -> m a
    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 a. IO a -> m a
    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 a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> IO Bool
    forall a. a -> IO a
    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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length FilePath
    f