{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE BangPatterns #-}
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, (>>=))
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)
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
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
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
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
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
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
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)
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)
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)
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)
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
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
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
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
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 ()
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)