{-# language BangPatterns #-}
{-# language DataKinds #-}
{-# language GADTSyntax #-}
{-# language KindSignatures #-}
{-# language MagicHash #-}
{-# language UnliftedFFITypes #-}
{-# language NamedFieldPuns #-}
{-# language UnboxedTuples #-}
module Linux.Epoll
(
uninterruptibleCreate
, uninterruptibleCreate1
, waitMutablePrimArray
, uninterruptibleWaitMutablePrimArray
, uninterruptibleControlMutablePrimArray
, EpollFlags(..)
, ControlOperation(..)
, Events(..)
, Event(..)
, Exchange(..)
, PrimEpollData
, T.closeOnExec
, T.add
, T.modify
, T.delete
, T.input
, T.output
, T.priority
, T.hangup
, T.readHangup
, T.error
, T.edgeTriggered
, T.containsAnyEvents
, T.containsAllEvents
, T.sizeofEvent
, T.peekEventEvents
, T.peekEventDataFd
, T.peekEventDataPtr
, T.peekEventDataU32
, T.peekEventDataU64
, T.pokeEventDataU64
) where
import Prelude hiding (error)
import Assertion (assertMutablePrimArrayPinned)
import Data.Primitive (MutablePrimArray(..))
import Foreign.C.Error (Errno,getErrno)
import Foreign.C.Types (CInt(..))
import GHC.Exts (RealWorld,MutableByteArray#)
import Linux.Epoll.Types (EpollFlags(..),ControlOperation(..),Events(..),Exchange(..))
import Linux.Epoll.Types (Event(..),PrimEpollData(..))
import System.Posix.Types (Fd(..))
import qualified Linux.Epoll.Types as T
foreign import ccall unsafe "sys/epoll.h epoll_create"
c_epoll_create :: CInt -> IO Fd
foreign import ccall unsafe "sys/epoll.h epoll_create1"
c_epoll_create1 :: EpollFlags -> IO Fd
foreign import ccall unsafe "sys/epoll.h epoll_wait"
c_epoll_wait_unsafe :: Fd -> MutableByteArray# RealWorld -> CInt -> CInt -> IO CInt
foreign import ccall safe "sys/epoll.h epoll_wait"
c_epoll_wait_safe :: Fd -> MutableByteArray# RealWorld -> CInt -> CInt -> IO CInt
foreign import ccall unsafe "sys/epoll.h epoll_ctl"
c_epoll_ctl_unsafe :: Fd -> ControlOperation -> Fd -> MutableByteArray# RealWorld -> IO CInt
uninterruptibleCreate ::
CInt
-> IO (Either Errno Fd)
{-# inline uninterruptibleCreate #-}
uninterruptibleCreate !sz = c_epoll_create sz >>= errorsFromFd
uninterruptibleCreate1 ::
EpollFlags
-> IO (Either Errno Fd)
{-# inline uninterruptibleCreate1 #-}
uninterruptibleCreate1 !flags =
c_epoll_create1 flags >>= errorsFromFd
uninterruptibleWaitMutablePrimArray ::
Fd
-> MutablePrimArray RealWorld (Event 'Response a)
-> CInt
-> IO (Either Errno CInt)
{-# inline uninterruptibleWaitMutablePrimArray #-}
uninterruptibleWaitMutablePrimArray !epfd (MutablePrimArray evs) !maxEvents =
c_epoll_wait_unsafe epfd evs maxEvents 0 >>= errorsFromInt
waitMutablePrimArray ::
Fd
-> MutablePrimArray RealWorld (Event 'Response a)
-> CInt
-> CInt
-> IO (Either Errno CInt)
{-# inline waitMutablePrimArray #-}
waitMutablePrimArray !epfd !evs !maxEvents !timeout =
let !(MutablePrimArray evs#) = assertMutablePrimArrayPinned evs
in c_epoll_wait_safe epfd evs# maxEvents timeout >>= errorsFromInt
uninterruptibleControlMutablePrimArray ::
Fd
-> ControlOperation
-> Fd
-> MutablePrimArray RealWorld (Event 'Request a)
-> IO (Either Errno ())
{-# inline uninterruptibleControlMutablePrimArray #-}
uninterruptibleControlMutablePrimArray !epfd !op !fd (MutablePrimArray ev) =
c_epoll_ctl_unsafe epfd op fd ev >>= errorsFromInt_
errorsFromFd :: Fd -> IO (Either Errno Fd)
{-# inline errorsFromFd #-}
errorsFromFd r = if r > (-1)
then pure (Right r)
else fmap Left getErrno
errorsFromInt :: CInt -> IO (Either Errno CInt)
{-# inline errorsFromInt #-}
errorsFromInt r = if r > (-1)
then pure (Right r)
else fmap Left getErrno
errorsFromInt_ :: CInt -> IO (Either Errno ())
{-# inline errorsFromInt_ #-}
errorsFromInt_ r = if r == 0
then pure (Right ())
else fmap Left getErrno