{-# LANGUAgE CPP #-}
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
withSystemTempFile :: MonadUnliftIO m =>
String
-> (FilePath -> Handle -> m a)
-> 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
withSystemTempDirectory :: MonadUnliftIO m =>
String
-> (FilePath -> m a)
-> 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
withTempFile :: MonadUnliftIO m =>
FilePath
-> String
-> (FilePath -> Handle -> m a)
-> 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)
withTempDirectory :: MonadUnliftIO m =>
FilePath
-> String
-> (FilePath -> m a)
-> 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)
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
createTempDirectory
:: FilePath
-> String
-> 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