{-# 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 :: CInt -> IO (Either Errno Fd)
uninterruptibleCreate !CInt
sz = CInt -> IO Fd
c_epoll_create CInt
sz forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd
uninterruptibleCreate1 ::
EpollFlags
-> IO (Either Errno Fd)
{-# inline uninterruptibleCreate1 #-}
uninterruptibleCreate1 :: EpollFlags -> IO (Either Errno Fd)
uninterruptibleCreate1 !EpollFlags
flags =
EpollFlags -> IO Fd
c_epoll_create1 EpollFlags
flags forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd
uninterruptibleWaitMutablePrimArray ::
Fd
-> MutablePrimArray RealWorld (Event 'Response a)
-> CInt
-> IO (Either Errno CInt)
{-# inline uninterruptibleWaitMutablePrimArray #-}
uninterruptibleWaitMutablePrimArray :: forall a.
Fd
-> MutablePrimArray RealWorld (Event 'Response a)
-> CInt
-> IO (Either Errno CInt)
uninterruptibleWaitMutablePrimArray !Fd
epfd (MutablePrimArray MutableByteArray# RealWorld
evs) !CInt
maxEvents =
Fd -> MutableByteArray# RealWorld -> CInt -> CInt -> IO CInt
c_epoll_wait_unsafe Fd
epfd MutableByteArray# RealWorld
evs CInt
maxEvents CInt
0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno CInt)
errorsFromInt
waitMutablePrimArray ::
Fd
-> MutablePrimArray RealWorld (Event 'Response a)
-> CInt
-> CInt
-> IO (Either Errno CInt)
{-# inline waitMutablePrimArray #-}
waitMutablePrimArray :: forall a.
Fd
-> MutablePrimArray RealWorld (Event 'Response a)
-> CInt
-> CInt
-> IO (Either Errno CInt)
waitMutablePrimArray !Fd
epfd !MutablePrimArray RealWorld (Event 'Response a)
evs !CInt
maxEvents !CInt
timeout =
let !(MutablePrimArray MutableByteArray# RealWorld
evs#) = forall s a. MutablePrimArray s a -> MutablePrimArray s a
assertMutablePrimArrayPinned MutablePrimArray RealWorld (Event 'Response a)
evs
in Fd -> MutableByteArray# RealWorld -> CInt -> CInt -> IO CInt
c_epoll_wait_safe Fd
epfd MutableByteArray# RealWorld
evs# CInt
maxEvents CInt
timeout forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno CInt)
errorsFromInt
uninterruptibleControlMutablePrimArray ::
Fd
-> ControlOperation
-> Fd
-> MutablePrimArray RealWorld (Event 'Request a)
-> IO (Either Errno ())
{-# inline uninterruptibleControlMutablePrimArray #-}
uninterruptibleControlMutablePrimArray :: forall a.
Fd
-> ControlOperation
-> Fd
-> MutablePrimArray RealWorld (Event 'Request a)
-> IO (Either Errno ())
uninterruptibleControlMutablePrimArray !Fd
epfd !ControlOperation
op !Fd
fd (MutablePrimArray MutableByteArray# RealWorld
ev) =
Fd
-> ControlOperation -> Fd -> MutableByteArray# RealWorld -> IO CInt
c_epoll_ctl_unsafe Fd
epfd ControlOperation
op Fd
fd MutableByteArray# RealWorld
ev forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_
errorsFromFd :: Fd -> IO (Either Errno Fd)
{-# inline errorsFromFd #-}
errorsFromFd :: Fd -> IO (Either Errno Fd)
errorsFromFd Fd
r = if Fd
r forall a. Ord a => a -> a -> Bool
> (-Fd
1)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right Fd
r)
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
errorsFromInt :: CInt -> IO (Either Errno CInt)
{-# inline errorsFromInt #-}
errorsFromInt :: CInt -> IO (Either Errno CInt)
errorsFromInt CInt
r = if CInt
r forall a. Ord a => a -> a -> Bool
> (-CInt
1)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right CInt
r)
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno
errorsFromInt_ :: CInt -> IO (Either Errno ())
{-# inline errorsFromInt_ #-}
errorsFromInt_ :: CInt -> IO (Either Errno ())
errorsFromInt_ CInt
r = if CInt
r forall a. Eq a => a -> a -> Bool
== CInt
0
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right ())
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO Errno
getErrno