module System.LowLevelIO (myfdRead, myfdSeek, Errno(..), select'read'pending)
where
import Foreign.C
import Foreign.Ptr
import System.Posix
import System.IO (SeekMode(..))
import Data.Bits
import Foreign.Marshal.Array
myfdRead :: Fd -> Ptr CChar -> ByteCount -> IO (Either Errno ByteCount)
myfdRead (Fd fd) ptr n = do
n' <- cRead fd ptr n
if n' == 1 then getErrno >>= return . Left
else return . Right . fromIntegral $ n'
foreign import ccall unsafe "unistd.h read" cRead
:: CInt -> Ptr CChar -> CSize -> IO CInt
foreign import ccall unsafe "string.h" strerror :: Errno -> IO (Ptr CChar)
myfdSeek:: Fd -> SeekMode -> FileOffset -> IO (Either Errno FileOffset)
myfdSeek (Fd fd) mode off = do
n' <- cLSeek fd off (mode2Int mode)
if n' == 1 then getErrno >>= return . Left
else return . Right $ n'
where mode2Int :: SeekMode -> CInt
mode2Int AbsoluteSeek = (0)
mode2Int RelativeSeek = (1)
mode2Int SeekFromEnd = (2)
foreign import ccall unsafe "unistd.h lseek" cLSeek
:: CInt -> FileOffset -> CInt -> IO FileOffset
type FDSET = CUInt
type TIMEVAL = CLong
foreign import ccall "unistd.h select" c_select
:: CInt -> Ptr FDSET -> Ptr FDSET -> Ptr FDSET -> Ptr TIMEVAL -> IO CInt
fd2fds :: CInt -> [FDSET]
fd2fds fd = (replicate nb 0) ++ [setBit 0 off]
where
(nb,off) = quotRem (fromIntegral fd) (bitSize (undefined::FDSET))
fds2mfd :: [FDSET] -> [CInt]
fds2mfd fds = [fromIntegral (j+i*bitsize) |
(afds,i) <- zip fds [0..], j <- [0..bitsize],
testBit afds j]
where bitsize = bitSize (undefined::FDSET)
test_fd_conv = and $ map (\e -> [e] == (fds2mfd $ fd2fds e)) lst
where
lst = [0,1,5,7,8,9,16,17,63,64,65]
test_fd_conv' = mfd == fds2mfd fds
where
mfd = [0,1,5,7,8,9,16,17,63,64,65]
fds :: [FDSET]
fds = foldr ormax [] (map fd2fds mfd)
fdmax = maximum $ map fromIntegral mfd
ormax [] x = x
ormax x [] = x
ormax (a:ar) (b:br) = (a .|. b) : ormax ar br
unFd :: Fd -> CInt
unFd (Fd x) = x
select'read'pending :: [Fd] -> IO (Either Errno [Fd])
select'read'pending mfd =
withArray ([0,1]::[TIMEVAL]) (
\timeout ->
withArray fds (
\readfs ->
do
rc <- c_select (fdmax+1) readfs nullPtr nullPtr nullPtr
if rc == 1 then getErrno >>= return . Left
else peekArray (length fds) readfs >>=
return . Right . map Fd . fds2mfd))
where
fds :: [FDSET]
fds = foldr ormax [] (map (fd2fds . unFd) mfd)
fdmax = maximum $ map fromIntegral mfd
ormax [] x = x
ormax x [] = x
ormax (a:ar) (b:br) = (a .|. b) : ormax ar br
foreign import ccall "fcntl.h fcntl" fcntl
:: CInt -> CInt -> CInt -> IO CInt
cleanup'fd = mapM_ (closeFd . Fd)