{-# LANGUAGE CPP, ScopedTypeVariables #-}
-- | Functions to create temporary files and directories.
--
-- Most functions come in two flavours: those that create files/directories
-- under the system standard temporary directory and those that use the
-- user-supplied directory.
--
-- The functions that create files/directories under the system standard
-- temporary directory will return canonical absolute paths (see
-- 'getCanonicalTemporaryDirectory'). The functions use the user-supplied
-- directory do not canonicalize the returned path.
--
-- The action inside 'withTempFile' or 'withTempDirectory' is allowed to
-- remove the temporary file/directory if it needs to.
--
-- == Templates and file names
--
-- The treatment of templates differs somewhat for files vs directories.
--
-- For files, the template has form @name.ext@, and a random number will be
-- placed between between the name and the extension to yield a unique file
-- name, e.g.  @name1804289383846930886.ext@.
--
-- For directories, no extension is recognized.
-- A random hexadecimal string (whose length depends on the system's word
-- size) is appended to the end of the template.
-- For instance,
-- the directory template @dir@ may result in a directory named
-- @dir-e4bd89e5d00acdee@.
--
-- You shouldn't rely on the specific form of file or directory names
-- generated by the library; it has changed in the past and may change in the future.
module System.IO.Temp (
    withSystemTempFile, withSystemTempDirectory,
    withTempFile, withTempDirectory,
    openNewBinaryFile,
    createTempDirectory,
    writeTempFile, writeSystemTempFile,
    emptyTempFile, emptySystemTempFile,
    -- * Re-exports from System.IO
    openTempFile,
    openBinaryTempFile,
    -- * Auxiliary functions
    getCanonicalTemporaryDirectory
  ) where

import qualified Control.Monad.Catch as MC

import Control.Monad.IO.Class
import Data.Bits -- no import list: we use different functions
                 -- depending on the base version
#if !MIN_VERSION_base(4,8,0)
import Data.Word (Word)
#endif
import System.Directory
import System.IO (Handle, hClose, openTempFile, openBinaryTempFile,
       openBinaryTempFileWithDefaultPermissions, hPutStr)
import System.IO.Error        (isAlreadyExistsError)
import System.FilePath        ((</>))
import System.Random
#ifdef mingw32_HOST_OS
import System.Directory       ( createDirectory )
#else
import qualified System.Posix
#endif
import Text.Printf

-- | Create, open, and use a temporary file in the system standard temporary directory.
--
-- The temp file is deleted after use.
--
-- Behaves exactly the same as 'withTempFile', except that the parent temporary directory
-- will be that returned by 'getCanonicalTemporaryDirectory'.
withSystemTempFile :: (MonadIO m, MC.MonadMask m) =>
                      String   -- ^ File name template
                   -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file
                   -> m a
withSystemTempFile :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
template String -> Handle -> m a
action = IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCanonicalTemporaryDirectory m String -> (String -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
tmpDir -> String -> String -> (String -> Handle -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> String -> (String -> Handle -> m a) -> m a
withTempFile String
tmpDir String
template String -> Handle -> m a
action

-- | Create and use a temporary directory in the system standard temporary directory.
--
-- Behaves exactly the same as 'withTempDirectory', except that the parent temporary directory
-- will be that returned by 'getCanonicalTemporaryDirectory'.
withSystemTempDirectory :: (MonadIO m, MC.MonadMask m) =>
                           String   -- ^ Directory name template
                        -> (FilePath -> m a) -- ^ Callback that can use the directory
                        -> m a
withSystemTempDirectory :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
template String -> m a
action = IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCanonicalTemporaryDirectory m String -> (String -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
tmpDir -> String -> String -> (String -> m a) -> m a
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
String -> String -> (String -> m a) -> m a
withTempDirectory String
tmpDir String
template String -> m a
action


-- | Create, open, and use a temporary file in the given directory.
--
-- The temp file is deleted after use.
withTempFile :: (MonadIO m, MC.MonadMask m) =>
                FilePath -- ^ Parent directory to create the file in
             -> String   -- ^ File name template
             -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file
             -> m a
withTempFile :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> String -> (String -> Handle -> m a) -> m a
withTempFile String
tmpDir String
template String -> Handle -> m a
action =
  m (String, Handle)
-> ((String, Handle) -> m ()) -> ((String, Handle) -> m a) -> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
MC.bracket
    (IO (String, Handle) -> m (String, Handle)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> String -> IO (String, Handle)
openTempFile String
tmpDir String
template))
    (\(String
name, Handle
handle) -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
handle IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> IO ()
forall (m :: * -> *). MonadCatch m => m () -> m ()
ignoringIOErrors (String -> IO ()
removeFile String
name)))
    ((String -> Handle -> m a) -> (String, Handle) -> m a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Handle -> m a
action)

-- | Create and use a temporary directory inside the given directory.
--
-- The directory is deleted after use.
withTempDirectory :: (MC.MonadMask m, MonadIO m) =>
                     FilePath -- ^ Parent directory to create the directory in
                  -> String   -- ^ Directory name template
                  -> (FilePath -> m a) -- ^ Callback that can use the directory
                  -> m a
withTempDirectory :: forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
String -> String -> (String -> m a) -> m a
withTempDirectory String
targetDir String
template =
  m String -> (String -> m ()) -> (String -> m a) -> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
MC.bracket
    (IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> String -> IO String
createTempDirectory String
targetDir String
template))
    (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (m :: * -> *). MonadCatch m => m () -> m ()
ignoringIOErrors (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
removeDirectoryRecursive)

-- | Create a unique new file, write (text mode) a given data string to it,
--   and close the handle again. The file will not be deleted automatically,
--   and only the current user will have permission to access the file.
--
-- @since 1.2.1
writeTempFile :: FilePath    -- ^ Parent directory to create the file in
              -> String      -- ^ File name template
              -> String      -- ^ Data to store in the file
              -> IO FilePath -- ^ Path to the (written and closed) file
writeTempFile :: String -> String -> String -> IO String
writeTempFile String
targetDir String
template String
content = IO (String, Handle)
-> ((String, Handle) -> IO ())
-> ((String, Handle) -> IO String)
-> IO String
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
MC.bracket
    (String -> String -> IO (String, Handle)
openTempFile String
targetDir String
template)
    (\(String
_, Handle
handle) -> Handle -> IO ()
hClose Handle
handle)
    (\(String
filePath, Handle
handle) -> Handle -> String -> IO ()
hPutStr Handle
handle String
content IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
filePath)

-- | Like 'writeTempFile', but use the system directory for temporary files.
--
-- @since 1.2.1
writeSystemTempFile :: String      -- ^ File name template
                    -> String      -- ^ Data to store in the file
                    -> IO FilePath -- ^ Path to the (written and closed) file
writeSystemTempFile :: String -> String -> IO String
writeSystemTempFile String
template String
content
    = IO String
getCanonicalTemporaryDirectory IO String -> (String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
tmpDir -> String -> String -> String -> IO String
writeTempFile String
tmpDir String
template String
content

-- | Create a unique new empty file. (Equivalent to 'writeTempFile' with empty data string.)
--   This is useful if the actual content is provided by an external process.
--
-- @since 1.2.1
emptyTempFile :: FilePath    -- ^ Parent directory to create the file in
              -> String      -- ^ File name template
              -> IO FilePath -- ^ Path to the (written and closed) file
emptyTempFile :: String -> String -> IO String
emptyTempFile String
targetDir String
template = IO (String, Handle)
-> ((String, Handle) -> IO ())
-> ((String, Handle) -> IO String)
-> IO String
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
MC.bracket
    (String -> String -> IO (String, Handle)
openTempFile String
targetDir String
template)
    (\(String
_, Handle
handle) -> Handle -> IO ()
hClose Handle
handle)
    (\(String
filePath, Handle
_) -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
filePath)

-- | Like 'emptyTempFile', but use the system directory for temporary files.
--
-- @since 1.2.1
emptySystemTempFile :: String      -- ^ File name template
                    -> IO FilePath -- ^ Path to the (written and closed) file
emptySystemTempFile :: String -> IO String
emptySystemTempFile String
template
    = IO String
getCanonicalTemporaryDirectory IO String -> (String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
tmpDir -> String -> String -> IO String
emptyTempFile String
tmpDir String
template


ignoringIOErrors :: MC.MonadCatch m => m () -> m ()
ignoringIOErrors :: forall (m :: * -> *). MonadCatch m => m () -> m ()
ignoringIOErrors m ()
ioe = m ()
ioe m () -> (IOError -> m ()) -> m ()
forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`MC.catch` (\IOError
e -> m () -> IOError -> m ()
forall a b. a -> b -> a
const (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IOError
e :: IOError))

-- | Like 'openBinaryTempFile', but uses 666 rather than 600 for the
-- permissions.
--
-- Equivalent to 'openBinaryTempFileWithDefaultPermissions'.
openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle)
openNewBinaryFile :: String -> String -> IO (String, Handle)
openNewBinaryFile = String -> String -> IO (String, Handle)
openBinaryTempFileWithDefaultPermissions

-- | Create a temporary directory.
createTempDirectory
  :: FilePath -- ^ Parent directory to create the directory in
  -> String -- ^ Directory name template
  -> IO FilePath
createTempDirectory :: String -> String -> IO String
createTempDirectory String
dir String
template = IO String
findTempName
  where
    findTempName :: IO String
findTempName = do
      Word
x :: Word <- IO Word
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
      let dirpath :: String
dirpath = String
dir String -> String -> String
</> String
template String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Int -> Word -> String
forall r. PrintfType r => String -> r
printf String
"-%.*x" (Int
wordSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) Word
x
      Either IOError ()
r <- IO () -> IO (Either IOError ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
MC.try (IO () -> IO (Either IOError ()))
-> IO () -> IO (Either IOError ())
forall a b. (a -> b) -> a -> b
$ String -> IO ()
mkPrivateDir String
dirpath
      case Either IOError ()
r of
        Right ()
_ -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
dirpath
        Left  IOError
e | IOError -> Bool
isAlreadyExistsError IOError
e -> IO String
findTempName
                | Bool
otherwise              -> IOError -> IO String
forall a. IOError -> IO a
ioError IOError
e

-- | Word size in bits
wordSize :: Int
wordSize :: Int
wordSize =
#if MIN_VERSION_base(4,7,0)
 Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
forall a. HasCallStack => a
undefined :: Word)
#else
  bitSize (undefined :: Word)
#endif

mkPrivateDir :: String -> IO ()
#ifdef mingw32_HOST_OS
mkPrivateDir s = createDirectory s
#else
mkPrivateDir :: String -> IO ()
mkPrivateDir String
s = String -> FileMode -> IO ()
System.Posix.createDirectory String
s FileMode
0o700
#endif

-- | Return the absolute and canonical path to the system temporary
-- directory.
--
-- >>> setCurrentDirectory "/home/feuerbach/"
-- >>> setEnv "TMPDIR" "."
-- >>> getTemporaryDirectory
-- "."
-- >>> getCanonicalTemporaryDirectory
-- "/home/feuerbach"
getCanonicalTemporaryDirectory :: IO FilePath
getCanonicalTemporaryDirectory :: IO String
getCanonicalTemporaryDirectory = IO String
getTemporaryDirectory IO String -> (String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
canonicalizePath