{-# LINE 1 "src/System/Posix/IO/Select/Types.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "src/System/Posix/IO/Select/Types.hsc" #-}

-- | Various types.
module System.Posix.IO.Select.Types where

import Foreign.C.Types
import Foreign.Storable
import qualified System.Posix.IO.Select.FdSet.Unsafe as FSUNSAFE
import qualified System.Posix.IO.Select.FdSet as FS

-- | A timeout of @'Never'@ tells @select(2)@ to never time out, while
-- @'Time'@ sets a finite timeout.
data Timeout = Never | Time CTimeval

-- | A 'Storable' instance for @struct timeval@ (see @select(2)@). The
-- first argument corresponds to @tv_sec@, the second to @tv_usec@.
data CTimeval = CTimeval CLong CLong

-- | @'finite' s us@ tells @select@ to time out after @s@ seconds and
-- @us@ microseconds.
finite :: CLong -> CLong -> Timeout
finite s us = Time (CTimeval s us)


{-# LINE 25 "src/System/Posix/IO/Select/Types.hsc" #-}

{-# LINE 26 "src/System/Posix/IO/Select/Types.hsc" #-}
instance Storable CTimeval where
    sizeOf _ = (8)
{-# LINE 28 "src/System/Posix/IO/Select/Types.hsc" #-}
    alignment _ = 4
{-# LINE 29 "src/System/Posix/IO/Select/Types.hsc" #-}
    peek ptr = (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr >>= \s ->
{-# LINE 30 "src/System/Posix/IO/Select/Types.hsc" #-}
               (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr >>= \us ->
{-# LINE 31 "src/System/Posix/IO/Select/Types.hsc" #-}
               return (CTimeval s us)
    poke ptr (CTimeval s us) = (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr s >>
{-# LINE 33 "src/System/Posix/IO/Select/Types.hsc" #-}
                               (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr us
{-# LINE 34 "src/System/Posix/IO/Select/Types.hsc" #-}

-- | Abstraction for the return value of @select@. @'Error'@ means
-- that @select@ returned an error, while 'Timeout' means it
-- timed out. @'Ready' n rfds wfds efds@ specifies that it returned
-- because the file descriptors in @rfds@, @wfds@ and @efds@ are ready
-- in their respective ways (see @select(2)@), with @n@ descriptors in
-- total.
data Result = Error | Timeout | Ready CInt FS.FdSet FS.FdSet FS.FdSet

-- | The total number of ready file descriptors across all three sets.
numReady :: Result -> CInt
numReady Error = 0
numReady Timeout  = 0
numReady (Ready n _ _ _) = n

-- | The file descriptors ready for reading.
readyRead :: Result -> FS.FdSet
readyRead Error = FSUNSAFE.empty
readyRead Timeout = FSUNSAFE.empty
readyRead (Ready _ rfds _ _) = rfds

-- | The file descriptors ready for writing.
readyWrite :: Result -> FS.FdSet
readyWrite Error = FSUNSAFE.empty
readyWrite Timeout = FSUNSAFE.empty
readyWrite (Ready _ _ wfds _) = wfds

-- | The file descriptors having exceptional conditions.
readyException :: Result -> FS.FdSet
readyException Error = FSUNSAFE.empty
readyException Timeout = FSUNSAFE.empty
readyException (Ready _ _ _ efds) = efds