-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
-{-# OPTIONS_GHC -fno-warn-unused-binds #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, ForeignFunctionInterface #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
import GHC.IO.IOMode
import GHC.IO.Exception
import GHC.IO.Device
+#ifndef mingw32_HOST_OS
+import {-# SOURCE #-} GHC.IO.Encoding (fileSystemEncoding)
+import qualified GHC.Foreign as GHC
+#endif
#elif __HUGS__
import Hugs.Prelude (IOException(..), IOErrorType(..))
import Hugs.IO (IOMode(..))
{-# CFILES cbits/PrelIOUtils.c cbits/consUtils.c #-}
#endif
+
+-- ---------------------------------------------------------------------------
+-- Debugging the base package
+
+puts :: String -> IO ()
+puts s = withCAStringLen (s ++ "\n") $ \(p, len) -> do
+ -- In reality should be withCString, but assume ASCII to avoid loop
+ -- if this is called by GHC.Foreign
+ _ <- c_write 1 (castPtr p) (fromIntegral len)
+ return ()
+
+
-- ---------------------------------------------------------------------------
-- Types
#ifdef mingw32_HOST_OS
withFilePath :: FilePath -> (CWString -> IO a) -> IO a
-withFilePath = withCWString
+withFilePath = withCWString
+
+peekFilePath :: CWString -> IO FilePath
+peekFilePath = peekCWString
#else
+
withFilePath :: FilePath -> (CString -> IO a) -> IO a
+peekFilePath :: CString -> IO FilePath
+peekFilePathLen :: CStringLen -> IO FilePath
+
+#if __GLASGOW_HASKELL__
+withFilePath = GHC.withCString fileSystemEncoding
+peekFilePath = GHC.peekCString fileSystemEncoding
+peekFilePathLen = GHC.peekCStringLen fileSystemEncoding
+#else
withFilePath = withCString
+peekFilePath = peekCString
+peekFilePathLen = peekCStringLen
+#endif
+
#endif
-- ---------------------------------------------------------------------------
foreign import ccall unsafe "consUtils.h get_console_echo__"
get_console_echo :: CInt -> IO CInt
+foreign import ccall unsafe "consUtils.h is_console__"
+ is_console :: CInt -> IO CInt
+
#endif
-- ---------------------------------------------------------------------------
setNonBlockingFD fd set = do
flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
(c_fcntl_read fd const_f_getfl)
- -- An error when setting O_NONBLOCK isn't fatal: on some systems
- -- there are certain file handles on which this will fail (eg. /dev/null
- -- on FreeBSD) so we throw away the return code from fcntl_write.
let flags' | set = flags .|. o_NONBLOCK
| otherwise = flags .&. complement o_NONBLOCK
unless (flags == flags') $ do
+ -- An error when setting O_NONBLOCK isn't fatal: on some systems
+ -- there are certain file handles on which this will fail (eg. /dev/null
+ -- on FreeBSD) so we throw away the return code from fcntl_write.
_ <- c_fcntl_write fd const_f_setfl (fromIntegral flags')
return ()
#else
foreign import ccall unsafe "HsBase.h __hscore_open"
c_open :: CFilePath -> CInt -> CMode -> IO CInt
+foreign import ccall safe "HsBase.h __hscore_open"
+ c_safe_open :: CFilePath -> CInt -> CMode -> IO CInt
+
foreign import ccall unsafe "HsBase.h read"
c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize