select-0.3: src/System/Posix/IO/Select.hs

{-# LANGUAGE ForeignFunctionInterface #-}

-- | Interface to the @select(2)@ POSIX function.
-- 
-- TODO: 
--
-- * Make a version of @'select'@ that shows which file descriptors
-- are ready. (Needs a type for fd_set that can be passed to and from
-- C).
module System.Posix.IO.Select (select, Timeout(Never, Time)) where

import System.Posix.IO.Select.Types
import Foreign
import Foreign.C.Types
import System.Posix.Types
import qualified Data.Vector.Storable as V -- For contiguous memory and passing to C. Should perhaps be an Array instead.

foreign import ccall "select_wrapper.h select_wrapper"
        c_select_wrapper :: Ptr CInt -> CInt -> 
                            Ptr CInt -> CInt -> 
                            Ptr CInt -> CInt ->
                            CChar -> CLong -> CLong -> 
                            IO CInt

-- | @'select' readFds writeFds exceptFds timeout@ calls the
-- @select(2)@ function with the file descriptors in @readFds@ as the
-- FD set to watch for read readiness, and similarly for @writeFds@
-- and @exceptFds@, with @timeout@ specifying the timeout. The return
-- value is that of the call.
select :: [Fd] -> [Fd] -> [Fd] -> Timeout -> IO CInt
select readFds writeFds exceptFds timeout =
    let
        rfds = V.fromList (map fromIntegral readFds) :: V.Vector CInt -- Make contiguous memory.
        nr = fromIntegral (V.length rfds)
        wfds = V.fromList (map fromIntegral writeFds) :: V.Vector CInt
        nw = fromIntegral (V.length wfds)
        efds = V.fromList (map fromIntegral exceptFds) :: V.Vector CInt
        ne = fromIntegral (V.length efds)
        (tFlag, s, us) = timeoutToC timeout
    in
      -- Yikes, the next line is ugly. But stare at unsafeWith, and you'll see this is right.
      V.unsafeWith rfds $ \pr -> V.unsafeWith wfds $ \pw -> V.unsafeWith efds $ \pe -> 
      c_select_wrapper pr nr pw nw pe ne tFlag s us 

timeoutToC :: Timeout -> (CChar, CLong, CLong)
timeoutToC Never = (0, 0, 0)
timeoutToC (Time s us) = (1, fromIntegral s, fromIntegral us)