{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude #-}
module GHC.IO.Handle.FD (
stdin, stdout, stderr,
openFile, openBinaryFile, openFileBlocking,
mkHandleFromFD, fdToHandle, fdToHandle',
isEOF
) where
import GHC.Base
import GHC.Show
import Data.Maybe
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
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 = unsafePerformIO $ do
setBinaryMode FD.stdin
enc <- getLocaleEncoding
mkHandle FD.stdin "<stdin>" ReadHandle True (Just enc)
nativeNewlineMode
(Just stdHandleFinalizer) Nothing
stdout :: Handle
{-# NOINLINE stdout #-}
stdout = unsafePerformIO $ do
setBinaryMode FD.stdout
enc <- getLocaleEncoding
mkHandle FD.stdout "<stdout>" WriteHandle True (Just enc)
nativeNewlineMode
(Just stdHandleFinalizer) Nothing
stderr :: Handle
{-# NOINLINE stderr #-}
stderr = unsafePerformIO $ do
setBinaryMode FD.stderr
enc <- getLocaleEncoding
mkHandle FD.stderr "<stderr>" WriteHandle False
(Just enc)
nativeNewlineMode
(Just stdHandleFinalizer) Nothing
stdHandleFinalizer :: FilePath -> MVar Handle__ -> IO ()
stdHandleFinalizer fp m = do
h_ <- takeMVar m
flushWriteBuffer h_
case haType h_ of
ClosedHandle -> return ()
_other -> closeTextCodecs h_
putMVar m (ioe_finalizedHandle fp)
setBinaryMode :: FD.FD -> IO ()
#ifdef mingw32_HOST_OS
setBinaryMode fd = do _ <- setmode (FD.fdFD fd) True
return ()
#else
setBinaryMode _ = return ()
#endif
#ifdef mingw32_HOST_OS
foreign import ccall unsafe "__hscore_setmode"
setmode :: CInt -> Bool -> IO CInt
#endif
isEOF :: IO Bool
isEOF = hIsEOF stdin
addFilePathToIOError :: String -> FilePath -> IOException -> IOException
addFilePathToIOError fun fp ioe
= ioe{ ioe_location = fun, ioe_filename = Just fp }
openFile :: FilePath -> IOMode -> IO Handle
openFile fp im =
catchException
(openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE True)
(\e -> ioError (addFilePathToIOError "openFile" fp e))
openFileBlocking :: FilePath -> IOMode -> IO Handle
openFileBlocking fp im =
catchException
(openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE False)
(\e -> ioError (addFilePathToIOError "openFile" fp e))
openBinaryFile :: FilePath -> IOMode -> IO Handle
openBinaryFile fp m =
catchException
(openFile' fp m True True)
(\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
openFile' :: String -> IOMode -> Bool -> Bool -> IO Handle
openFile' filepath iomode binary non_blocking = do
(fd, fd_type) <- FD.openFile filepath iomode non_blocking
mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding
mkHandleFromFD fd fd_type filepath iomode
False
mb_codec
`onException` IODevice.close fd
mkHandleFromFD
:: FD.FD
-> IODeviceType
-> FilePath
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD fd0 fd_type filepath iomode set_non_blocking mb_codec
= do
#ifndef mingw32_HOST_OS
fd <- if set_non_blocking
then FD.setNonBlockingMode fd0 True
else return fd0
#else
let _ = set_non_blocking
fd <- return fd0
#endif
let nl | isJust mb_codec = nativeNewlineMode
| otherwise = noNewlineTranslation
case fd_type of
Directory ->
ioException (IOError Nothing InappropriateType "openFile"
"is a directory" Nothing Nothing)
Stream
| ReadWriteMode <- iomode ->
mkDuplexHandle fd filepath mb_codec nl
_other ->
mkFileHandle fd filepath iomode mb_codec nl
fdToHandle' :: CInt
-> Maybe IODeviceType
-> Bool
-> FilePath
-> IOMode
-> Bool
-> IO Handle
fdToHandle' fdint mb_type is_socket filepath iomode binary = do
let mb_stat = case mb_type of
Nothing -> Nothing
Just RegularFile -> Nothing
Just other -> Just (other,0,0)
(fd,fd_type) <- FD.mkFD fdint iomode mb_stat
is_socket
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 fdint = do
iomode <- Posix.fdGetMode fdint
(fd,fd_type) <- FD.mkFD fdint iomode Nothing
False
False
let fd_str = "<file descriptor: " ++ show fd ++ ">"
mkHandleFromFD fd fd_type fd_str iomode False
Nothing
dEFAULT_OPEN_IN_BINARY_MODE :: Bool
dEFAULT_OPEN_IN_BINARY_MODE = False