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