{-# 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