type CUtsname = ()
#ifndef __GLASGOW_HASKELL__
-type FD = Int
+type FD = CInt
#endif
-- ---------------------------------------------------------------------------
-- stat()-related stuff
-fdFileSize :: Int -> IO Integer
+fdFileSize :: FD -> IO Integer
fdFileSize fd =
allocaBytes sizeof_stat $ \ p_stat -> do
throwErrnoIfMinus1Retry "fileSize" $
- c_fstat (fromIntegral fd) p_stat
+ c_fstat fd p_stat
c_mode <- st_mode p_stat :: IO CMode
if not (s_isreg c_mode)
then return (-1)
-- NOTE: On Win32 platforms, this will only work with file descriptors
-- referring to file handles. i.e., it'll fail for socket FDs.
-fdType :: Int -> IO FDType
+fdType :: FD -> IO FDType
fdType fd =
allocaBytes sizeof_stat $ \ p_stat -> do
throwErrnoIfMinus1Retry "fdType" $
- c_fstat (fromIntegral fd) p_stat
+ c_fstat fd p_stat
statGetType p_stat
statGetType p_stat = do
c_closesocket :: CInt -> IO CInt
#endif
-fdGetMode :: Int -> IO IOMode
+fdGetMode :: FD -> IO IOMode
fdGetMode fd = do
#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))
+ (c__setmode fd (fromIntegral o_WRONLY))
flags <- throwErrnoIfMinus1Retry "fdGetMode"
- (c__setmode (fromIntegral fd) (fromIntegral flags1))
+ (c__setmode fd (fromIntegral flags1))
#else
flags <- throwErrnoIfMinus1Retry "fdGetMode"
- (c_fcntl_read (fromIntegral fd) const_f_getfl)
+ (c_fcntl_read fd const_f_getfl)
#endif
let
wH = (flags .&. o_WRONLY) /= 0
-- ---------------------------------------------------------------------------
-- Terminal-related stuff
-fdIsTTY :: Int -> IO Bool
-fdIsTTY fd = c_isatty (fromIntegral fd) >>= return.toBool
+fdIsTTY :: FD -> IO Bool
+fdIsTTY fd = c_isatty fd >>= return.toBool
#if defined(HTYPE_TCFLAG_T)
-setEcho :: Int -> Bool -> IO ()
+setEcho :: FD -> Bool -> IO ()
setEcho fd on = do
tcSetAttr fd $ \ p_tios -> do
c_lflag <- c_lflag p_tios :: IO CTcflag
| otherwise = c_lflag .&. complement (fromIntegral const_echo)
poke_c_lflag p_tios (new_c_lflag :: CTcflag)
-getEcho :: Int -> IO Bool
+getEcho :: FD -> IO Bool
getEcho fd = do
tcSetAttr fd $ \ p_tios -> do
c_lflag <- c_lflag p_tios :: IO CTcflag
return ((c_lflag .&. fromIntegral const_echo) /= 0)
-setCooked :: Int -> Bool -> IO ()
+setCooked :: FD -> Bool -> IO ()
setCooked fd cooked =
tcSetAttr fd $ \ p_tios -> do
tcSetAttr fd fun = do
allocaBytes sizeof_termios $ \p_tios -> do
throwErrnoIfMinus1Retry "tcSetAttr"
- (c_tcgetattr (fromIntegral fd) p_tios)
+ (c_tcgetattr fd p_tios)
#ifdef __GLASGOW_HASKELL__
-- Save a copy of termios, if this is a standard file descriptor.
c_sigprocmask const_sig_block p_sigset p_old_sigset
r <- fun p_tios -- do the business
throwErrnoIfMinus1Retry_ "tcSetAttr" $
- c_tcsetattr (fromIntegral fd) const_tcsanow p_tios
+ c_tcsetattr fd const_tcsanow p_tios
c_sigprocmask const_sig_setmask p_old_sigset nullPtr
return r
#ifdef __GLASGOW_HASKELL__
foreign import ccall unsafe "HsBase.h __hscore_get_saved_termios"
- get_saved_termios :: Int -> IO (Ptr CTermios)
+ get_saved_termios :: CInt -> IO (Ptr CTermios)
foreign import ccall unsafe "HsBase.h __hscore_set_saved_termios"
- set_saved_termios :: Int -> (Ptr CTermios) -> IO ()
+ set_saved_termios :: CInt -> (Ptr CTermios) -> IO ()
#endif
#else
-- report that character until another character is input..odd.) This
-- latter feature doesn't sit too well with IO actions like IO.hGetLine..
-- consider yourself warned.
-setCooked :: Int -> Bool -> IO ()
+setCooked :: FD -> Bool -> IO ()
setCooked fd cooked = do
- x <- set_console_buffering (fromIntegral fd) (if cooked then 1 else 0)
+ x <- set_console_buffering fd (if cooked then 1 else 0)
if (x /= 0)
then ioError (ioe_unk_error "setCooked" "failed to set buffering")
else return ()
-- Note: echoing goes hand in hand with enabling 'line input' / raw-ness
-- for Win32 consoles, hence setEcho ends up being the inverse of setCooked.
-setEcho :: Int -> Bool -> IO ()
+setEcho :: FD -> Bool -> IO ()
setEcho fd on = do
- x <- set_console_echo (fromIntegral fd) (if on then 1 else 0)
+ x <- set_console_echo fd (if on then 1 else 0)
if (x /= 0)
then ioError (ioe_unk_error "setEcho" "failed to set echoing")
else return ()
-getEcho :: Int -> IO Bool
+getEcho :: FD -> IO Bool
getEcho fd = do
- r <- get_console_echo (fromIntegral fd)
+ r <- get_console_echo fd
if (r == (-1))
then ioError (ioe_unk_error "getEcho" "failed to get echoing")
else return (r == 1)
setNonBlockingFD fd = do
flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
- (c_fcntl_read (fromIntegral fd) const_f_getfl)
+ (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.
unless (testBit flags (fromIntegral o_NONBLOCK)) $ do
- c_fcntl_write (fromIntegral fd) const_f_setfl (flags .|. o_NONBLOCK)
+ c_fcntl_write fd const_f_setfl (fromIntegral (flags .|. o_NONBLOCK))
return ()
#else
-- foreign imports
foreign import ccall unsafe "HsBase.h access"
- c_access :: CString -> CMode -> IO CInt
+ c_access :: CString -> CInt -> IO CInt
foreign import ccall unsafe "HsBase.h chmod"
c_chmod :: CString -> CMode -> IO CInt
c_fstat :: CInt -> Ptr CStat -> IO CInt
foreign import ccall unsafe "HsBase.h getcwd"
- c_getcwd :: Ptr CChar -> CInt -> IO (Ptr CChar)
+ c_getcwd :: Ptr CChar -> CSize -> IO (Ptr CChar)
foreign import ccall unsafe "HsBase.h isatty"
c_isatty :: CInt -> IO CInt
c_fcntl_read :: CInt -> CInt -> IO CInt
foreign import ccall unsafe "HsBase.h fcntl"
- c_fcntl_write :: CInt -> CInt -> CInt -> IO CInt
+ c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt
foreign import ccall unsafe "HsBase.h fcntl"
c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt
c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt
foreign import ccall unsafe "HsBase.h utime"
- c_utime :: CString -> Ptr CUtimbuf -> IO CMode
+ c_utime :: CString -> Ptr CUtimbuf -> IO CInt
foreign import ccall unsafe "HsBase.h waitpid"
c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
foreign import ccall unsafe "HsBase.h __hscore_o_nonblock" o_NONBLOCK :: CInt
foreign import ccall unsafe "HsBase.h __hscore_o_binary" o_BINARY :: CInt
-foreign import ccall unsafe "HsBase.h __hscore_s_isreg" s_isreg :: CMode -> Bool
-foreign import ccall unsafe "HsBase.h __hscore_s_ischr" s_ischr :: CMode -> Bool
-foreign import ccall unsafe "HsBase.h __hscore_s_isblk" s_isblk :: CMode -> Bool
-foreign import ccall unsafe "HsBase.h __hscore_s_isdir" s_isdir :: CMode -> Bool
-foreign import ccall unsafe "HsBase.h __hscore_s_isfifo" s_isfifo :: CMode -> Bool
+foreign import ccall unsafe "HsBase.h __hscore_s_isreg" c_s_isreg :: CMode -> CInt
+foreign import ccall unsafe "HsBase.h __hscore_s_ischr" c_s_ischr :: CMode -> CInt
+foreign import ccall unsafe "HsBase.h __hscore_s_isblk" c_s_isblk :: CMode -> CInt
+foreign import ccall unsafe "HsBase.h __hscore_s_isdir" c_s_isdir :: CMode -> CInt
+foreign import ccall unsafe "HsBase.h __hscore_s_isfifo" c_s_isfifo :: CMode -> CInt
+
+s_isreg :: CMode -> Bool
+s_isreg cm = c_s_isreg cm /= 0
+s_ischr :: CMode -> Bool
+s_ischr cm = c_s_ischr cm /= 0
+s_isblk :: CMode -> Bool
+s_isblk cm = c_s_isblk cm /= 0
+s_isdir :: CMode -> Bool
+s_isdir cm = c_s_isdir cm /= 0
+s_isfifo :: CMode -> Bool
+s_isfifo cm = c_s_isfifo cm /= 0
foreign import ccall unsafe "HsBase.h __hscore_sizeof_stat" sizeof_stat :: Int
foreign import ccall unsafe "HsBase.h __hscore_st_mtime" st_mtime :: Ptr CStat -> IO CTime
#endif
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-foreign import ccall unsafe "HsBase.h __hscore_s_issock" s_issock :: CMode -> Bool
+foreign import ccall unsafe "HsBase.h __hscore_s_issock" c_s_issock :: CMode -> CInt
+s_issock :: CMode -> Bool
+s_issock cmode = c_s_issock cmode /= 0
#else
s_issock :: CMode -> Bool
s_issock cmode = False
projects / haskell-directory.git / blobdiff