{-# LANGUAGE ForeignFunctionInterface #-}

-- | Interface to @select(2)@. The arguments to the functions exposed
-- here must fulfill the same requirements as the arguments for
-- @select@ itself; see the man page.
--
-- If the @select@ call made by any of these functions is interrupted
-- (@select@ returning @-1@ and @errno@ being @EINTR@) before the
-- given time has elapsed, the call will be retried. If the specified
-- amount of time has passed and @select@ is still being interrupted,
-- the functions below will make one last attempt with timeout
-- zero. If that call too is interrupted, behavior will be as if
-- @select@ returned an error.
module System.Posix.IO.Select (select, select', select'') where

import System.Posix.IO.Select.Types 
import qualified System.Posix.IO.Select.FdSet as FS
import qualified System.Posix.IO.Select.FdSet.Unsafe as FSUNSAFE
import qualified System.Posix.IO.Select.FdSet.Internal as FSI
import Foreign
import Foreign.C.Types
import System.Posix.Types
import Foreign.Ptr
import Foreign.ForeignPtr
import Misc

foreign import ccall "Select/cbits.h xselect"
        c_xselect :: Fd -> Ptr () -> Ptr () -> Ptr () -> Ptr () -> IO CInt
--                   nfds  readfds   writefds  exceptfds timeout    

-- | The first 'FS.FdSet' is watched for readiness to read, the second
-- for readiness to write, and the third for exceptions. The 'Timeout'
-- argument specifies when @select@ should time out (if at all). 
select :: FS.FdSet -> FS.FdSet -> FS.FdSet -> Timeout -> IO Result
select rfds wfds efds timeout =
    (
     case timeout of
       Never -> nullForeignPtr
       Time timeval -> mallocInitForeignPtr ((flip poke) timeval)
    ) >>= \timevalp ->
    FS.duplicate rfds >>= \(FSI.FdSet rfdsp brfd) ->
    FS.duplicate wfds >>= \(FSI.FdSet wfdsp bwfd) ->
    FS.duplicate efds >>= \(FSI.FdSet efdsp befd) ->
    withForeignPtr rfdsp $ \rfdsp' -> 
    withForeignPtr wfdsp $ \wfdsp' -> 
    withForeignPtr efdsp $ \efdsp' ->
    withForeignPtr timevalp $ \timevalp' -> 
    c_xselect (1 + maximum [brfd, bwfd, befd]) rfdsp' wfdsp' efdsp' (castPtr timevalp') >>= \ret ->
    return (
            if cError ret
            then Error
            else if cTrue ret
                 then Ready ret (FSI.FdSet rfdsp brfd) (FSI.FdSet wfdsp bwfd) (FSI.FdSet efdsp befd)
                 else Timeout
           )

-- | A simpler version of 'select' that uses file descriptor lists
-- instead of 'FS.FdSet's. 'Nothing' is returned in case @select@ gives
-- an error, otherwise @'Just' (rfds, wfds, efds)@ is returned, where
-- @rfds@, @wfds@ and @efds@ are lists of ready file descriptors (they
-- may be empty, such as in the case of @select@ timing out).
select' :: [Fd] -> [Fd] -> [Fd] -> Timeout -> IO (Maybe ([Fd], [Fd], [Fd]))
select' rfds wfds efds timeout =
    (
     case timeout of
       Never -> nullForeignPtr
       Time timeval -> mallocInitForeignPtr ((flip poke) timeval)
    ) >>= \timevalp ->
    FS.fromList rfds >>= \rset@(FSI.FdSet rfdsp brfd) ->
    FS.fromList wfds >>= \wset@(FSI.FdSet wfdsp bwfd) ->
    FS.fromList efds >>= \eset@(FSI.FdSet efdsp befd) ->
    withForeignPtr rfdsp $ \rfdsp' -> 
    withForeignPtr wfdsp $ \wfdsp' -> 
    withForeignPtr efdsp $ \efdsp' ->
    withForeignPtr timevalp $ \timevalp' -> 
    c_xselect (1 + maximum [brfd, bwfd, befd]) rfdsp' wfdsp' efdsp' (castPtr timevalp') >>= \ret ->
    if cError ret
    then return Nothing
    else FS.inList rfds rset >>= \rfds' ->
         FS.inList wfds wset >>= \wfds' ->
         FS.inList efds eset >>= \efds' ->
         return $ Just (rfds', wfds', efds')

-- | This simpler version of 'select' takes the same arguments as
-- 'select'', but only returns the return value of @select(2)@ itself
-- (i.e. @-1@ on error, otherwise the number of ready file descriptors
-- in total).
select'' :: [Fd] -> [Fd] -> [Fd] -> Timeout -> IO CInt
select'' rfds wfds efds timeout =
    (
     case timeout of
       Never -> nullForeignPtr
       Time timeval -> mallocInitForeignPtr ((flip poke) timeval)
    ) >>= \timevalp ->
    FS.fromList rfds >>= \rset@(FSI.FdSet rfdsp brfd) ->
    FS.fromList wfds >>= \wset@(FSI.FdSet wfdsp bwfd) ->
    FS.fromList efds >>= \eset@(FSI.FdSet efdsp befd) ->
    withForeignPtr rfdsp $ \rfdsp' -> 
    withForeignPtr wfdsp $ \wfdsp' -> 
    withForeignPtr efdsp $ \efdsp' ->
    withForeignPtr timevalp $ \timevalp' -> 
    c_xselect (1 + maximum [brfd, bwfd, befd]) rfdsp' wfdsp' efdsp' (castPtr timevalp')