{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Trustworthy #-}
module GHC.Event.Manager
(
EventManager
, new
, newWith
, newDefaultBackend
, finished
, loop
, step
, shutdown
, release
, cleanup
, wakeManager
, callbackTableVar
, emControl
, Lifetime (..)
, Event
, evtRead
, evtWrite
, IOCallback
, FdKey(keyFd)
, FdData
, registerFd
, unregisterFd_
, unregisterFd
, closeFd
, closeFd_
) where
#include "EventConfig.h"
import Control.Concurrent.MVar (MVar, newMVar, putMVar,
tryPutMVar, takeMVar, withMVar)
import Control.Exception (onException)
import Data.Bits ((.&.))
import Data.Foldable (forM_)
import Data.Functor (void)
import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef,
writeIORef)
import Data.Maybe (maybe)
import Data.OldList (partition)
import GHC.Arr (Array, (!), listArray)
import GHC.Base
import GHC.Conc.Sync (yield)
import GHC.List (filter, replicate)
import GHC.Num (Num(..))
import GHC.Real (fromIntegral)
import GHC.Show (Show(..))
import GHC.Event.Control
import GHC.Event.IntTable (IntTable)
import GHC.Event.Internal (Backend, Event, evtClose, evtRead, evtWrite,
Lifetime(..), EventLifetime, Timeout(..))
import GHC.Event.Unique (Unique, UniqueSource, newSource, newUnique)
import System.Posix.Types (Fd)
import qualified GHC.Event.IntTable as IT
import qualified GHC.Event.Internal as I
#if defined(HAVE_KQUEUE)
import qualified GHC.Event.KQueue as KQueue
#elif defined(HAVE_EPOLL)
import qualified GHC.Event.EPoll as EPoll
#elif defined(HAVE_POLL)
import qualified GHC.Event.Poll as Poll
#else
# error not implemented for this operating system
#endif
data FdData = FdData {
FdData -> FdKey
fdKey :: {-# UNPACK #-} !FdKey
, FdData -> EventLifetime
fdEvents :: {-# UNPACK #-} !EventLifetime
, FdData -> IOCallback
_fdCallback :: !IOCallback
}
data FdKey = FdKey {
FdKey -> Fd
keyFd :: {-# UNPACK #-} !Fd
, FdKey -> Unique
keyUnique :: {-# UNPACK #-} !Unique
} deriving ( FdKey -> FdKey -> Bool
(FdKey -> FdKey -> Bool) -> (FdKey -> FdKey -> Bool) -> Eq FdKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FdKey -> FdKey -> Bool
$c/= :: FdKey -> FdKey -> Bool
== :: FdKey -> FdKey -> Bool
$c== :: FdKey -> FdKey -> Bool
Eq
, Int -> FdKey -> ShowS
[FdKey] -> ShowS
FdKey -> String
(Int -> FdKey -> ShowS)
-> (FdKey -> String) -> ([FdKey] -> ShowS) -> Show FdKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FdKey] -> ShowS
$cshowList :: [FdKey] -> ShowS
show :: FdKey -> String
$cshow :: FdKey -> String
showsPrec :: Int -> FdKey -> ShowS
$cshowsPrec :: Int -> FdKey -> ShowS
Show
)
type IOCallback = FdKey -> Event -> IO ()
data State = Created
| Running
| Dying
| Releasing
| Finished
deriving ( State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq
, Int -> State -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show
)
data EventManager = EventManager
{ EventManager -> Backend
emBackend :: !Backend
, EventManager -> Array Int (MVar (IntTable [FdData]))
emFds :: {-# UNPACK #-} !(Array Int (MVar (IntTable [FdData])))
, EventManager -> IORef State
emState :: {-# UNPACK #-} !(IORef State)
, EventManager -> UniqueSource
emUniqueSource :: {-# UNPACK #-} !UniqueSource
, EventManager -> Control
emControl :: {-# UNPACK #-} !Control
, EventManager -> MVar ()
emLock :: {-# UNPACK #-} !(MVar ())
}
callbackArraySize :: Int
callbackArraySize :: Int
callbackArraySize = Int
32
hashFd :: Fd -> Int
hashFd :: Fd -> Int
hashFd Fd
fd = Fd -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int
callbackArraySize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE hashFd #-}
callbackTableVar :: EventManager -> Fd -> MVar (IntTable [FdData])
callbackTableVar :: EventManager -> Fd -> MVar (IntTable [FdData])
callbackTableVar EventManager
mgr Fd
fd = EventManager -> Array Int (MVar (IntTable [FdData]))
emFds EventManager
mgr Array Int (MVar (IntTable [FdData]))
-> Int -> MVar (IntTable [FdData])
forall i e. Ix i => Array i e -> i -> e
! Fd -> Int
hashFd Fd
fd
{-# INLINE callbackTableVar #-}
haveOneShot :: Bool
{-# INLINE haveOneShot #-}
#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
haveOneShot = False
#elif defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)
haveOneShot :: Bool
haveOneShot = Bool
True
#else
haveOneShot = False
#endif
handleControlEvent :: EventManager -> Fd -> Event -> IO ()
handleControlEvent :: EventManager -> Fd -> Event -> IO ()
handleControlEvent EventManager
mgr Fd
fd Event
_evt = do
ControlMessage
msg <- Control -> Fd -> IO ControlMessage
readControlMessage (EventManager -> Control
emControl EventManager
mgr) Fd
fd
case ControlMessage
msg of
ControlMessage
CMsgWakeup -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ControlMessage
CMsgDie -> IORef State -> State -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (EventManager -> IORef State
emState EventManager
mgr) State
Finished
ControlMessage
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
newDefaultBackend :: IO Backend
#if defined(HAVE_KQUEUE)
newDefaultBackend = KQueue.new
#elif defined(HAVE_EPOLL)
newDefaultBackend :: IO Backend
newDefaultBackend = IO Backend
EPoll.new
#elif defined(HAVE_POLL)
newDefaultBackend = Poll.new
#else
newDefaultBackend = errorWithoutStackTrace "no back end for this platform"
#endif
new :: IO EventManager
new :: IO EventManager
new = Backend -> IO EventManager
newWith (Backend -> IO EventManager) -> IO Backend -> IO EventManager
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Backend
newDefaultBackend
newWith :: Backend -> IO EventManager
newWith :: Backend -> IO EventManager
newWith Backend
be = do
Array Int (MVar (IntTable [FdData]))
iofds <- ([MVar (IntTable [FdData])]
-> Array Int (MVar (IntTable [FdData])))
-> IO [MVar (IntTable [FdData])]
-> IO (Array Int (MVar (IntTable [FdData])))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int, Int)
-> [MVar (IntTable [FdData])]
-> Array Int (MVar (IntTable [FdData]))
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int
callbackArraySizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) (IO [MVar (IntTable [FdData])]
-> IO (Array Int (MVar (IntTable [FdData]))))
-> IO [MVar (IntTable [FdData])]
-> IO (Array Int (MVar (IntTable [FdData])))
forall a b. (a -> b) -> a -> b
$
Int
-> IO (MVar (IntTable [FdData])) -> IO [MVar (IntTable [FdData])]
forall {m :: * -> *} {a}. Monad m => Int -> m a -> m [a]
replicateM Int
callbackArraySize (IntTable [FdData] -> IO (MVar (IntTable [FdData]))
forall a. a -> IO (MVar a)
newMVar (IntTable [FdData] -> IO (MVar (IntTable [FdData])))
-> IO (IntTable [FdData]) -> IO (MVar (IntTable [FdData]))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO (IntTable [FdData])
forall a. Int -> IO (IntTable a)
IT.new Int
8)
Control
ctrl <- Bool -> IO Control
newControl Bool
False
IORef State
state <- State -> IO (IORef State)
forall a. a -> IO (IORef a)
newIORef State
Created
UniqueSource
us <- IO UniqueSource
newSource
Weak (IORef State)
_ <- IORef State -> IO () -> IO (Weak (IORef State))
forall a. IORef a -> IO () -> IO (Weak (IORef a))
mkWeakIORef IORef State
state (IO () -> IO (Weak (IORef State)))
-> IO () -> IO (Weak (IORef State))
forall a b. (a -> b) -> a -> b
$ do
State
st <- IORef State -> (State -> (State, State)) -> IO State
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef State
state ((State -> (State, State)) -> IO State)
-> (State -> (State, State)) -> IO State
forall a b. (a -> b) -> a -> b
$ \State
s -> (State
Finished, State
s)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (State
st State -> State -> Bool
forall a. Eq a => a -> a -> Bool
/= State
Finished) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Backend -> IO ()
I.delete Backend
be
Control -> IO ()
closeControl Control
ctrl
MVar ()
lockVar <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
let mgr :: EventManager
mgr = EventManager { emBackend :: Backend
emBackend = Backend
be
, emFds :: Array Int (MVar (IntTable [FdData]))
emFds = Array Int (MVar (IntTable [FdData]))
iofds
, emState :: IORef State
emState = IORef State
state
, emUniqueSource :: UniqueSource
emUniqueSource = UniqueSource
us
, emControl :: Control
emControl = Control
ctrl
, emLock :: MVar ()
emLock = MVar ()
lockVar
}
EventManager -> Fd -> Event -> IO ()
registerControlFd EventManager
mgr (Control -> Fd
controlReadFd Control
ctrl) Event
evtRead
EventManager -> Fd -> Event -> IO ()
registerControlFd EventManager
mgr (Control -> Fd
wakeupReadFd Control
ctrl) Event
evtRead
EventManager -> IO EventManager
forall (m :: * -> *) a. Monad m => a -> m a
return EventManager
mgr
where
replicateM :: Int -> m a -> m [a]
replicateM Int
n m a
x = [m a] -> m [a]
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (Int -> m a -> [m a]
forall a. Int -> a -> [a]
replicate Int
n m a
x)
failOnInvalidFile :: String -> Fd -> IO Bool -> IO ()
failOnInvalidFile :: String -> Fd -> IO Bool -> IO ()
failOnInvalidFile String
loc Fd
fd IO Bool
m = do
Bool
ok <- IO Bool
m
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
ok) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
let msg :: String
msg = String
"Failed while attempting to modify registration of file " String -> ShowS
forall a. [a] -> [a] -> [a]
++
Fd -> String
forall a. Show a => a -> String
show Fd
fd String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at location " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
loc
in String -> IO ()
forall a. String -> a
errorWithoutStackTrace String
msg
registerControlFd :: EventManager -> Fd -> Event -> IO ()
registerControlFd :: EventManager -> Fd -> Event -> IO ()
registerControlFd EventManager
mgr Fd
fd Event
evs =
String -> Fd -> IO Bool -> IO ()
failOnInvalidFile String
"registerControlFd" Fd
fd (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$
Backend -> Fd -> Event -> Event -> IO Bool
I.modifyFd (EventManager -> Backend
emBackend EventManager
mgr) Fd
fd Event
forall a. Monoid a => a
mempty Event
evs
shutdown :: EventManager -> IO ()
shutdown :: EventManager -> IO ()
shutdown EventManager
mgr = do
State
state <- IORef State -> (State -> (State, State)) -> IO State
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (EventManager -> IORef State
emState EventManager
mgr) ((State -> (State, State)) -> IO State)
-> (State -> (State, State)) -> IO State
forall a b. (a -> b) -> a -> b
$ \State
s -> (State
Dying, State
s)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (State
state State -> State -> Bool
forall a. Eq a => a -> a -> Bool
== State
Running) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Control -> IO ()
sendDie (EventManager -> Control
emControl EventManager
mgr)
release :: EventManager -> IO ()
release :: EventManager -> IO ()
release EventManager{MVar ()
UniqueSource
Array Int (MVar (IntTable [FdData]))
IORef State
Backend
Control
emLock :: MVar ()
emControl :: Control
emUniqueSource :: UniqueSource
emState :: IORef State
emFds :: Array Int (MVar (IntTable [FdData]))
emBackend :: Backend
emLock :: EventManager -> MVar ()
emUniqueSource :: EventManager -> UniqueSource
emState :: EventManager -> IORef State
emFds :: EventManager -> Array Int (MVar (IntTable [FdData]))
emBackend :: EventManager -> Backend
emControl :: EventManager -> Control
..} = do
State
state <- IORef State -> (State -> (State, State)) -> IO State
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef State
emState ((State -> (State, State)) -> IO State)
-> (State -> (State, State)) -> IO State
forall a b. (a -> b) -> a -> b
$ \State
s -> (State
Releasing, State
s)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (State
state State -> State -> Bool
forall a. Eq a => a -> a -> Bool
== State
Running) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Control -> IO ()
sendWakeup Control
emControl
finished :: EventManager -> IO Bool
finished :: EventManager -> IO Bool
finished EventManager
mgr = (State -> State -> Bool
forall a. Eq a => a -> a -> Bool
== State
Finished) (State -> Bool) -> IO State -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` IORef State -> IO State
forall a. IORef a -> IO a
readIORef (EventManager -> IORef State
emState EventManager
mgr)
cleanup :: EventManager -> IO ()
cleanup :: EventManager -> IO ()
cleanup EventManager{MVar ()
UniqueSource
Array Int (MVar (IntTable [FdData]))
IORef State
Backend
Control
emLock :: MVar ()
emControl :: Control
emUniqueSource :: UniqueSource
emState :: IORef State
emFds :: Array Int (MVar (IntTable [FdData]))
emBackend :: Backend
emLock :: EventManager -> MVar ()
emUniqueSource :: EventManager -> UniqueSource
emState :: EventManager -> IORef State
emFds :: EventManager -> Array Int (MVar (IntTable [FdData]))
emBackend :: EventManager -> Backend
emControl :: EventManager -> Control
..} = do
IORef State -> State -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef State
emState State
Finished
IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar ()
emLock ()
Backend -> IO ()
I.delete Backend
emBackend
Control -> IO ()
closeControl Control
emControl
loop :: EventManager -> IO ()
loop :: EventManager -> IO ()
loop mgr :: EventManager
mgr@EventManager{MVar ()
UniqueSource
Array Int (MVar (IntTable [FdData]))
IORef State
Backend
Control
emLock :: MVar ()
emControl :: Control
emUniqueSource :: UniqueSource
emState :: IORef State
emFds :: Array Int (MVar (IntTable [FdData]))
emBackend :: Backend
emLock :: EventManager -> MVar ()
emUniqueSource :: EventManager -> UniqueSource
emState :: EventManager -> IORef State
emFds :: EventManager -> Array Int (MVar (IntTable [FdData]))
emBackend :: EventManager -> Backend
emControl :: EventManager -> Control
..} = do
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
emLock
State
state <- IORef State -> (State -> (State, State)) -> IO State
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef State
emState ((State -> (State, State)) -> IO State)
-> (State -> (State, State)) -> IO State
forall a b. (a -> b) -> a -> b
$ \State
s -> case State
s of
State
Created -> (State
Running, State
s)
State
Releasing -> (State
Running, State
s)
State
_ -> (State
s, State
s)
case State
state of
State
Created -> IO ()
go IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`onException` EventManager -> IO ()
cleanup EventManager
mgr
State
Releasing -> IO ()
go IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`onException` EventManager -> IO ()
cleanup EventManager
mgr
State
Dying -> EventManager -> IO ()
cleanup EventManager
mgr
State
Finished -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
State
_ -> do EventManager -> IO ()
cleanup EventManager
mgr
String -> IO ()
forall a. String -> a
errorWithoutStackTrace (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"GHC.Event.Manager.loop: state is already " String -> ShowS
forall a. [a] -> [a] -> [a]
++
State -> String
forall a. Show a => a -> String
show State
state
where
go :: IO ()
go = do State
state <- EventManager -> IO State
step EventManager
mgr
case State
state of
State
Running -> IO ()
yield IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
go
State
Releasing -> MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
emLock ()
State
_ -> EventManager -> IO ()
cleanup EventManager
mgr
step :: EventManager -> IO State
step :: EventManager -> IO State
step mgr :: EventManager
mgr@EventManager{MVar ()
UniqueSource
Array Int (MVar (IntTable [FdData]))
IORef State
Backend
Control
emLock :: MVar ()
emControl :: Control
emUniqueSource :: UniqueSource
emState :: IORef State
emFds :: Array Int (MVar (IntTable [FdData]))
emBackend :: Backend
emLock :: EventManager -> MVar ()
emUniqueSource :: EventManager -> UniqueSource
emState :: EventManager -> IORef State
emFds :: EventManager -> Array Int (MVar (IntTable [FdData]))
emBackend :: EventManager -> Backend
emControl :: EventManager -> Control
..} = do
IO ()
waitForIO
State
state <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef IORef State
emState
State
state State -> IO State -> IO State
`seq` State -> IO State
forall (m :: * -> *) a. Monad m => a -> m a
return State
state
where
waitForIO :: IO ()
waitForIO = do
Int
n1 <- Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
I.poll Backend
emBackend Maybe Timeout
forall a. Maybe a
Nothing (EventManager -> Fd -> Event -> IO ()
onFdEvent EventManager
mgr)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO ()
yield
Int
n2 <- Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
I.poll Backend
emBackend Maybe Timeout
forall a. Maybe a
Nothing (EventManager -> Fd -> Event -> IO ()
onFdEvent EventManager
mgr)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Int
_ <- Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
I.poll Backend
emBackend (Timeout -> Maybe Timeout
forall a. a -> Maybe a
Just Timeout
Forever) (EventManager -> Fd -> Event -> IO ()
onFdEvent EventManager
mgr)
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
registerFd_ :: EventManager -> IOCallback -> Fd -> Event -> Lifetime
-> IO (FdKey, Bool)
registerFd_ :: EventManager
-> IOCallback -> Fd -> Event -> Lifetime -> IO (FdKey, Bool)
registerFd_ mgr :: EventManager
mgr@(EventManager{MVar ()
UniqueSource
Array Int (MVar (IntTable [FdData]))
IORef State
Backend
Control
emLock :: MVar ()
emControl :: Control
emUniqueSource :: UniqueSource
emState :: IORef State
emFds :: Array Int (MVar (IntTable [FdData]))
emBackend :: Backend
emLock :: EventManager -> MVar ()
emUniqueSource :: EventManager -> UniqueSource
emState :: EventManager -> IORef State
emFds :: EventManager -> Array Int (MVar (IntTable [FdData]))
emBackend :: EventManager -> Backend
emControl :: EventManager -> Control
..}) IOCallback
cb Fd
fd Event
evs Lifetime
lt = do
Unique
u <- UniqueSource -> IO Unique
newUnique UniqueSource
emUniqueSource
let fd' :: Int
fd' = Fd -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd
reg :: FdKey
reg = Fd -> Unique -> FdKey
FdKey Fd
fd Unique
u
el :: EventLifetime
el = Event -> Lifetime -> EventLifetime
I.eventLifetime Event
evs Lifetime
lt
!fdd :: FdData
fdd = FdKey -> EventLifetime -> IOCallback -> FdData
FdData FdKey
reg EventLifetime
el IOCallback
cb
(Bool
modify,Bool
ok) <- MVar (IntTable [FdData])
-> (IntTable [FdData] -> IO (Bool, Bool)) -> IO (Bool, Bool)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (EventManager -> Fd -> MVar (IntTable [FdData])
callbackTableVar EventManager
mgr Fd
fd) ((IntTable [FdData] -> IO (Bool, Bool)) -> IO (Bool, Bool))
-> (IntTable [FdData] -> IO (Bool, Bool)) -> IO (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ \IntTable [FdData]
tbl -> do
Maybe [FdData]
oldFdd <- ([FdData] -> [FdData] -> [FdData])
-> Int -> [FdData] -> IntTable [FdData] -> IO (Maybe [FdData])
forall a. (a -> a -> a) -> Int -> a -> IntTable a -> IO (Maybe a)
IT.insertWith [FdData] -> [FdData] -> [FdData]
forall a. [a] -> [a] -> [a]
(++) Int
fd' [FdData
fdd] IntTable [FdData]
tbl
let prevEvs :: EventLifetime
prevEvs :: EventLifetime
prevEvs = EventLifetime
-> ([FdData] -> EventLifetime) -> Maybe [FdData] -> EventLifetime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EventLifetime
forall a. Monoid a => a
mempty [FdData] -> EventLifetime
eventsOf Maybe [FdData]
oldFdd
el' :: EventLifetime
el' :: EventLifetime
el' = EventLifetime
prevEvs EventLifetime -> EventLifetime -> EventLifetime
forall a. Monoid a => a -> a -> a
`mappend` EventLifetime
el
case EventLifetime -> Lifetime
I.elLifetime EventLifetime
el' of
Lifetime
OneShot | Bool
haveOneShot -> do
Bool
ok <- Backend -> Fd -> Event -> IO Bool
I.modifyFdOnce Backend
emBackend Fd
fd (EventLifetime -> Event
I.elEvent EventLifetime
el')
if Bool
ok
then (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Bool
True)
else Int -> Maybe [FdData] -> IntTable [FdData] -> IO ()
forall a. Int -> Maybe a -> IntTable a -> IO ()
IT.reset Int
fd' Maybe [FdData]
oldFdd IntTable [FdData]
tbl IO () -> IO (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Bool
False)
Lifetime
_ -> do
let modify :: Bool
modify = EventLifetime
prevEvs EventLifetime -> EventLifetime -> Bool
forall a. Eq a => a -> a -> Bool
/= EventLifetime
el'
Bool
ok <- if Bool
modify
then let newEvs :: Event
newEvs = EventLifetime -> Event
I.elEvent EventLifetime
el'
oldEvs :: Event
oldEvs = EventLifetime -> Event
I.elEvent EventLifetime
prevEvs
in Backend -> Fd -> Event -> Event -> IO Bool
I.modifyFd Backend
emBackend Fd
fd Event
oldEvs Event
newEvs
else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
if Bool
ok
then (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
modify, Bool
True)
else Int -> Maybe [FdData] -> IntTable [FdData] -> IO ()
forall a. Int -> Maybe a -> IntTable a -> IO ()
IT.reset Int
fd' Maybe [FdData]
oldFdd IntTable [FdData]
tbl IO () -> IO (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Bool
False)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
ok) (IOCallback
cb FdKey
reg Event
evs)
(FdKey, Bool) -> IO (FdKey, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (FdKey
reg,Bool
modify)
{-# INLINE registerFd_ #-}
registerFd :: EventManager -> IOCallback -> Fd -> Event -> Lifetime -> IO FdKey
registerFd :: EventManager -> IOCallback -> Fd -> Event -> Lifetime -> IO FdKey
registerFd EventManager
mgr IOCallback
cb Fd
fd Event
evs Lifetime
lt = do
(FdKey
r, Bool
wake) <- EventManager
-> IOCallback -> Fd -> Event -> Lifetime -> IO (FdKey, Bool)
registerFd_ EventManager
mgr IOCallback
cb Fd
fd Event
evs Lifetime
lt
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
wake (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ EventManager -> IO ()
wakeManager EventManager
mgr
FdKey -> IO FdKey
forall (m :: * -> *) a. Monad m => a -> m a
return FdKey
r
{-# INLINE registerFd #-}
wakeManager :: EventManager -> IO ()
#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
wakeManager mgr = sendWakeup (emControl mgr)
#elif defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)
wakeManager :: EventManager -> IO ()
wakeManager EventManager
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
wakeManager mgr = sendWakeup (emControl mgr)
#endif
eventsOf :: [FdData] -> EventLifetime
eventsOf :: [FdData] -> EventLifetime
eventsOf [FdData
fdd] = FdData -> EventLifetime
fdEvents FdData
fdd
eventsOf [FdData]
fdds = [EventLifetime] -> EventLifetime
forall a. Monoid a => [a] -> a
mconcat ([EventLifetime] -> EventLifetime)
-> [EventLifetime] -> EventLifetime
forall a b. (a -> b) -> a -> b
$ (FdData -> EventLifetime) -> [FdData] -> [EventLifetime]
forall a b. (a -> b) -> [a] -> [b]
map FdData -> EventLifetime
fdEvents [FdData]
fdds
unregisterFd_ :: EventManager -> FdKey -> IO Bool
unregisterFd_ :: EventManager -> FdKey -> IO Bool
unregisterFd_ mgr :: EventManager
mgr@(EventManager{MVar ()
UniqueSource
Array Int (MVar (IntTable [FdData]))
IORef State
Backend
Control
emLock :: MVar ()
emControl :: Control
emUniqueSource :: UniqueSource
emState :: IORef State
emFds :: Array Int (MVar (IntTable [FdData]))
emBackend :: Backend
emLock :: EventManager -> MVar ()
emUniqueSource :: EventManager -> UniqueSource
emState :: EventManager -> IORef State
emFds :: EventManager -> Array Int (MVar (IntTable [FdData]))
emBackend :: EventManager -> Backend
emControl :: EventManager -> Control
..}) (FdKey Fd
fd Unique
u) =
MVar (IntTable [FdData])
-> (IntTable [FdData] -> IO Bool) -> IO Bool
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (EventManager -> Fd -> MVar (IntTable [FdData])
callbackTableVar EventManager
mgr Fd
fd) ((IntTable [FdData] -> IO Bool) -> IO Bool)
-> (IntTable [FdData] -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \IntTable [FdData]
tbl -> do
let dropReg :: [FdData] -> Maybe [FdData]
dropReg = [FdData] -> Maybe [FdData]
forall a. [a] -> Maybe [a]
nullToNothing ([FdData] -> Maybe [FdData])
-> ([FdData] -> [FdData]) -> [FdData] -> Maybe [FdData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FdData -> Bool) -> [FdData] -> [FdData]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
/= Unique
u) (Unique -> Bool) -> (FdData -> Unique) -> FdData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FdKey -> Unique
keyUnique (FdKey -> Unique) -> (FdData -> FdKey) -> FdData -> Unique
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FdData -> FdKey
fdKey)
fd' :: Int
fd' = Fd -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd
pairEvents :: [FdData] -> IO (EventLifetime, EventLifetime)
pairEvents :: [FdData] -> IO (EventLifetime, EventLifetime)
pairEvents [FdData]
prev = do
EventLifetime
r <- EventLifetime
-> ([FdData] -> EventLifetime) -> Maybe [FdData] -> EventLifetime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EventLifetime
forall a. Monoid a => a
mempty [FdData] -> EventLifetime
eventsOf (Maybe [FdData] -> EventLifetime)
-> IO (Maybe [FdData]) -> IO EventLifetime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> IntTable [FdData] -> IO (Maybe [FdData])
forall a. Int -> IntTable a -> IO (Maybe a)
IT.lookup Int
fd' IntTable [FdData]
tbl
(EventLifetime, EventLifetime) -> IO (EventLifetime, EventLifetime)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FdData] -> EventLifetime
eventsOf [FdData]
prev, EventLifetime
r)
(EventLifetime
oldEls, EventLifetime
newEls) <- ([FdData] -> Maybe [FdData])
-> Int -> IntTable [FdData] -> IO (Maybe [FdData])
forall a. (a -> Maybe a) -> Int -> IntTable a -> IO (Maybe a)
IT.updateWith [FdData] -> Maybe [FdData]
dropReg Int
fd' IntTable [FdData]
tbl IO (Maybe [FdData])
-> (Maybe [FdData] -> IO (EventLifetime, EventLifetime))
-> IO (EventLifetime, EventLifetime)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
IO (EventLifetime, EventLifetime)
-> ([FdData] -> IO (EventLifetime, EventLifetime))
-> Maybe [FdData]
-> IO (EventLifetime, EventLifetime)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((EventLifetime, EventLifetime) -> IO (EventLifetime, EventLifetime)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventLifetime
forall a. Monoid a => a
mempty, EventLifetime
forall a. Monoid a => a
mempty)) [FdData] -> IO (EventLifetime, EventLifetime)
pairEvents
let modify :: Bool
modify = EventLifetime
oldEls EventLifetime -> EventLifetime -> Bool
forall a. Eq a => a -> a -> Bool
/= EventLifetime
newEls
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
modify (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Fd -> IO Bool -> IO ()
failOnInvalidFile String
"unregisterFd_" Fd
fd (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$
case EventLifetime -> Lifetime
I.elLifetime EventLifetime
newEls of
Lifetime
OneShot | EventLifetime -> Event
I.elEvent EventLifetime
newEls Event -> Event -> Bool
forall a. Eq a => a -> a -> Bool
/= Event
forall a. Monoid a => a
mempty, Bool
haveOneShot ->
Backend -> Fd -> Event -> IO Bool
I.modifyFdOnce Backend
emBackend Fd
fd (EventLifetime -> Event
I.elEvent EventLifetime
newEls)
Lifetime
_ ->
Backend -> Fd -> Event -> Event -> IO Bool
I.modifyFd Backend
emBackend Fd
fd (EventLifetime -> Event
I.elEvent EventLifetime
oldEls) (EventLifetime -> Event
I.elEvent EventLifetime
newEls)
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
modify
unregisterFd :: EventManager -> FdKey -> IO ()
unregisterFd :: EventManager -> FdKey -> IO ()
unregisterFd EventManager
mgr FdKey
reg = do
Bool
wake <- EventManager -> FdKey -> IO Bool
unregisterFd_ EventManager
mgr FdKey
reg
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
wake (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ EventManager -> IO ()
wakeManager EventManager
mgr
closeFd :: EventManager -> (Fd -> IO ()) -> Fd -> IO ()
closeFd :: EventManager -> (Fd -> IO ()) -> Fd -> IO ()
closeFd EventManager
mgr Fd -> IO ()
close Fd
fd = do
[FdData]
fds <- MVar (IntTable [FdData])
-> (IntTable [FdData] -> IO [FdData]) -> IO [FdData]
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (EventManager -> Fd -> MVar (IntTable [FdData])
callbackTableVar EventManager
mgr Fd
fd) ((IntTable [FdData] -> IO [FdData]) -> IO [FdData])
-> (IntTable [FdData] -> IO [FdData]) -> IO [FdData]
forall a b. (a -> b) -> a -> b
$ \IntTable [FdData]
tbl -> do
Maybe [FdData]
prev <- Int -> IntTable [FdData] -> IO (Maybe [FdData])
forall a. Int -> IntTable a -> IO (Maybe a)
IT.delete (Fd -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd) IntTable [FdData]
tbl
case Maybe [FdData]
prev of
Maybe [FdData]
Nothing -> Fd -> IO ()
close Fd
fd IO () -> IO [FdData] -> IO [FdData]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [FdData] -> IO [FdData]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just [FdData]
fds -> do
let oldEls :: EventLifetime
oldEls = [FdData] -> EventLifetime
eventsOf [FdData]
fds
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventLifetime -> Event
I.elEvent EventLifetime
oldEls Event -> Event -> Bool
forall a. Eq a => a -> a -> Bool
/= Event
forall a. Monoid a => a
mempty) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool
_ <- Backend -> Fd -> Event -> Event -> IO Bool
I.modifyFd (EventManager -> Backend
emBackend EventManager
mgr) Fd
fd (EventLifetime -> Event
I.elEvent EventLifetime
oldEls) Event
forall a. Monoid a => a
mempty
EventManager -> IO ()
wakeManager EventManager
mgr
Fd -> IO ()
close Fd
fd
[FdData] -> IO [FdData]
forall (m :: * -> *) a. Monad m => a -> m a
return [FdData]
fds
[FdData] -> (FdData -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FdData]
fds ((FdData -> IO ()) -> IO ()) -> (FdData -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(FdData FdKey
reg EventLifetime
el IOCallback
cb) -> IOCallback
cb FdKey
reg (EventLifetime -> Event
I.elEvent EventLifetime
el Event -> Event -> Event
forall a. Monoid a => a -> a -> a
`mappend` Event
evtClose)
closeFd_ :: EventManager
-> IntTable [FdData]
-> Fd
-> IO (IO ())
closeFd_ :: EventManager -> IntTable [FdData] -> Fd -> IO (IO ())
closeFd_ EventManager
mgr IntTable [FdData]
tbl Fd
fd = do
Maybe [FdData]
prev <- Int -> IntTable [FdData] -> IO (Maybe [FdData])
forall a. Int -> IntTable a -> IO (Maybe a)
IT.delete (Fd -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd) IntTable [FdData]
tbl
case Maybe [FdData]
prev of
Maybe [FdData]
Nothing -> IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Just [FdData]
fds -> do
let oldEls :: EventLifetime
oldEls = [FdData] -> EventLifetime
eventsOf [FdData]
fds
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventLifetime
oldEls EventLifetime -> EventLifetime -> Bool
forall a. Eq a => a -> a -> Bool
/= EventLifetime
forall a. Monoid a => a
mempty) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool
_ <- Backend -> Fd -> Event -> Event -> IO Bool
I.modifyFd (EventManager -> Backend
emBackend EventManager
mgr) Fd
fd (EventLifetime -> Event
I.elEvent EventLifetime
oldEls) Event
forall a. Monoid a => a
mempty
EventManager -> IO ()
wakeManager EventManager
mgr
IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
forall a b. (a -> b) -> a -> b
$
[FdData] -> (FdData -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FdData]
fds ((FdData -> IO ()) -> IO ()) -> (FdData -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(FdData FdKey
reg EventLifetime
el IOCallback
cb) ->
IOCallback
cb FdKey
reg (EventLifetime -> Event
I.elEvent EventLifetime
el Event -> Event -> Event
forall a. Monoid a => a -> a -> a
`mappend` Event
evtClose)
onFdEvent :: EventManager -> Fd -> Event -> IO ()
onFdEvent :: EventManager -> Fd -> Event -> IO ()
onFdEvent EventManager
mgr Fd
fd Event
evs
| Fd
fd Fd -> Fd -> Bool
forall a. Eq a => a -> a -> Bool
== Control -> Fd
controlReadFd (EventManager -> Control
emControl EventManager
mgr) Bool -> Bool -> Bool
|| Fd
fd Fd -> Fd -> Bool
forall a. Eq a => a -> a -> Bool
== Control -> Fd
wakeupReadFd (EventManager -> Control
emControl EventManager
mgr) =
EventManager -> Fd -> Event -> IO ()
handleControlEvent EventManager
mgr Fd
fd Event
evs
| Bool
otherwise = do
[FdData]
fdds <- MVar (IntTable [FdData])
-> (IntTable [FdData] -> IO [FdData]) -> IO [FdData]
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (EventManager -> Fd -> MVar (IntTable [FdData])
callbackTableVar EventManager
mgr Fd
fd) ((IntTable [FdData] -> IO [FdData]) -> IO [FdData])
-> (IntTable [FdData] -> IO [FdData]) -> IO [FdData]
forall a b. (a -> b) -> a -> b
$ \IntTable [FdData]
tbl ->
Int -> IntTable [FdData] -> IO (Maybe [FdData])
forall a. Int -> IntTable a -> IO (Maybe a)
IT.delete (Fd -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd) IntTable [FdData]
tbl IO (Maybe [FdData])
-> (Maybe [FdData] -> IO [FdData]) -> IO [FdData]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO [FdData]
-> ([FdData] -> IO [FdData]) -> Maybe [FdData] -> IO [FdData]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([FdData] -> IO [FdData]
forall (m :: * -> *) a. Monad m => a -> m a
return []) (IntTable [FdData] -> [FdData] -> IO [FdData]
selectCallbacks IntTable [FdData]
tbl)
[FdData] -> (FdData -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FdData]
fdds ((FdData -> IO ()) -> IO ()) -> (FdData -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(FdData FdKey
reg EventLifetime
_ IOCallback
cb) -> IOCallback
cb FdKey
reg Event
evs
where
selectCallbacks :: IntTable [FdData] -> [FdData] -> IO [FdData]
selectCallbacks :: IntTable [FdData] -> [FdData] -> IO [FdData]
selectCallbacks IntTable [FdData]
tbl [FdData]
fdds = do
let
matches :: FdData -> Bool
matches :: FdData -> Bool
matches FdData
fd' = Event
evs Event -> Event -> Bool
`I.eventIs` EventLifetime -> Event
I.elEvent (FdData -> EventLifetime
fdEvents FdData
fd')
([FdData]
triggered, [FdData]
notTriggered) = (FdData -> Bool) -> [FdData] -> ([FdData], [FdData])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition FdData -> Bool
matches [FdData]
fdds
isMultishot :: FdData -> Bool
isMultishot :: FdData -> Bool
isMultishot FdData
fd' = EventLifetime -> Lifetime
I.elLifetime (FdData -> EventLifetime
fdEvents FdData
fd') Lifetime -> Lifetime -> Bool
forall a. Eq a => a -> a -> Bool
== Lifetime
MultiShot
saved :: [FdData]
saved = [FdData]
notTriggered [FdData] -> [FdData] -> [FdData]
forall a. [a] -> [a] -> [a]
++ (FdData -> Bool) -> [FdData] -> [FdData]
forall a. (a -> Bool) -> [a] -> [a]
filter FdData -> Bool
isMultishot [FdData]
triggered
savedEls :: EventLifetime
savedEls = [FdData] -> EventLifetime
eventsOf [FdData]
saved
allEls :: EventLifetime
allEls = [FdData] -> EventLifetime
eventsOf [FdData]
fdds
Maybe [FdData]
_ <- ([FdData] -> [FdData] -> [FdData])
-> Int -> [FdData] -> IntTable [FdData] -> IO (Maybe [FdData])
forall a. (a -> a -> a) -> Int -> a -> IntTable a -> IO (Maybe a)
IT.insertWith (\[FdData]
_ [FdData]
_ -> [FdData]
saved) (Fd -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd) [FdData]
saved IntTable [FdData]
tbl
case EventLifetime -> Lifetime
I.elLifetime EventLifetime
allEls of
Lifetime
MultiShot | EventLifetime
allEls EventLifetime -> EventLifetime -> Bool
forall a. Eq a => a -> a -> Bool
== EventLifetime
savedEls ->
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Lifetime
_ ->
case EventLifetime -> Lifetime
I.elLifetime EventLifetime
savedEls of
Lifetime
OneShot | Bool
haveOneShot ->
Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => Bool -> m () -> m ()
unless (Lifetime
OneShot Lifetime -> Lifetime -> Bool
forall a. Eq a => a -> a -> Bool
== EventLifetime -> Lifetime
I.elLifetime EventLifetime
allEls
Bool -> Bool -> Bool
&& Event
forall a. Monoid a => a
mempty Event -> Event -> Bool
forall a. Eq a => a -> a -> Bool
== EventLifetime -> Event
I.elEvent EventLifetime
savedEls) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Backend -> Fd -> Event -> IO Bool
I.modifyFdOnce (EventManager -> Backend
emBackend EventManager
mgr) Fd
fd (EventLifetime -> Event
I.elEvent EventLifetime
savedEls)
Lifetime
_ ->
IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Backend -> Fd -> Event -> Event -> IO Bool
I.modifyFd (EventManager -> Backend
emBackend EventManager
mgr) Fd
fd
(EventLifetime -> Event
I.elEvent EventLifetime
allEls) (EventLifetime -> Event
I.elEvent EventLifetime
savedEls)
[FdData] -> IO [FdData]
forall (m :: * -> *) a. Monad m => a -> m a
return [FdData]
triggered
nullToNothing :: [a] -> Maybe [a]
nullToNothing :: forall a. [a] -> Maybe [a]
nullToNothing [] = Maybe [a]
forall a. Maybe a
Nothing
nullToNothing xs :: [a]
xs@(a
_:[a]
_) = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
xs
unless :: Monad m => Bool -> m () -> m ()
unless :: forall (m :: * -> *). Monad m => Bool -> m () -> m ()
unless Bool
p = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
p)