-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, PatternGuards, ForeignFunctionInterface #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : GHC.IO.Handle.FD
module GHC.IO.Handle.FD (
stdin, stdout, stderr,
- openFile, openBinaryFile,
+ openFile, openBinaryFile, openFileBlocking,
mkHandleFromFD, fdToHandle, fdToHandle',
isEOF
) where
import GHC.Base
-import GHC.Num
-import GHC.Real
import GHC.Show
import Data.Maybe
-import Control.Monad
+-- import Control.Monad
import Foreign.C.Types
import GHC.MVar
import GHC.IO
import GHC.IO.Encoding
-import GHC.IO.Exception
+-- import GHC.IO.Exception
import GHC.IO.Device as IODevice
import GHC.IO.Exception
import GHC.IO.IOMode
-- | A handle managing input from the Haskell program's standard input channel.
stdin :: Handle
+{-# NOINLINE stdin #-}
stdin = unsafePerformIO $ do
-- ToDo: acquire lock
+ setBinaryMode FD.stdin
mkHandle FD.stdin "<stdin>" ReadHandle True (Just localeEncoding)
nativeNewlineMode{-translate newlines-}
(Just stdHandleFinalizer) Nothing
-- | A handle managing output to the Haskell program's standard output channel.
stdout :: Handle
+{-# NOINLINE stdout #-}
stdout = unsafePerformIO $ do
-- ToDo: acquire lock
+ setBinaryMode FD.stdout
mkHandle FD.stdout "<stdout>" WriteHandle True (Just localeEncoding)
nativeNewlineMode{-translate newlines-}
(Just stdHandleFinalizer) Nothing
-- | A handle managing output to the Haskell program's standard error channel.
stderr :: Handle
+{-# NOINLINE stderr #-}
stderr = unsafePerformIO $ do
-- ToDo: acquire lock
+ setBinaryMode FD.stderr
mkHandle FD.stderr "<stderr>" WriteHandle False{-stderr is unbuffered-}
(Just localeEncoding)
nativeNewlineMode{-translate newlines-}
stdHandleFinalizer fp m = do
h_ <- takeMVar m
flushWriteBuffer h_
+ case haType h_ of
+ ClosedHandle -> return ()
+ _other -> closeTextCodecs h_
putMVar m (ioe_finalizedHandle fp)
+-- We have to put the FDs into binary mode on Windows to avoid the newline
+-- translation that the CRT IO library does.
+setBinaryMode :: FD -> IO ()
+#ifdef mingw32_HOST_OS
+setBinaryMode fd = do _ <- setmode (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
openFile :: FilePath -> IOMode -> IO Handle
openFile fp im =
catchException
- (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE)
+ (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE True)
+ (\e -> ioError (addFilePathToIOError "openFile" fp e))
+
+-- | Like 'openFile', but opens the file in ordinary blocking mode.
+-- This can be useful for opening a FIFO for reading: if we open in
+-- non-blocking mode then the open will fail if there are no writers,
+-- whereas a blocking open will block until a writer appears.
+openFileBlocking :: FilePath -> IOMode -> IO Handle
+openFileBlocking fp im =
+ catchException
+ (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE False)
(\e -> ioError (addFilePathToIOError "openFile" fp e))
-- | Like 'openFile', but open the file in binary mode.
openBinaryFile :: FilePath -> IOMode -> IO Handle
openBinaryFile fp m =
catchException
- (openFile' fp m True)
+ (openFile' fp m True True)
(\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
-openFile' :: String -> IOMode -> Bool -> IO Handle
-openFile' filepath iomode binary = do
+openFile' :: String -> IOMode -> Bool -> Bool -> IO Handle
+openFile' filepath iomode binary non_blocking = do
-- first open the file to get an FD
- (fd, fd_type) <- FD.openFile filepath iomode
+ (fd, fd_type) <- FD.openFile filepath iomode non_blocking
let mb_codec = if binary then Nothing else Just localeEncoding
-- then use it to make a Handle
- mkHandleFromFD fd fd_type filepath iomode True{-non-blocking-} mb_codec
+ mkHandleFromFD fd fd_type filepath iomode
+ False {- do not *set* non-blocking mode -}
+ mb_codec
`onException` IODevice.close fd
-- NB. don't forget to close the FD if mkHandleFromFD fails, otherwise
-- this FD leaks.
mkHandleFromFD
:: FD
-> IODeviceType
- -> FilePath -- a string describing this file descriptor (e.g. the filename)
+ -> FilePath -- a string describing this file descriptor (e.g. the filename)
-> IOMode
- -> Bool -- non_blocking (*sets* non-blocking mode on the FD)
+ -> Bool -- *set* non-blocking mode on the FD
-> Maybe TextEncoding
-> IO Handle
-mkHandleFromFD fd fd_type filepath iomode set_non_blocking mb_codec
+mkHandleFromFD fd0 fd_type filepath iomode set_non_blocking mb_codec
= do
#ifndef mingw32_HOST_OS
- when set_non_blocking $ FD.setNonBlockingMode fd
-- turn on non-blocking mode
+ fd <- if set_non_blocking
+ then FD.setNonBlockingMode fd0 True
+ else return fd0
#else
let _ = set_non_blocking -- warning suppression
+ fd <- return fd0
#endif
let nl | isJust mb_codec = nativeNewlineMode
Just RegularFile -> Nothing
-- no stat required for streams etc.:
Just other -> Just (other,0,0)
- (fd,fd_type) <- FD.mkFD (fromIntegral fdint) iomode mb_stat
+ (fd,fd_type) <- FD.mkFD fdint iomode mb_stat
is_socket
is_socket
mkHandleFromFD fd fd_type filepath iomode is_socket
-- translation instead.
fdToHandle :: Posix.FD -> IO Handle
fdToHandle fdint = do
- iomode <- Posix.fdGetMode (fromIntegral fdint)
- (fd,fd_type) <- FD.mkFD (fromIntegral fdint) iomode Nothing
+ iomode <- Posix.fdGetMode fdint
+ (fd,fd_type) <- FD.mkFD fdint iomode Nothing
False{-is_socket-}
-- NB. the is_socket flag is False, meaning that:
-- on Windows we're guessing this is not a socket (XXX)
projects / ghc-base.git / blobdiff