{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ViewPatterns #-}

module System.File.OsPath.Internal where


import qualified System.File.Platform as P

import Prelude ((.), ($), String, IO, ioError, pure, either, const, flip, Maybe(..), fmap, (<$>), id, Bool(..), FilePath, (++), return, show, (>>=), (==), otherwise, userError)
import GHC.IO (catchException)
import GHC.IO.Exception (IOException(..))
import GHC.IO.Handle (hClose_help)
import GHC.IO.Handle.Internals (debugIO)
import GHC.IO.Handle.Types (Handle__, Handle(..))
import Control.Concurrent.MVar
import Control.Monad (void, when)
import Control.DeepSeq (force)
import Control.Exception (SomeException, try, evaluate, mask, onException, throwIO)
import System.IO (IOMode(..), hSetBinaryMode, hClose)
import System.IO.Unsafe (unsafePerformIO)
import System.OsPath as OSP
import System.OsString.Internal.Types

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import System.Posix.Types (CMode)
#if MIN_VERSION_filepath(1, 5, 0)
import qualified System.OsString as OSS
#else
import Data.Coerce
#endif

-- | Like 'openFile', but open the file in binary mode.
-- On Windows, reading a file in text mode (which is the default)
-- will translate CRLF to LF, and writing will translate LF to CRLF.
-- This is usually what you want with text files.  With binary files
-- this is undesirable; also, as usual under Microsoft operating systems,
-- text mode treats control-Z as EOF.  Binary mode turns off all special
-- treatment of end-of-line and end-of-file characters.
-- (See also 'System.IO.hSetBinaryMode'.)

-- On POSIX systems, 'openBinaryFile' is an /interruptible operation/ as
-- described in "Control.Exception".
openBinaryFile :: OsPath -> IOMode -> IO Handle
openBinaryFile :: OsString -> IOMode -> IO Handle
openBinaryFile OsString
osfp IOMode
iomode = [Char] -> OsString -> IO Handle -> IO Handle
forall a. [Char] -> OsString -> IO a -> IO a
augmentError [Char]
"openBinaryFile" OsString
osfp (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsString
osfp IOMode
iomode Bool
True Bool
False Bool
False Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


-- | Run an action on a file.
--
-- The 'Handle' is automatically closed afther the action.
withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile :: forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
withFile OsString
osfp IOMode
iomode Handle -> IO r
act = ([Char]
-> OsString -> IO (Either IOError r) -> IO (Either IOError r)
forall a. [Char] -> OsString -> IO a -> IO a
augmentError [Char]
"withFile" OsString
osfp
    (IO (Either IOError r) -> IO (Either IOError r))
-> IO (Either IOError r) -> IO (Either IOError r)
forall a b. (a -> b) -> a -> b
$ OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO (Either IOError r))
-> Bool
-> IO (Either IOError r)
forall r.
OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsString
osfp IOMode
iomode Bool
False Bool
False Bool
False (IO r -> IO (Either IOError r)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO r -> IO (Either IOError r))
-> (Handle -> IO r) -> Handle -> IO (Either IOError r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO r
act) Bool
True)
  IO (Either IOError r) -> (Either IOError r -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOError -> IO r) -> (r -> IO r) -> Either IOError r -> IO r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOError -> IO r
forall a. IOError -> IO a
ioError r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

withBinaryFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile :: forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile OsString
osfp IOMode
iomode Handle -> IO r
act = ([Char]
-> OsString -> IO (Either IOError r) -> IO (Either IOError r)
forall a. [Char] -> OsString -> IO a -> IO a
augmentError [Char]
"withBinaryFile" OsString
osfp
    (IO (Either IOError r) -> IO (Either IOError r))
-> IO (Either IOError r) -> IO (Either IOError r)
forall a b. (a -> b) -> a -> b
$ OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO (Either IOError r))
-> Bool
-> IO (Either IOError r)
forall r.
OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsString
osfp IOMode
iomode Bool
True Bool
False Bool
False (IO r -> IO (Either IOError r)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO r -> IO (Either IOError r))
-> (Handle -> IO r) -> Handle -> IO (Either IOError r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO r
act) Bool
True)
  IO (Either IOError r) -> (Either IOError r -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOError -> IO r) -> (r -> IO r) -> Either IOError r -> IO r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOError -> IO r
forall a. IOError -> IO a
ioError r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Run an action on a file.
--
-- The 'Handle' is not automatically closed to allow lazy IO. Use this
-- with caution.
withFile'
  :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile' :: forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
