module GHC.Event.Internal
(
Backend
, backend
, delete
, poll
, modifyFd
, modifyFdOnce
, module GHC.Event.Internal.Types
, throwErrnoIfMinus1NoRetry
, exchangePtr
) where
import Foreign.C.Error (eINTR, getErrno, throwErrno)
import System.Posix.Types (Fd)
import GHC.Base
import GHC.Num (Num(..))
import GHC.Event.Internal.Types
import GHC.Ptr (Ptr(..))
data Backend = forall a. Backend {
_beState :: !a
, _bePoll :: a
-> Maybe Timeout
-> (Fd -> Event -> IO ())
-> IO Int
, _beModifyFd :: a
-> Fd
-> Event
-> Event
-> IO Bool
, _beModifyFdOnce :: a
-> Fd
-> Event
-> IO Bool
, _beDelete :: a -> IO ()
}
backend :: (a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)
-> (a -> Fd -> Event -> Event -> IO Bool)
-> (a -> Fd -> Event -> IO Bool)
-> (a -> IO ())
-> a
-> Backend
backend bPoll bModifyFd bModifyFdOnce bDelete state =
Backend state bPoll bModifyFd bModifyFdOnce bDelete
poll :: Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
poll (Backend bState bPoll _ _ _) = bPoll bState
modifyFd :: Backend -> Fd -> Event -> Event -> IO Bool
modifyFd (Backend bState _ bModifyFd _ _) = bModifyFd bState
modifyFdOnce :: Backend -> Fd -> Event -> IO Bool
modifyFdOnce (Backend bState _ _ bModifyFdOnce _) = bModifyFdOnce bState
delete :: Backend -> IO ()
delete (Backend bState _ _ _ bDelete) = bDelete bState
throwErrnoIfMinus1NoRetry :: (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1NoRetry loc f = do
res <- f
if res == 1
then do
err <- getErrno
if err == eINTR then return 0 else throwErrno loc
else return res
exchangePtr :: Ptr (Ptr a) -> Ptr a -> IO (Ptr a)
exchangePtr (Ptr dst) (Ptr val) =
IO $ \s ->
case (atomicExchangeAddrAddr# dst val s) of
(# s2, old_val #) -> (# s2, Ptr old_val #)