{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnliftedFFITypes #-}
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 (MutableByteArray#, RealWorld)
import Linux.Epoll.Types (ControlOperation (..), EpollFlags (..), Event (..), Events (..), Exchange (..), 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 IO Fd -> (Fd -> IO (Either Errno Fd)) -> IO (Either Errno Fd)
forall a b. IO a -> (a -> IO b) -> IO b
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 IO Fd -> (Fd -> IO (Either Errno Fd)) -> IO (Either Errno Fd)
forall a b. IO a -> (a -> IO b) -> IO b
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 IO CInt
-> (CInt -> IO (Either Errno CInt)) -> IO (Either Errno CInt)
forall a b. IO a -> (a -> IO b) -> IO b
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#) = MutablePrimArray RealWorld (Event 'Response a)
-> MutablePrimArray RealWorld (Event 'Response a)
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 IO CInt
-> (CInt -> IO (Either Errno CInt)) -> IO (Either Errno CInt)
forall a b. IO a -> (a -> IO b) -> IO b
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 IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
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 Fd -> Fd -> Bool
forall a. Ord a => a -> a -> Bool
> (-Fd
1)
then Either Errno Fd -> IO (Either Errno Fd)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fd -> Either Errno Fd
forall a b. b -> Either a b
Right Fd
r)
else (Errno -> Either Errno Fd) -> IO Errno -> IO (Either Errno Fd)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno Fd
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 CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> (-CInt
1)
then Either Errno CInt -> IO (Either Errno CInt)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> Either Errno CInt
forall a b. b -> Either a b
Right CInt
r)
else (Errno -> Either Errno CInt) -> IO Errno -> IO (Either Errno CInt)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno CInt
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 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
then Either Errno () -> IO (Either Errno ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either Errno ()
forall a b. b -> Either a b
Right ())
else (Errno -> Either Errno ()) -> IO Errno -> IO (Either Errno ())
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno ()
forall a b. a -> Either a b
Left IO Errno
getErrno