{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE CPP, NoImplicitPrelude #-}
module GHC.Internal.IO.Handle.FD (
stdin, stdout, stderr,
openFile, withFile,
openBinaryFile, withBinaryFile,
openFileBlocking, withFileBlocking,
mkHandleFromFD, fdToHandle, fdToHandle', handleToFd
) where
import GHC.Internal.Base
import GHC.Internal.Show
import GHC.Internal.Control.Exception (tryWithContext)
import GHC.Internal.Data.Maybe
import GHC.Internal.Data.Either (either)
import GHC.Internal.Data.Typeable
import GHC.Internal.Foreign.C.Types
import GHC.Internal.MVar
import GHC.Internal.Exception.Type
import GHC.Internal.IO
import GHC.Internal.IO.Encoding
import GHC.Internal.IO.Device as IODevice
import GHC.Internal.IO.Exception
import GHC.Internal.IO.IOMode
import GHC.Internal.IO.Handle.Types
import GHC.Internal.IO.Handle.Internals
import qualified GHC.Internal.IO.FD as FD
import qualified GHC.Internal.System.Posix.Internals as Posix
stdin :: Handle
{-# NOINLINE stdin #-}
stdin :: Handle
stdin = IO Handle -> Handle
forall a. IO a -> a
unsafePerformIO (IO Handle -> Handle) -> IO Handle -> Handle
forall a b. (a -> b) -> a -> b
$ do
FD -> IO ()
setBinaryMode FD
FD.stdin
enc <- IO TextEncoding
getLocaleEncoding
mkHandle FD.stdin "<stdin>" ReadHandle True (Just enc)
nativeNewlineMode
(Just stdHandleFinalizer) Nothing
stdout :: Handle
{-# NOINLINE stdout #-}
stdout :: Handle
stdout = IO Handle -> Handle
forall a. IO a -> a
unsafePerformIO (IO Handle -> Handle) -> IO Handle -> Handle
forall a b. (a -> b) -> a -> b
$ do
FD -> IO ()
setBinaryMode FD
FD.stdout
enc <- IO TextEncoding
getLocaleEncoding
mkHandle FD.stdout "<stdout>" WriteHandle True (Just enc)
nativeNewlineMode
(Just stdHandleFinalizer) Nothing
stderr :: Handle
{-# NOINLINE stderr #-}
stderr :: Handle
stderr = IO Handle -> Handle
forall a. IO a -> a
unsafePerformIO (IO Handle -> Handle) -> IO Handle -> Handle
forall a b. (a -> b) -> a -> b
$ do
FD -> IO ()
setBinaryMode FD
FD.stderr
enc <- IO TextEncoding
getLocaleEncoding
mkHandle FD.stderr "<stderr>" WriteHandle False
(Just enc)
nativeNewlineMode
(Just stdHandleFinalizer) Nothing
stdHandleFinalizer :: FilePath -> MVar Handle__ -> IO ()
stdHandleFinalizer :: HandleFinalizer
stdHandleFinalizer FilePath
fp MVar Handle__
m = do
h_ <- MVar Handle__ -> IO Handle__
forall a. MVar a -> IO a
takeMVar MVar Handle__
m
flushWriteBuffer h_
case haType h_ of
HandleType
ClosedHandle -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
HandleType
_other -> Handle__ -> IO ()
closeTextCodecs Handle__
h_
putMVar m (ioe_finalizedHandle fp)
setBinaryMode :: FD.FD -> IO ()
#if defined(mingw32_HOST_OS)
setBinaryMode fd = do _ <- setmode (FD.fdFD fd) True
return ()
#else
setBinaryMode :: FD -> IO ()
setBinaryMode FD
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
#if defined(mingw32_HOST_OS)
foreign import ccall unsafe "__hscore_setmode"
setmode :: CInt -> Bool -> IO CInt
#endif
addFilePathToIOError :: String -> FilePath -> IOException -> IOException
addFilePathToIOError :: FilePath -> FilePath -> IOException -> IOException
addFilePathToIOError FilePath
fun FilePath
fp IOException
ioe
= IOException
ioe{ ioe_location = fun, ioe_filename = Just fp }
catchAndAnnotate :: FilePath -> String -> IO a -> IO a
catchAndAnnotate :: forall a. FilePath -> FilePath -> IO a -> IO a
catchAndAnnotate FilePath
fp FilePath
s IO a
a =
forall e a.
Exception e =>
IO a -> (ExceptionWithContext e -> IO a) -> IO a
catchExceptionNoPropagate @IOError IO a
a
(\(ExceptionWithContext ExceptionContext
c IOException
e) -> ExceptionWithContext IOException -> IO a
forall e a. Exception e => ExceptionWithContext e -> IO a
rethrowIO (ExceptionContext -> IOException -> ExceptionWithContext IOException
forall a. ExceptionContext -> a -> ExceptionWithContext a
ExceptionWithContext ExceptionContext
c (FilePath -> FilePath -> IOException -> IOException
addFilePathToIOError FilePath
s FilePath
fp IOException
e)))
rethrowError :: ExceptionWithContext IOError -> IO a
rethrowError :: forall a. ExceptionWithContext IOException -> IO a
rethrowError = ExceptionWithContext IOException -> IO a
forall e a. Exception e => ExceptionWithContext e -> IO a
rethrowIO
openFile :: FilePath -> IOMode -> IO Handle
openFile :: FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
im =
FilePath -> FilePath -> IO Handle -> IO Handle
forall a. FilePath -> FilePath -> IO a -> IO a
catchAndAnnotate
FilePath
fp FilePath
"openFile"
(FilePath -> IOMode -> Bool -> Bool -> IO Handle
openFile' FilePath
fp IOMode
im Bool
dEFAULT_OPEN_IN_BINARY_MODE Bool
True)
withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile :: forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fp IOMode
im Handle -> IO r
act = do
FilePath
-> FilePath
-> IO (Either (ExceptionWithContext IOException) r)
-> IO (Either (ExceptionWithContext IOException) r)
forall a. FilePath -> FilePath -> IO a -> IO a
catchAndAnnotate FilePath
fp FilePath
"withFile"
(FilePath
-> IOMode
-> Bool
-> Bool
-> (Handle -> IO (Either (ExceptionWithContext IOException) r))
-> IO (Either (ExceptionWithContext IOException) r)
forall r.
FilePath -> IOMode -> Bool -> Bool -> (Handle -> IO r) -> IO r
withFile' FilePath
fp IOMode
im Bool
dEFAULT_OPEN_IN_BINARY_MODE Bool
True (IO r -> IO (Either (ExceptionWithContext IOException) r)
forall e a.
Exception e =>
IO a -> IO (Either (ExceptionWithContext e) a)
tryWithContext (IO r -> IO (Either (ExceptionWithContext IOException) r))
-> (Handle -> IO r)
-> Handle
-> IO (Either (ExceptionWithContext IOException) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO r
act))
IO (Either (ExceptionWithContext IOException) r)
-> (Either (ExceptionWithContext IOException) 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
>>= (ExceptionWithContext IOException -> IO r)
-> (r -> IO r)
-> Either (ExceptionWithContext IOException) r
-> IO r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ExceptionWithContext IOException -> IO r
forall a. ExceptionWithContext IOException -> IO a
rethrowError r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
openFileBlocking :: FilePath -> IOMode -> IO Handle
openFileBlocking :: FilePath -> IOMode -> IO Handle
openFileBlocking FilePath
fp IOMode
im =
FilePath -> FilePath -> IO Handle -> IO Handle
forall a. FilePath -> FilePath -> IO a -> IO a
catchAndAnnotate FilePath
fp FilePath
"openFileBlocking"
(FilePath -> IOMode -> Bool -> Bool -> IO Handle
openFile' FilePath
fp IOMode
im Bool
dEFAULT_OPEN_IN_BINARY_MODE Bool
False)
withFileBlocking :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFileBlocking :: forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFileBlocking FilePath
fp IOMode
im Handle -> IO r
act = do
FilePath
-> FilePath
-> IO (Either (ExceptionWithContext IOException) r)
-> IO (Either (ExceptionWithContext IOException) r)
forall a. FilePath -> FilePath -> IO a -> IO a
catchAndAnnotate FilePath
fp FilePath
"withFileBlocking"
(FilePath
-> IOMode
-> Bool
-> Bool
-> (Handle -> IO (Either (ExceptionWithContext IOException) r))
-> IO (Either (ExceptionWithContext IOException) r)
forall r.
FilePath -> IOMode -> Bool -> Bool -> (Handle -> IO r) -> IO r
withFile' FilePath
fp IOMode
im Bool
dEFAULT_OPEN_IN_BINARY_MODE Bool
False (IO r -> IO (Either (ExceptionWithContext IOException) r)
forall e a.
Exception e =>
IO a -> IO (Either (ExceptionWithContext e) a)
tryWithContext (IO r -> IO (Either (ExceptionWithContext IOException) r))
-> (Handle -> IO r)
-> Handle
-> IO (Either (ExceptionWithContext IOException) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO r
act))
IO (Either (ExceptionWithContext IOException) r)
-> (Either (ExceptionWithContext IOException) 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
>>= (ExceptionWithContext IOException -> IO r)
-> (r -> IO r)
-> Either (ExceptionWithContext IOException) r
-> IO r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ExceptionWithContext IOException -> IO r
forall a. ExceptionWithContext IOException -> IO a
rethrowError r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
openBinaryFile :: FilePath -> IOMode -> IO Handle
openBinaryFile :: FilePath -> IOMode -> IO Handle
openBinaryFile FilePath
fp IOMode
m =
FilePath -> FilePath -> IO Handle -> IO Handle
forall a. FilePath -> FilePath -> IO a -> IO a
catchAndAnnotate FilePath
fp FilePath
"openBinaryFile"
(FilePath -> IOMode -> Bool -> Bool -> IO Handle
openFile' FilePath
fp IOMode
m Bool
True Bool
True)
withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile :: forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
fp IOMode
im Handle -> IO r
act =
FilePath
-> FilePath
-> IO (Either (ExceptionWithContext IOException) r)
-> IO (Either (ExceptionWithContext IOException) r)
forall a. FilePath -> FilePath -> IO a -> IO a
catchAndAnnotate FilePath
fp FilePath
"withBinaryFile"
(FilePath
-> IOMode
-> Bool
-> Bool
-> (Handle -> IO (Either (ExceptionWithContext IOException) r))
-> IO (Either (ExceptionWithContext IOException) r)
forall r.
FilePath -> IOMode -> Bool -> Bool -> (Handle -> IO r) -> IO r
withFile' FilePath
fp IOMode
im Bool
True Bool
True (IO r -> IO (Either (ExceptionWithContext IOException) r)
forall e a.
Exception e =>
IO a -> IO (Either (ExceptionWithContext e) a)
tryWithContext (IO r -> IO (Either (ExceptionWithContext IOException) r))
-> (Handle -> IO r)
-> Handle
-> IO (Either (ExceptionWithContext IOException) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO r
act))
IO (Either (ExceptionWithContext IOException) r)
-> (Either (ExceptionWithContext IOException) 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
>>= (ExceptionWithContext IOException -> IO r)
-> (r -> IO r)
-> Either (ExceptionWithContext IOException) r
-> IO r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ExceptionWithContext IOException -> IO r
forall a. ExceptionWithContext IOException -> IO a
rethrowError r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
withOpenFile' :: String -> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' :: forall r.
FilePath
-> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' FilePath
filepath IOMode
iomode Bool
binary Bool
non_blocking Handle -> IO r
act Bool
close_finally =
FilePath
-> IOMode
-> Bool
-> (FD -> IODeviceType -> IO Handle)
-> ((forall x. IO x -> IO x) -> Handle -> IO r)
-> IO r
forall r s.
FilePath
-> IOMode
-> Bool
-> (FD -> IODeviceType -> IO r)
-> ((forall x. IO x -> IO x) -> r -> IO s)
-> IO s
FD.openFileWith FilePath
filepath IOMode
iomode Bool
non_blocking (\FD
fd IODeviceType
fd_type -> do
mb_codec <- if Bool
binary then Maybe TextEncoding -> IO (Maybe TextEncoding)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TextEncoding
forall a. Maybe a
Nothing else (TextEncoding -> Maybe TextEncoding)
-> IO TextEncoding -> IO (Maybe TextEncoding)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEncoding -> Maybe TextEncoding
forall a. a -> Maybe a
Just IO TextEncoding
getLocaleEncoding
mkHandleFromFDNoFinalizer fd fd_type filepath iomode
False
mb_codec)
(\forall x. IO x -> IO x
restore Handle
hndl -> do
Handle -> HandleFinalizer -> IO ()
addHandleFinalizer Handle
hndl HandleFinalizer
handleFinalizer
r <- IO r -> IO r
forall x. IO x -> IO x
restore (Handle -> IO r
act Handle
hndl) IO r -> IO () -> IO r
forall a b. IO a -> IO b -> IO a
`onException` Handle -> IO ()
hClose_impl Handle
hndl
when close_finally $ hClose_impl hndl
pure r
)
withFile' :: String -> IOMode -> Bool -> Bool -> (Handle -> IO r) -> IO r
withFile' :: forall r.
FilePath -> IOMode -> Bool -> Bool -> (Handle -> IO r) -> IO r
withFile' FilePath
filepath IOMode
iomode Bool
binary Bool
non_blocking Handle -> IO r
act =
FilePath
-> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
forall r.
FilePath
-> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' FilePath
filepath IOMode
iomode Bool
binary Bool
non_blocking Handle -> IO r
act Bool
True
openFile' :: String -> IOMode -> Bool -> Bool -> IO Handle
openFile' :: FilePath -> IOMode -> Bool -> Bool -> IO Handle
openFile' FilePath
filepath IOMode
iomode Bool
binary Bool
non_blocking =
FilePath
-> IOMode
-> Bool
-> Bool
-> (Handle -> IO Handle)
-> Bool
-> IO Handle
forall r.
FilePath
-> IOMode -> Bool -> Bool -> (Handle -> IO r) -> Bool -> IO r
withOpenFile' FilePath
filepath IOMode
iomode Bool
binary Bool
non_blocking Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
mkHandleFromFDNoFinalizer
:: FD.FD
-> IODeviceType
-> FilePath
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFDNoFinalizer :: FD
-> IODeviceType
-> FilePath
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFDNoFinalizer FD
fd0 IODeviceType
fd_type FilePath
filepath IOMode
iomode Bool
set_non_blocking Maybe TextEncoding
mb_codec
= do
#if !defined(mingw32_HOST_OS)
fd <- if Bool
set_non_blocking
then FD -> Bool -> IO FD
FD.setNonBlockingMode FD
fd0 Bool
True
else FD -> IO FD
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FD
fd0
#else
let _ = set_non_blocking
fd <- return fd0
#endif
let nl | Maybe TextEncoding -> Bool
forall a. Maybe a -> Bool
isJust Maybe TextEncoding
mb_codec = NewlineMode
nativeNewlineMode
| Bool
otherwise = NewlineMode
noNewlineTranslation
case fd_type of
IODeviceType
Directory ->
IOException -> IO Handle
forall a. HasCallStack => IOException -> IO a
ioException (Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InappropriateType FilePath
"openFile"
FilePath
"is a directory" Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing)
IODeviceType
Stream
| IOMode
ReadWriteMode <- IOMode
iomode ->
FD -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
mkDuplexHandleNoFinalizer FD
fd FilePath
filepath Maybe TextEncoding
mb_codec NewlineMode
nl
IODeviceType
_other ->
FD
-> FilePath
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> IO Handle
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> IO Handle
mkFileHandleNoFinalizer FD
fd FilePath
filepath IOMode
iomode Maybe TextEncoding
mb_codec NewlineMode
nl
mkHandleFromFD
:: FD.FD
-> IODeviceType
-> FilePath
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD :: FD
-> IODeviceType
-> FilePath
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD FD
fd0 IODeviceType
fd_type FilePath
filepath IOMode
iomode Bool
set_non_blocking Maybe TextEncoding
mb_codec = do
h <- FD
-> IODeviceType
-> FilePath
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFDNoFinalizer FD
fd0 IODeviceType
fd_type FilePath
filepath IOMode
iomode
Bool
set_non_blocking Maybe TextEncoding
mb_codec
addHandleFinalizer h handleFinalizer
pure h
fdToHandle' :: CInt
-> Maybe IODeviceType
-> Bool
-> FilePath
-> IOMode
-> Bool
-> IO Handle
fdToHandle' :: CInt
-> Maybe IODeviceType
-> Bool
-> FilePath
-> IOMode
-> Bool
-> IO Handle
fdToHandle' CInt
fdint Maybe IODeviceType
mb_type Bool
is_socket FilePath
filepath IOMode
iomode Bool
binary = do
let mb_stat :: Maybe (IODeviceType, CDev, CIno)
mb_stat = case Maybe IODeviceType
mb_type of
Maybe IODeviceType
Nothing -> Maybe (IODeviceType, CDev, CIno)
forall a. Maybe a
Nothing
Just IODeviceType
RegularFile -> Maybe (IODeviceType, CDev, CIno)
forall a. Maybe a
Nothing
Just IODeviceType
other -> (IODeviceType, CDev, CIno) -> Maybe (IODeviceType, CDev, CIno)
forall a. a -> Maybe a
Just (IODeviceType
other,CDev
0,CIno
0)
(fd,fd_type) <- CInt
-> IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Bool
-> Bool
-> IO (FD, IODeviceType)
FD.mkFD CInt
fdint IOMode
iomode Maybe (IODeviceType, CDev, CIno)
mb_stat
Bool
is_socket
Bool
is_socket
enc <- if binary then return Nothing else fmap Just getLocaleEncoding
mkHandleFromFD fd fd_type filepath iomode is_socket enc
fdToHandle :: Posix.FD -> IO Handle
fdToHandle :: CInt -> IO Handle
fdToHandle CInt
fdint = do
iomode <- CInt -> IO IOMode
Posix.fdGetMode CInt
fdint
(fd,fd_type) <- FD.mkFD fdint iomode Nothing
False
False
let fd_str = FilePath
"<file descriptor: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FD -> FilePath
forall a. Show a => a -> FilePath
show FD
fd FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
">"
mkHandleFromFD fd fd_type fd_str iomode False
Nothing
handleToFd :: Handle -> IO FD.FD
handleToFd :: Handle -> IO FD
handleToFd Handle
h = case Handle
h of
FileHandle FilePath
_ MVar Handle__
mv -> do
Handle__{haDevice = dev} <- MVar Handle__ -> IO Handle__
forall a. MVar a -> IO a
readMVar MVar Handle__
mv
case cast dev of
Just FD
fd -> FD -> IO FD
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FD
fd
Maybe FD
Nothing -> FilePath -> IO FD
forall {a}. FilePath -> IO a
throwErr FilePath
"not a file descriptor"
DuplexHandle{} -> FilePath -> IO FD
forall {a}. FilePath -> IO a
throwErr FilePath
"not a file handle"
where
throwErr :: FilePath -> IO a
throwErr FilePath
msg = IOException -> IO a
forall a. HasCallStack => IOException -> IO a
ioException (IOException -> IO a) -> IOException -> IO a
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h)
IOErrorType
InappropriateType FilePath
"handleToFd" FilePath
msg Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing
dEFAULT_OPEN_IN_BINARY_MODE :: Bool
dEFAULT_OPEN_IN_BINARY_MODE :: Bool
dEFAULT_OPEN_IN_BINARY_MODE = Bool
False