withFile' OsString
osfp IOMode
iomode Handle -> IO r
act = ([Char]
-> OsString -> IO (Either IOError r) -> IO (Either IOError r)
forall a. [Char] -> OsString -> IO a -> IO a
augmentError [Char]
"withFile'" OsString
osfp
    (IO (Either IOError r) -> IO (Either IOError r))
-> IO (Either IOError r) -> IO (Either IOError r)
forall a b. (a -> b) -> a -> b
$ OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO (Either IOError r))
-> Bool
-> IO (Either IOError r)
forall r.
OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsString
osfp IOMode
iomode Bool
False Bool
False Bool
False (IO r -> IO (Either IOError r)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO r -> IO (Either IOError r))
-> (Handle -> IO r) -> Handle -> IO (Either IOError r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO r
act) Bool
False)
  IO (Either IOError r) -> (Either IOError r -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOError -> IO r) -> (r -> IO r) -> Either IOError r -> IO r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOError -> IO r
forall a. IOError -> IO a
ioError r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

withBinaryFile'
  :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile' :: forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile' OsString
osfp IOMode
iomode Handle -> IO r
act = ([Char]
-> OsString -> IO (Either IOError r) -> IO (Either IOError r)
forall a. [Char] -> OsString -> IO a -> IO a
augmentError [Char]
"withBinaryFile'" OsString
osfp
    (IO (Either IOError r) -> IO (Either IOError r))
-> IO (Either IOError r) -> IO (Either IOError r)
forall a b. (a -> b) -> a -> b
$ OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO (Either IOError r))
-> Bool
-> IO (Either IOError r)
forall r.
OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsString
osfp IOMode
iomode Bool
True Bool
False Bool
False (IO r -> IO (Either IOError r)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO r -> IO (Either IOError r))
-> (Handle -> IO r) -> Handle -> IO (Either IOError r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO r
act) Bool
False)
  IO (Either IOError r) -> (Either IOError r -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOError -> IO r) -> (r -> IO r) -> Either IOError r -> IO r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOError -> IO r
forall a. IOError -> IO a
ioError r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | The 'readFile' function reads a file and returns the contents of the file
-- as a 'ByteString'. The file is read lazily, on demand.
readFile :: OsPath -> IO BSL.ByteString
readFile :: OsString -> IO ByteString
readFile OsString
fp = OsString -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
withFile' OsString
fp IOMode
ReadMode Handle -> IO ByteString
BSL.hGetContents

-- | The 'readFile'' function reads a file and returns the contents of the file
-- as a 'ByteString'. The file is fully read before being returned.
readFile'
  :: OsPath -> IO BS.ByteString
readFile' :: OsString -> IO ByteString
readFile' OsString
fp = OsString -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
withFile OsString
fp IOMode
ReadMode Handle -> IO ByteString
BS.hGetContents

-- | The computation 'writeFile' @file str@ function writes the lazy 'ByteString' @str@,
-- to the file @file@.
writeFile :: OsPath -> BSL.ByteString -> IO ()
writeFile :: OsString -> ByteString -> IO ()
writeFile OsString
fp ByteString
contents = OsString -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
withFile OsString
fp IOMode
WriteMode (Handle -> ByteString -> IO ()
`BSL.hPut` ByteString
contents)

-- | The computation 'writeFile' @file str@ function writes the strict 'ByteString' @str@,
-- to the file @file@.
writeFile'
  :: OsPath -> BS.ByteString -> IO ()
writeFile' :: OsString -> ByteString -> IO ()
writeFile' OsString
fp ByteString
contents = OsString -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
withFile OsString
fp IOMode
WriteMode (Handle -> ByteString -> IO ()
`BS.hPut` ByteString
contents)

-- | The computation 'appendFile' @file str@ function appends the lazy 'ByteString' @str@,
-- to the file @file@.
appendFile :: OsPath -> BSL.ByteString -> IO ()
appendFile :: OsString -> ByteString -> IO ()
appendFile OsString
fp ByteString
contents = OsString -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
withFile OsString
fp IOMode
AppendMode (Handle -> ByteString -> IO ()
`BSL.hPut` ByteString
contents)

-- | The computation 'appendFile' @file str@ function appends the strict 'ByteString' @str@,
-- to the file @file@.
appendFile'
  :: OsPath -> BS.ByteString -> IO ()
appendFile' :: OsString -> ByteString -> IO ()
appendFile' OsString
fp ByteString
contents = OsString -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. OsString -> IOMode -> (Handle -> IO r) -> IO r
withFile OsString
fp IOMode
AppendMode (Handle -> ByteString -> IO ()
`BS.hPut` ByteString
contents)

