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
stdin :: Handle
stdin = unsafePerformIO $ do
-- ToDo: acquire lock
+ setBinaryMode FD.stdin
mkHandle FD.stdin "<stdin>" ReadHandle True (Just localeEncoding)
nativeNewlineMode{-translate newlines-}
(Just stdHandleFinalizer) Nothing
stdout :: Handle
stdout = unsafePerformIO $ do
-- ToDo: acquire lock
+ setBinaryMode FD.stdout
mkHandle FD.stdout "<stdout>" WriteHandle True (Just localeEncoding)
nativeNewlineMode{-translate newlines-}
(Just stdHandleFinalizer) Nothing
stderr :: Handle
stderr = unsafePerformIO $ do
-- ToDo: acquire lock
+ setBinaryMode FD.stderr
mkHandle FD.stderr "<stderr>" WriteHandle False{-stderr is unbuffered-}
(Just localeEncoding)
nativeNewlineMode{-translate newlines-}
flushWriteBuffer 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
-> 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