{-# 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 :: OsPath -> IOMode -> IO Handle
openBinaryFile OsPath
osfp IOMode
iomode = [Char] -> OsPath -> IO Handle -> IO Handle
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"openBinaryFile" OsPath
osfp (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsPath
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. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
osfp IOMode
iomode Handle -> IO r
act = ([Char] -> OsPath -> IO (Either IOError r) -> IO (Either IOError r)
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"withFile" OsPath
osfp
    (IO (Either IOError r) -> IO (Either IOError r))
-> IO (Either IOError r) -> IO (Either IOError r)
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO (Either IOError r))
-> Bool
-> IO (Either IOError r)
forall r.
OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsPath
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. HasCallStack => 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. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile OsPath
osfp IOMode
iomode Handle -> IO r
act = ([Char] -> OsPath -> IO (Either IOError r) -> IO (Either IOError r)
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"withBinaryFile" OsPath
osfp
    (IO (Either IOError r) -> IO (Either IOError r))
-> IO (Either IOError r) -> IO (Either IOError r)
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO (Either IOError r))
-> Bool
-> IO (Either IOError r)
forall r.
OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsPath
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. HasCallStack => 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. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile' OsPath
osfp IOMode
iomode Handle -> IO r
act = ([Char] -> OsPath -> IO (Either IOError r) -> IO (Either IOError r)
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"withFile'" OsPath
osfp
    (IO (Either IOError r) -> IO (Either IOError r))
-> IO (Either IOError r) -> IO (Either IOError r)
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO (Either IOError r))
-> Bool
-> IO (Either IOError r)
forall r.
OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsPath
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. HasCallStack => 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. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile' OsPath
osfp IOMode
iomode Handle -> IO r
act = ([Char] -> OsPath -> IO (Either IOError r) -> IO (Either IOError r)
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"withBinaryFile'" OsPath
osfp
    (IO (Either IOError r) -> IO (Either IOError r))
-> IO (Either IOError r) -> IO (Either IOError r)
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO (Either IOError r))
-> Bool
-> IO (Either IOError r)
forall r.
OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsPath
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. HasCallStack => 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 :: OsPath -> IO ByteString
readFile OsPath
fp = OsPath -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile' OsPath
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' :: OsPath -> IO ByteString
readFile' OsPath
fp = OsPath -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
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 :: OsPath -> ByteString -> IO ()
writeFile OsPath
fp ByteString
contents = OsPath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
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' :: OsPath -> ByteString -> IO ()
writeFile' OsPath
fp ByteString
contents = OsPath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
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 :: OsPath -> ByteString -> IO ()
appendFile OsPath
fp ByteString
contents = OsPath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
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' :: OsPath -> ByteString -> IO ()
appendFile' OsPath
fp ByteString
contents = OsPath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withFile OsPath
fp IOMode
AppendMode (Handle -> ByteString -> IO ()
`BS.hPut` ByteString
contents)

-- | Open a file and return the 'Handle'.
openFile :: OsPath -> IOMode -> IO Handle
openFile :: OsPath -> IOMode -> IO Handle
openFile OsPath
osfp IOMode
iomode = [Char] -> OsPath -> IO Handle -> IO Handle
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"openFile" OsPath
osfp (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsPath
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 :: OsPath -> IOMode -> IO Handle
openExistingFile OsPath
osfp IOMode
iomode = [Char] -> OsPath -> IO Handle -> IO Handle
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"openExistingFile" OsPath
osfp (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsPath
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 :: OsPath -> IOMode -> IO Handle
openFileWithCloseOnExec OsPath
osfp IOMode
iomode = [Char] -> OsPath -> IO Handle -> IO Handle
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"openFileWithCloseOnExec" OsPath
osfp (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsPath
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 :: OsPath -> IOMode -> IO Handle
openExistingFileWithCloseOnExec OsPath
osfp IOMode
iomode = [Char] -> OsPath -> IO Handle -> IO Handle
forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
"openExistingFileWithCloseOnExec" OsPath
osfp (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' OsPath
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 :: OsPath -> OsPath -> IO (OsPath, Handle)
openTempFile OsPath
tmp_dir OsPath
template = [Char] -> OsPath -> OsPath -> Bool -> CMode -> IO (OsPath, Handle)
openTempFile' [Char]
"openTempFile" OsPath
tmp_dir OsPath
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 :: OsPath -> OsPath -> IO (OsPath, Handle)
openBinaryTempFile OsPath
tmp_dir OsPath
template
    = [Char] -> OsPath -> OsPath -> Bool -> CMode -> IO (OsPath, Handle)
openTempFile' [Char]
"openBinaryTempFile" OsPath
tmp_dir OsPath
template Bool
True CMode
0o600

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

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

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

handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
handleFinalizer :: [Char] -> MVar Handle__ -> IO ()
handleFinalizer [Char]
_fp MVar Handle__
m = do
  handle_ <- MVar Handle__ -> IO Handle__
forall a. MVar a -> IO a
takeMVar MVar Handle__
m
  (handle_', _) <- hClose_help handle_
  putMVar m handle_'
  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.
OsPath
-> IOMode
-> Bool
-> Bool
-> Bool
-> (Handle -> IO r)
-> Bool
-> IO r
withOpenFile' (OsString PlatformString
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
  hndl <- case (Bool
existing, Bool
cloExec) of
            (Bool
True, Bool
False) -> PlatformString -> IOMode -> IO Handle
P.openExistingFile PlatformString
fp IOMode
iomode
            (Bool
False, Bool
False) -> PlatformString -> IOMode -> IO Handle
P.openFile PlatformString
fp IOMode
iomode
            (Bool
True, Bool
True) -> PlatformString -> IOMode -> IO Handle
P.openExistingFileWithCloseOnExec PlatformString
fp IOMode
iomode
            (Bool
False, Bool
True) -> PlatformString -> IOMode -> IO Handle
P.openFileWithCloseOnExec PlatformString
fp IOMode
iomode
  addHandleFinalizer hndl handleFinalizer
  when binary $ hSetBinaryMode hndl True
  r <- restore (action hndl) `onException` hClose hndl
  when close_finally $ hClose hndl
  pure r

addFilePathToIOError :: String -> OsPath -> IOException -> IOException
addFilePathToIOError :: [Char] -> OsPath -> IOError -> IOError
addFilePathToIOError [Char]
fun OsPath
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
  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]) -> (OsPath -> [OsChar]) -> OsPath -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> [OsChar]
OSP.unpack (OsPath -> [Char]) -> OsPath -> [Char]
forall a b. (a -> b) -> a -> b
$ OsPath
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 (OsPath -> IO [Char]
OSP.decodeFS OsPath
fp)
  fp'' <- evaluate $ force fp'
  pure $ ioe{ ioe_location = fun, ioe_filename = Just fp'' }

augmentError :: String -> OsPath -> IO a -> IO a
augmentError :: forall a. [Char] -> OsPath -> IO a -> IO a
augmentError [Char]
str OsPath
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. HasCallStack => IOError -> IO a
ioError (IOError -> IO a) -> (IOError -> IOError) -> IOError -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> OsPath -> IOError -> IOError
addFilePathToIOError [Char]
str OsPath
osfp)


openTempFile' :: String -> OsPath -> OsString -> Bool -> CMode
              -> IO (OsPath, Handle)
openTempFile' :: [Char] -> OsPath -> OsPath -> Bool -> CMode -> IO (OsPath, Handle)
openTempFile' [Char]
loc (OsString PlatformString
tmp_dir) template :: OsPath
template@(OsString PlatformString
tmpl) Bool
binary CMode
mode
    | (OsChar -> Bool) -> OsPath -> Bool
any_ (OsChar -> OsChar -> Bool
forall a. Eq a => a -> a -> Bool
== OsChar
OSP.pathSeparator) OsPath
template
    = IOError -> IO (OsPath, Handle)
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IOError -> IO (OsPath, Handle)) -> IOError -> IO (OsPath, 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]
++ PlatformString -> [Char]
P.lenientDecode PlatformString
tmpl
    | Bool
otherwise = do
        (fp, hdl) <- (PlatformString, PlatformString)
-> [Char] -> PlatformString -> CMode -> IO (PlatformString, Handle)
P.findTempName (PlatformString
prefix, PlatformString
suffix) [Char]
loc PlatformString
tmp_dir CMode
mode
        when binary $ hSetBinaryMode hdl True
        pure (OsString fp, 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 PlatformString
prefix, OsString PlatformString
suffix) = OsPath -> (OsPath, OsPath)
OSP.splitExtension OsPath
template

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

#else
any_ :: (OsChar -> Bool) -> OsString -> Bool
any_ = coerce P.any_

#endif