-- | Open a file and return the 'Handle'.
openFile :: OsPath -> IOMode -> IO Handle
openFile :: OsString -> IOMode -> IO Handle
openFile OsString
osfp IOMode
iomode = [Char] -> OsString -> IO Handle -> IO Handle
forall a. [Char] -> OsString -> IO a -> IO a
augmentError [Char]
"openFile" OsString
osfp (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsString
osfp IOMode
iomode Bool
False Bool
False Bool
False Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


-- | Open an existing file and return the 'Handle'.
openExistingFile :: OsPath -> IOMode -> IO Handle
openExistingFile :: OsString -> IOMode -> IO Handle
openExistingFile OsString
osfp IOMode
iomode = [Char] -> OsString -> IO Handle -> IO Handle
forall a. [Char] -> OsString -> IO a -> IO a
augmentError [Char]
"openExistingFile" OsString
osfp (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsString
osfp IOMode
iomode Bool
False Bool
True Bool
False Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- | Open a file and return the 'Handle'.
--
-- Sets @O_CLOEXEC@ on posix.
--
-- @since 0.1.2
openFileWithCloseOnExec :: OsPath -> IOMode -> IO Handle
openFileWithCloseOnExec :: OsString -> IOMode -> IO Handle
openFileWithCloseOnExec OsString
osfp IOMode
iomode = [Char] -> OsString -> IO Handle -> IO Handle
forall a. [Char] -> OsString -> IO a -> IO a
augmentError [Char]
"openFileWithCloseOnExec" OsString
osfp (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsString
osfp IOMode
iomode Bool
False Bool
False Bool
True Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


-- | Open an existing file and return the 'Handle'.
--
-- Sets @O_CLOEXEC@ on posix.
--
-- @since 0.1.2
openExistingFileWithCloseOnExec :: OsPath -> IOMode -> IO Handle
openExistingFileWithCloseOnExec :: OsString -> IOMode -> IO Handle
openExistingFileWithCloseOnExec OsString
osfp IOMode
iomode = [Char] -> OsString -> IO Handle -> IO Handle
forall a. [Char] -> OsString -> IO a -> IO a
augmentError [Char]
"openExistingFileWithCloseOnExec" OsString
osfp (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsString
osfp IOMode
iomode Bool
False Bool
True Bool
True Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


-- | The function creates a temporary file in ReadWrite mode.
-- The created file isn\'t deleted automatically, so you need to delete it manually.
--
-- The file is created with permissions such that only the current
-- user can read\/write it.
--
-- With some exceptions (see below), the file will be created securely
-- in the sense that an attacker should not be able to cause
-- openTempFile to overwrite another file on the filesystem using your
-- credentials, by putting symbolic links (on Unix) in the place where
-- the temporary file is to be created.  On Unix the @O_CREAT@ and
-- @O_EXCL@ flags are used to prevent this attack, but note that
-- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you
-- rely on this behaviour it is best to use local filesystems only.
--
-- @since 0.1.3
openTempFile :: OsPath     -- ^ Directory in which to create the file
             -> OsString   -- ^ File name template. If the template is \"foo.ext\" then
                           -- the created file will be \"fooXXX.ext\" where XXX is some
                           -- random number. Note that this should not contain any path
                           -- separator characters. On Windows, the template prefix may
                           -- be truncated to 3 chars, e.g. \"foobar.ext\" will be
                           -- \"fooXXX.ext\".
             -> IO (OsPath, Handle)
openTempFile :: OsString -> OsString -> IO (OsString, Handle)
openTempFile OsString
tmp_dir OsString
template = [Char]
-> OsString -> OsString -> Bool -> CMode -> IO (OsString, Handle)
openTempFile' [Char]
"openTempFile" OsString
tmp_dir OsString
template Bool
False CMode
0o600

-- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
--
-- @since 0.1.3
openBinaryTempFile :: OsPath -> OsString -> IO (OsPath, Handle)
openBinaryTempFile :: OsString -> OsString -> IO (OsString, Handle)
openBinaryTempFile OsString
tmp_dir OsString
template
    = [Char]
-> OsString -> OsString -> Bool -> CMode -> IO (OsString, Handle)
openTempFile' [Char]
"openBinaryTempFile" OsString
tmp_dir OsString
template Bool
True CMode
0o600

-- | Like 'openTempFile', but uses the default file permissions
--
-- @since 0.1.3
openTempFileWithDefaultPermissions :: OsPath -> OsString
                                   -> IO (OsPath, Handle)
openTempFileWithDefaultPermissions :: OsString -> OsString -> IO (OsString, Handle)
openTempFileWithDefaultPermissions OsString
tmp_dir OsString
template
    = [Char]
-> OsString -> OsString -> Bool -> CMode -> IO (OsString, Handle)
openTempFile' [Char]
"openTempFileWithDefaultPermissions" OsString
tmp_dir OsString
template Bool
False CMode
0o666

-- | Like 'openBinaryTempFile', but uses the default file permissions
--
-- @since 0.1.3
openBinaryTempFileWithDefaultPermissions :: OsPath -> OsString
                                         -> IO (OsPath, Handle)
openBinaryTempFileWithDefaultPermissions :: OsString -> OsString -> IO (OsString, Handle)
openBinaryTempFileWithDefaultPermissions OsString
tmp_dir OsString
template
    = [Char]
-> OsString -> OsString -> Bool -> CMode -> IO (OsString, Handle)
openTempFile' [Char]
"openBinaryTempFileWithDefaultPermissions" OsString
tmp_dir OsString
template Bool
True CMode
0o666

-- ---------------------------------------------------------------------------
-- Internals

handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
handleFinalizer :: [Char] -> MVar Handle__ -> IO ()
handleFinalizer [Char]
_fp MVar Handle__
m = do
  Handle__
handle_ <- MVar Handle__ -> IO Handle__
forall a. MVar a -> IO a
takeMVar MVar Handle__
m
  (Handle__
handle_', Maybe SomeException
_) <- Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help Handle__
handle_
  MVar Handle__ -> Handle__ -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Handle__
m Handle__
handle_'
  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()

-- | Add a finalizer to a 'Handle'. Specifically, the finalizer
-- will be added to the 'MVar' of a file handle or the write-side
-- 'MVar' of a duplex handle. See Handle Finalizers for details.
addHandleFinalizer :: Handle -> HandleFinalizer -> IO ()
addHandleFinalizer :: Handle -> ([Char] -> MVar Handle__ -> IO ()) -> IO ()
addHandleFinalizer Handle
hndl [Char] -> MVar Handle__ -> IO ()
finalizer = do
  [Char] -> IO ()
debugIO ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Registering finalizer: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
filepath
  IO (Weak (MVar Handle__)) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Weak (MVar Handle__)) -> IO ())
-> IO (Weak (MVar Handle__)) -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar Handle__ -> IO () -> IO (Weak (MVar Handle__))
forall a. MVar a -> IO () -> IO (Weak (MVar a))
mkWeakMVar MVar Handle__
mv ([Char] -> MVar Handle__ -> IO ()
finalizer [Char]
filepath MVar Handle__
mv)
  where
    !([Char]
filepath, !MVar Handle__
mv) = case Handle
hndl of
      FileHandle [Char]
fp MVar Handle__
m -> ([Char]
fp, MVar Handle__
m)
      DuplexHandle [Char]
fp MVar Handle__
_ MVar Handle__
write_m -> ([Char]
fp, MVar Handle__
write_m)

withOpenFile' :: OsPath -> IOMode -> Bool -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' :: forall r.
OsString
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' (OsString PosixString
fp) IOMode
iomode Bool
binary Bool
existing Bool
cloExec Handle -> IO r
action Bool
close_finally = ((forall a. IO a -> IO a) -> IO r) -> IO r
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO r) -> IO r)
-> ((forall a. IO a -> IO a) -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
  Handle
hndl <- case (Bool
existing, Bool
cloExec) of
            (Bool
True, Bool
False) -> PosixString -> IOMode -> IO Handle
P.openExistingFile PosixString
fp IOMode
iomode
            (Bool
False, Bool
False) -> PosixString -> IOMode -> IO Handle
P.openFile PosixString
fp IOMode
iomode
            (Bool
True, Bool
True) -> PosixString -> IOMode -> IO Handle
P.openExistingFileWithCloseOnExec PosixString
fp IOMode
iomode
            (Bool
False, Bool
True) -> PosixString -> IOMode -> IO Handle
P.openFileWithCloseOnExec PosixString
fp IOMode
iomode
  Handle -> ([Char] -> MVar Handle__ -> IO ()) -> IO ()
addHandleFinalizer Handle
hndl [Char] -> MVar Handle__ -> IO ()
handleFinalizer
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
binary (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Bool -> IO ()
hSetBinaryMode Handle
hndl Bool
True
  r
r <- IO r -> IO r
forall a. IO a -> IO a
restore (Handle -> IO r
action Handle
hndl) IO r -> IO () -> IO r
forall a b. IO a -> IO b -> IO a
`onException` Handle -> IO ()
hClose Handle
hndl
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
close_finally (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
hndl
  r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r

addFilePathToIOError :: String -> OsPath -> IOException -> IOException
addFilePathToIOError :: [Char] -> OsString -> IOError -> IOError
addFilePathToIOError [Char]
fun OsString
fp IOError
ioe = IO IOError -> IOError
forall a. IO a -> a
unsafePerformIO (IO IOError -> IOError) -> IO IOError -> IOError
forall a b. (a -> b) -> a -> b
$ do
  [Char]
fp'  <- (SomeException -> [Char])
-> ([Char] -> [Char]) -> Either SomeException [Char] -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> SomeException -> [Char]
forall a b. a -> b -> a
const ((OsChar -> Char) -> [OsChar] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OsChar -> Char
OSP.toChar ([OsChar] -> [Char])
-> (OsString -> [OsChar]) -> OsString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> [OsChar]
OSP.unpack (OsString -> [Char]) -> OsString -> [Char]
forall a b. (a -> b) -> a -> b
$ OsString
fp)) [Char] -> [Char]
forall a. a -> a
id (Either SomeException [Char] -> [Char])
-> IO (Either SomeException [Char]) -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException (OsString -> IO [Char]
OSP.decodeFS OsString
fp)
  [Char]
fp'' <- [Char] -> IO [Char]
forall a. a -> IO a
evaluate ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. NFData a => a -> a
force [Char]
fp'
  IOError -> IO IOError
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IOError -> IO IOError) -> IOError -> IO IOError
forall a b. (a -> b) -> a -> b
$ IOError
ioe{ ioe_location = fun, ioe_filename = Just fp'' }

augmentError :: String -> OsPath -> IO a -> IO a
augmentError :: forall a. [Char] -> OsString -> IO a -> IO a
augmentError [Char]
str OsString
osfp = (IO a -> (IOError -> IO a) -> IO a)
-> (IOError -> IO a) -> IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catchException (IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> (IOError -> IOError) -> IOError -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> OsString -> IOError -> IOError
addFilePathToIOError [Char]
str OsString
osfp)


openTempFile' :: String -> OsPath -> OsString -> Bool -> CMode
              -> IO (OsPath, Handle)
openTempFile' :: [Char]
-> OsString -> OsString -> Bool -> CMode -> IO (OsString, Handle)
openTempFile' [Char]
loc (OsString PosixString
tmp_dir) template :: OsString
template@(OsString PosixString
tmpl) Bool
binary CMode
mode
    | (OsChar -> Bool) -> OsString -> Bool
any_ (OsChar -> OsChar -> Bool
forall a. Eq a => a -> a -> Bool
== OsChar
OSP.pathSeparator) OsString
template
    = IOError -> IO (OsString, Handle)
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO (OsString, Handle))
-> IOError -> IO (OsString, Handle)
forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError ([Char] -> IOError) -> [Char] -> IOError
forall a b. (a -> b) -> a -> b
$ [Char]
"openTempFile': Template string must not contain path separator characters: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PosixString -> [Char]
P.lenientDecode PosixString
tmpl
    | Bool
otherwise = do
        (PosixString
fp, Handle
hdl) <- (PosixString, PosixString)
-> [Char] -> PosixString -> CMode -> IO (PosixString, Handle)
P.findTempName (PosixString
prefix, PosixString
suffix) [Char]
loc PosixString
tmp_dir CMode
mode
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
binary (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Bool -> IO ()
hSetBinaryMode Handle
hdl Bool
True
        (OsString, Handle) -> IO (OsString, Handle)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PosixString -> OsString
OsString PosixString
fp, Handle
hdl)
  where
    -- We split off the last extension, so we can use .foo.ext files
    -- for temporary files (hidden on Unix OSes). Unfortunately we're
    -- below filepath in the hierarchy here.
    (OsString PosixString
prefix, OsString PosixString
suffix) = OsString -> (OsString, OsString)
OSP.splitExtension OsString
template

#if MIN_VERSION_filepath(1, 5, 0)
any_ :: (OsChar -> Bool) -> OsString -> Bool
any_ = OSS.any

#else
any_ :: (OsChar -> Bool) -> OsString -> Bool
any_ :: (OsChar -> Bool) -> OsString -> Bool
any_ = ((PosixChar -> Bool) -> PosixString -> Bool)
-> (OsChar -> Bool) -> OsString -> Bool
forall a b. Coercible a b => a -> b
coerce (PosixChar -> Bool) -> PosixString -> Bool
P.any_

#endif