{-# LANGUAgE CPP #-}
-- | Temporary file and directory support.
--
-- Strongly inspired by\/stolen from the <https://github.com/feuerbach/temporary> package.
--
-- @since 0.1.0.0
--
-- === __Copyright notice:__
--
-- The following copyright notice is taken from <https://github.com/feuerbach/temporary>
-- and is reproduced here as part of license terms of that package, of which this module is
-- a derivate work.
--
-- @
-- Copyright
--   (c) 2003-2006, Isaac Jones
--   (c) 2005-2009, Duncan Coutts
--   (c) 2008, Maximilian Bolingbroke
--   ... and other contributors
--
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without modification, are permitted
-- provided that the following conditions are met:
--
--     * Redistributions of source code must retain the above copyright notice, this list of
--       conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright notice, this list of
--       conditions and the following disclaimer in the documentation and/or other materials
--       provided with the distribution.
--     * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to
--       endorse or promote products derived from this software without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-- FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
-- IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
-- OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-- @
module UnliftIO.Temporary
  ( withSystemTempFile
  , withSystemTempDirectory
  , withTempFile
  , withTempDirectory
  ) where

import Control.Monad.IO.Unlift
import Control.Monad (liftM)
import UnliftIO.Exception
import System.Directory
import System.IO (Handle, openTempFile, hClose)
import System.IO.Error
import System.Posix.Internals (c_getpid)
import System.FilePath ((</>))

#ifdef mingw32_HOST_OS
import System.Directory       ( createDirectory )
#else
import qualified System.Posix
#endif

-- | Create and use a temporary file in the system standard temporary directory.
--
-- Behaves exactly the same as 'withTempFile', except that the parent temporary directory
-- will be that returned by 'getCanonicalTemporaryDirectory'.
--
-- @since 0.1.0.0
withSystemTempFile :: MonadUnliftIO m =>
                      String   -- ^ File name template. See 'openTempFile'.
                   -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file
                   -> m a
withSystemTempFile :: forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
template String -> Handle -> m a
action = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCanonicalTemporaryDirectory forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
tmpDir -> forall (m :: * -> *) a.
MonadUnliftIO 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'.
--
-- @since 0.1.0.0
withSystemTempDirectory :: MonadUnliftIO m =>
                           String   -- ^ Directory name template. See 'openTempFile'.
                        -> (FilePath -> m a) -- ^ Callback that can use the directory.
                        -> m a
withSystemTempDirectory :: forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
template String -> m a
action = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCanonicalTemporaryDirectory forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
tmpDir -> forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> String -> (String -> m a) -> m a
withTempDirectory String
tmpDir String
template String -> m a
action


-- | Use a temporary filename that doesn't already exist.
--
-- Creates a new temporary file inside the given directory, making use of the
-- template. The temp file is deleted after use. For example:
--
-- > withTempFile "src" "sdist." $ \tmpFile hFile -> do ...
--
-- The @tmpFile@ will be file in the given directory, e.g.
-- @src/sdist.342@.
--
-- @since 0.1.0.0
withTempFile :: MonadUnliftIO m =>
                FilePath -- ^ Temp dir to create the file in.
             -> String   -- ^ File name template. See 'openTempFile'.
             -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file.
             -> m a
withTempFile :: forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> String -> (String -> Handle -> m a) -> m a
withTempFile String
tmpDir String
template String -> Handle -> m a
action =
  forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> String -> IO (String, Handle)
openTempFile String
tmpDir String
template))
    (\(String
name, Handle
handle') -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
handle' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). MonadUnliftIO m => m () -> m ()
ignoringIOErrors (String -> IO ()
removeFile String
name)))
    (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Handle -> m a
action)

-- | Create and use a temporary directory.
--
-- Creates a new temporary directory inside the given directory, making use
-- of the template. The temp directory is deleted after use. For example:
--
-- > withTempDirectory "src" "sdist." $ \tmpDir -> do ...
--
-- The @tmpDir@ will be a new subdirectory of the given directory, e.g.
-- @src/sdist.342@.
--
-- @since 0.1.0.0
withTempDirectory :: MonadUnliftIO m =>
                     FilePath -- ^ Temp directory to create the directory in.
                  -> String   -- ^ Directory name template. See 'openTempFile'.
                  -> (FilePath -> m a) -- ^ Callback that can use the directory.
                  -> m a
withTempDirectory :: forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> String -> (String -> m a) -> m a
withTempDirectory String
targetDir String
template =
  forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> String -> IO String
createTempDirectory String
targetDir String
template))
    (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadUnliftIO m => m () -> m ()
ignoringIOErrors forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
removeDirectoryRecursive)

-- | 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
canonicalizePath

-- | Create a temporary directory. See 'withTempDirectory'.
createTempDirectory
  :: FilePath -- ^ Temp directory to create the directory in.
  -> String -- ^ Directory name template.
  -> IO FilePath
createTempDirectory :: String -> String -> IO String
createTempDirectory String
dir String
template = do
  CPid
pid <- IO CPid
c_getpid
  forall {t}. (Num t, Show t) => t -> IO String
findTempName CPid
pid
  where
    findTempName :: t -> IO String
findTempName t
x = do
      let dirpath :: String
dirpath = String
dir String -> String -> String
</> String
template forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show t
x
      Either IOError ()
r <- forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ String -> IO ()
mkPrivateDir String
dirpath
      case Either IOError ()
r of
        Right ()
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
dirpath
        Left  IOError
e | IOError -> Bool
isAlreadyExistsError IOError
e -> t -> IO String
findTempName (t
xforall a. Num a => a -> a -> a
+t
1)
                | Bool
otherwise              -> forall a. IOError -> IO a
ioError IOError
e


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

ignoringIOErrors :: MonadUnliftIO m => m () -> m ()
ignoringIOErrors :: forall (m :: * -> *). MonadUnliftIO m => m () -> m ()
ignoringIOErrors = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. a -> b -> a
const ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOError a)
tryIO -- yes, it's just void, but for pre-AMP GHCs