-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
--
-- Maintainer : cvs-ghc@haskell.org
-- Stability : internal
--- Portability : non-portable
+-- Portability : non-portable (requires POSIX)
--
-- POSIX support layer for the standard libraries.
-- This library is built on *every* platform, including Win32.
import Hugs.Prelude (IOException(..), IOErrorType(..))
{-# CFILES cbits/PrelIOUtils.c cbits/dirUtils.c cbits/consUtils.c #-}
-ioException = ioError
#endif
-- ---------------------------------------------------------------------------
c_size <- st_size p_stat :: IO COff
return (fromIntegral c_size)
-data FDType = Directory | Stream | RegularFile
+data FDType = Directory | Stream | RegularFile | RawDevice
deriving (Eq)
fileType :: FilePath -> IO FDType
| s_isfifo c_mode || s_issock c_mode || s_ischr c_mode
-> return Stream
| s_isreg c_mode -> return RegularFile
+ -- Q: map char devices to RawDevice too?
+ | s_isblk c_mode -> return RawDevice
| otherwise -> ioError ioe_unknownfiletype
ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType"
"unknown file type" Nothing
--- It isn't clear whether ftruncate is POSIX or not (I've read several
--- manpages and they seem to conflict), so we truncate using open/2.
-fileTruncate :: FilePath -> IO ()
-fileTruncate file = do
- let flags = o_WRONLY .|. o_TRUNC
- withCString file $ \file_cstr -> do
- fd <- fromIntegral `liftM`
- throwErrnoIfMinus1Retry "fileTruncate"
- (c_open file_cstr (fromIntegral flags) 0o666)
- c_close fd
- return ()
-
-#if defined(mingw32_TARGET_OS) || defined(__MINGW32__)
+#if __GLASGOW_HASKELL__ && (defined(mingw32_HOST_OS) || defined(__MINGW32__))
closeFd :: Bool -> CInt -> IO CInt
closeFd isStream fd
| isStream = c_closesocket fd
fdGetMode :: Int -> IO IOMode
fdGetMode fd = do
-#if defined(mingw32_TARGET_OS) || defined(__MINGW32__)
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-- XXX: this code is *BROKEN*, _setmode only deals with O_TEXT/O_BINARY
flags1 <- throwErrnoIfMinus1Retry "fdGetMode"
(c__setmode (fromIntegral fd) (fromIntegral o_WRONLY))
setCooked fd cooked = do
x <- set_console_buffering (fromIntegral fd) (if cooked then 1 else 0)
if (x /= 0)
- then ioException (ioe_unk_error "setCooked" "failed to set buffering")
+ then ioError (ioe_unk_error "setCooked" "failed to set buffering")
else return ()
ioe_unk_error loc msg
setEcho fd on = do
x <- set_console_echo (fromIntegral fd) (if on then 1 else 0)
if (x /= 0)
- then ioException (ioe_unk_error "setEcho" "failed to set echoing")
+ then ioError (ioe_unk_error "setEcho" "failed to set echoing")
else return ()
getEcho :: Int -> IO Bool
getEcho fd = do
r <- get_console_echo (fromIntegral fd)
if (r == (-1))
- then ioException (ioe_unk_error "getEcho" "failed to get echoing")
+ then ioError (ioe_unk_error "getEcho" "failed to get echoing")
else return (r == 1)
foreign import ccall unsafe "consUtils.h set_console_buffering__"
-- ---------------------------------------------------------------------------
-- Turning on non-blocking for a file descriptor
-#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__)
+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
setNonBlockingFD fd = do
flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
foreign import ccall unsafe "HsBase.h write"
c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize
+foreign import ccall unsafe "HsBase.h __hscore_ftruncate"
+ c_ftruncate :: CInt -> COff -> IO CInt
+
foreign import ccall unsafe "HsBase.h unlink"
c_unlink :: CString -> IO CInt
-#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__)
+foreign import ccall unsafe "HsBase.h getpid"
+ c_getpid :: IO CPid
+
+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
foreign import ccall unsafe "HsBase.h fcntl"
c_fcntl_read :: CInt -> CInt -> IO CInt
foreign import ccall unsafe "HsBase.h fork"
c_fork :: IO CPid
-foreign import ccall unsafe "HsBase.h getpid"
- c_getpid :: IO CPid
-
foreign import ccall unsafe "HsBase.h link"
c_link :: CString -> CString -> IO CInt
foreign import ccall unsafe "HsBase.h __hscore_ptr_c_cc" ptr_c_cc :: Ptr CTermios -> IO (Ptr Word8)
#endif
-#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__)
+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
foreign import ccall unsafe "HsBase.h __hscore_s_issock" s_issock :: CMode -> Bool
#else
s_issock :: CMode -> Bool