{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE BangPatterns
           , CPP
           , ExistentialQuantification
           , NoImplicitPrelude
           , RecordWildCards
           , TypeSynonymInstances
           , FlexibleInstances
  #-}

-- |
-- The event manager supports event notification on fds. Each fd may
-- have multiple callbacks registered, each listening for a different
-- set of events. Registrations may be automatically deactivated after
-- the occurrence of an event ("one-shot mode") or active until
-- explicitly unregistered.
--
-- If an fd has only one-shot registrations then we use one-shot
-- polling if available. Otherwise we use multi-shot polling.

module GHC.Event.Manager
    ( -- * Types
      EventManager

      -- * Creation
    , new
    , newWith
    , newDefaultBackend

      -- * Running
    , finished
    , loop
    , step
    , shutdown
    , release
    , cleanup
    , wakeManager

      -- * State
    , callbackTableVar
    , emControl

      -- * Registering interest in I/O events
    , Lifetime (..)
    , Event
    , evtRead
    , evtWrite
    , IOCallback
    , FdKey(keyFd)
    , FdData
    , registerFd
    , unregisterFd_
    , unregisterFd
    , closeFd
    , closeFd_
    ) where

#include "EventConfig.h"

------------------------------------------------------------------------
-- Imports

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

------------------------------------------------------------------------
-- Types

data FdData = FdData {
      FdData -> FdKey
fdKey       :: {-# UNPACK #-} !FdKey
    , FdData -> EventLifetime
fdEvents    :: {-# UNPACK #-} !EventLifetime
    , FdData -> IOCallback
_fdCallback :: !IOCallback
    }

-- | A file descriptor registration cookie.
data FdKey = FdKey {
      FdKey -> Fd
keyFd     :: {-# UNPACK #-} !Fd
    , FdKey -> Unique
keyUnique :: {-# UNPACK #-} !Unique
    } deriving ( Eq   -- ^ @since 4.4.0.0
               , Show -- ^ @since 4.4.0.0
               )

-- | Callback invoked on I/O events.
type IOCallback = FdKey -> Event -> IO ()

data State = Created
           | Running
           | Dying
           | Releasing
           | Finished
             deriving ( Eq   -- ^ @since 4.4.0.0
                      , Show -- ^ @since 4.4.0.0
                      )

-- | The event manager state.
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 ())
    }

-- must be power of 2
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
External instance of the constraint type Num Int
External instance of the constraint type Integral Fd
fromIntegral Fd
fd Int -> Int -> Int
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Int
.&. (Int
callbackArraySize Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- 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
External instance of the constraint type Ix Int
! Fd -> Int
hashFd Fd
fd
{-# INLINE callbackTableVar #-}

haveOneShot :: Bool
{-# INLINE haveOneShot #-}
#if defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)
haveOneShot :: Bool
haveOneShot = Bool
True
#else
haveOneShot = False
#endif
------------------------------------------------------------------------
-- Creation

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
External instance of the constraint type Monad IO
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
External instance of the constraint type Monad IO
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

-- | Create a new event manager.
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
External instance of the constraint type Monad IO
=<< IO Backend
newDefaultBackend

-- | Create a new 'EventManager' with the given polling backend.
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
External instance of the constraint type Functor IO
fmap ((Int, Int)
-> [MVar (IntTable [FdData])]
-> Array Int (MVar (IntTable [FdData]))
forall i e. Ix i => (i, i) -> [e] -> Array i e
External instance of the constraint type Ix Int
listArray (Int
0, Int
callbackArraySizeInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-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]
External instance of the constraint type Monad IO
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
External instance of the constraint type Monad IO
=<< 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 ()
External instance of the constraint type Applicative IO
when (State
st State -> State -> Bool
forall a. Eq a => a -> a -> Bool
Instance of class: Eq of the constraint type Eq State
/= 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 :: Backend
-> Array Int (MVar (IntTable [FdData]))
-> IORef State
-> UniqueSource
-> Control
-> MVar ()
-> EventManager
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
External instance of the constraint type Monad IO
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]
Evidence bound by a type signature of the constraint type Monad m
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 ()
External instance of the constraint type Applicative IO
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
External instance of the constraint type Show Fd
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
External instance of the constraint type Monoid Event
mempty Event
evs

-- | Asynchronously shuts down the event manager, if running.
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 ()
External instance of the constraint type Applicative IO
when (State
state State -> State -> Bool
forall a. Eq a => a -> a -> Bool
Instance of class: Eq of the constraint type Eq State
== State
Running) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Control -> IO ()
sendDie (EventManager -> Control
emControl EventManager
mgr)

-- | Asynchronously tell the thread executing the event
-- manager loop to exit.
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 ()
External instance of the constraint type Applicative IO
when (State
state State -> State -> Bool
forall a. Eq a => a -> a -> Bool
Instance of class: Eq of the constraint type Eq State
== 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
Instance of class: Eq of the constraint type Eq State
== State
Finished) (State -> Bool) -> IO State -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
External instance of the constraint type Monad IO
`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 ()
External instance of the constraint type Functor IO
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

------------------------------------------------------------------------
-- Event loop

-- | Start handling events.  This function loops until told to stop,
-- using 'shutdown'.
--
-- /Note/: This loop can only be run once per 'EventManager', as it
-- closes all of its control resources when it finishes.
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 ()
External instance of the constraint type Functor IO
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
    -- While a poll loop is never forked when the event manager is in the
    -- 'Finished' state, its state could read 'Finished' once the new thread
    -- actually runs.  This is not an error, just an unfortunate race condition
    -- in Thread.restartPollLoop.  See #8235
    State
Finished  -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
Instance of class: Show of the constraint type Show State
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
External instance of the constraint type Monad IO
>> IO ()
go
            State
Releasing -> MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
emLock ()
            State
_         -> EventManager -> IO ()
cleanup EventManager
mgr

-- | To make a step, we first do a non-blocking poll, in case
-- there are already events ready to handle. This improves performance
-- because we can make an unsafe foreign C call, thereby avoiding
-- forcing the current Task to release the Capability and forcing a context switch.
-- If the poll fails to find events, we yield, putting the poll loop thread at
-- end of the Haskell run queue. When it comes back around, we do one more
-- non-blocking poll, in case we get lucky and have ready events.
-- If that also returns no events, then we do a blocking poll.
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
External instance of the constraint type Monad IO
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 ()
External instance of the constraint type Applicative IO
when (Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= 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 ()
External instance of the constraint type Applicative IO
when (Int
n2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= 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
External instance of the constraint type Monad IO
return ()

------------------------------------------------------------------------
-- Registering interest in I/O events

-- | Register interest in the given events, without waking the event
-- manager thread.  The 'Bool' return value indicates whether the
-- event manager ought to be woken.
--
-- Note that the event manager is generally implemented in terms of the
-- platform's @select@ or @epoll@ system call, which tend to vary in
-- what sort of fds are permitted. For instance, waiting on regular files
-- is not allowed on many platforms.
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
External instance of the constraint type Num Int
External instance of the constraint type Integral Fd
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
External instance of the constraint type Monoid EventLifetime
mempty [FdData] -> EventLifetime
eventsOf Maybe [FdData]
oldFdd

        el' :: EventLifetime
        el' :: EventLifetime
el' = EventLifetime
prevEvs EventLifetime -> EventLifetime -> EventLifetime
forall a. Monoid a => a -> a -> a
External instance of the constraint type Monoid EventLifetime
`mappend` EventLifetime
el
    case EventLifetime -> Lifetime
I.elLifetime EventLifetime
el' of
      -- All registrations want one-shot semantics and this is supported
      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
External instance of the constraint type Monad IO
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
External instance of the constraint type Monad IO
>> (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Bool
False, Bool
False)

      -- We don't want or don't support one-shot semantics
      Lifetime
_ -> do
        let modify :: Bool
modify = EventLifetime
prevEvs EventLifetime -> EventLifetime -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq EventLifetime
/= 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
External instance of the constraint type Monad IO
return Bool
True
        if Bool
ok
          then (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type Monad IO
>> (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Bool
False, Bool
False)
  -- this simulates behavior of old IO manager:
  -- i.e. just call the callback if the registration fails.
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type Applicative IO
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
External instance of the constraint type Monad IO
return (FdKey
reg,Bool
modify)
{-# INLINE registerFd_ #-}

-- | @registerFd mgr cb fd evs lt@ registers interest in the events @evs@
-- on the file descriptor @fd@ for lifetime @lt@. @cb@ is called for
-- each event that occurs.  Returns a cookie that can be handed to
-- 'unregisterFd'.
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 ()
External instance of the constraint type Applicative IO
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
External instance of the constraint type Monad IO
return FdKey
r
{-# INLINE registerFd #-}

-- | Wake up the event manager.
wakeManager :: EventManager -> IO ()
#if defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)
wakeManager :: EventManager -> IO ()
wakeManager EventManager
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type Monoid EventLifetime
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

-- | Drop a previous file descriptor registration, without waking the
-- event manager thread.  The return value indicates whether the event
-- manager ought to be woken.
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
External instance of the constraint type Eq Unique
/= 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
External instance of the constraint type Num Int
External instance of the constraint type Integral Fd
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
External instance of the constraint type Monoid EventLifetime
mempty [FdData] -> EventLifetime
eventsOf (Maybe [FdData] -> EventLifetime)
-> IO (Maybe [FdData]) -> IO EventLifetime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
`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
External instance of the constraint type Monad IO
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
External instance of the constraint type Monad IO
>>=
                        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
External instance of the constraint type Monad IO
return (EventLifetime
forall a. Monoid a => a
External instance of the constraint type Monoid EventLifetime
mempty, EventLifetime
forall a. Monoid a => a
External instance of the constraint type Monoid EventLifetime
mempty)) [FdData] -> IO (EventLifetime, EventLifetime)
pairEvents
    let modify :: Bool
modify = EventLifetime
oldEls EventLifetime -> EventLifetime -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq EventLifetime
/= EventLifetime
newEls
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type Applicative IO
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
External instance of the constraint type Eq Event
/= Event
forall a. Monoid a => a
External instance of the constraint type Monoid Event
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
External instance of the constraint type Monad IO
return Bool
modify

-- | Drop a previous file descriptor registration.
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 ()
External instance of the constraint type Applicative IO
when Bool
wake (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ EventManager -> IO ()
wakeManager EventManager
mgr

-- | Close a file descriptor in a race-safe way.
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
External instance of the constraint type Num Int
External instance of the constraint type Integral Fd
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
External instance of the constraint type Monad IO
>> [FdData] -> IO [FdData]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return []
      Just [FdData]
fds -> do
        let oldEls :: EventLifetime
oldEls = [FdData] -> EventLifetime
eventsOf [FdData]
fds
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type Applicative IO
when (EventLifetime -> Event
I.elEvent EventLifetime
oldEls Event -> Event -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Event
/= Event
forall a. Monoid a => a
External instance of the constraint type Monoid Event
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
External instance of the constraint type Monoid Event
mempty
          EventManager -> IO ()
wakeManager EventManager
mgr
        Fd -> IO ()
close Fd
fd
        [FdData] -> IO [FdData]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return [FdData]
fds
  [FdData] -> (FdData -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
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
External instance of the constraint type Monoid Event
`mappend` Event
evtClose)

-- | Close a file descriptor in a race-safe way.
-- It assumes the caller will update the callback tables and that the caller
-- holds the callback table lock for the fd. It must hold this lock because
-- this command executes a backend command on the fd.
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
External instance of the constraint type Num Int
External instance of the constraint type Integral Fd
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
External instance of the constraint type Monad IO
return (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ())
    Just [FdData]
fds -> do
      let oldEls :: EventLifetime
oldEls = [FdData] -> EventLifetime
eventsOf [FdData]
fds
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type Applicative IO
when (EventLifetime
oldEls EventLifetime -> EventLifetime -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq EventLifetime
/= EventLifetime
forall a. Monoid a => a
External instance of the constraint type Monoid EventLifetime
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
External instance of the constraint type Monoid Event
mempty
        EventManager -> IO ()
wakeManager EventManager
mgr
      IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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 ()
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
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
External instance of the constraint type Monoid Event
`mappend` Event
evtClose)

------------------------------------------------------------------------
-- Utilities

-- | Call the callbacks corresponding to the given file descriptor.
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
External instance of the constraint type Eq Fd
== Control -> Fd
controlReadFd (EventManager -> Control
emControl EventManager
mgr) Bool -> Bool -> Bool
|| Fd
fd Fd -> Fd -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Fd
== 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
External instance of the constraint type Num Int
External instance of the constraint type Integral Fd
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
External instance of the constraint type Monad IO
>>= 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
External instance of the constraint type Monad IO
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 ()
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
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
    -- | Here we look through the list of registrations for the fd of interest
    -- and sort out which match the events that were triggered. We,
    --
    --   1. re-arm the fd as appropriate
    --   2. reinsert registrations that weren't triggered and multishot
    --      registrations
    --   3. return a list containing the callbacks that should be invoked.
    selectCallbacks :: IntTable [FdData] -> [FdData] -> IO [FdData]
    selectCallbacks :: IntTable [FdData] -> [FdData] -> IO [FdData]
selectCallbacks IntTable [FdData]
tbl [FdData]
fdds = do
        let -- figure out which registrations have been triggered
            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

            -- sort out which registrations we need to retain
            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
External instance of the constraint type Eq Lifetime
== 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

        -- Reinsert multishot registrations.
        -- We deleted the table entry for this fd above so we there isn't a preexisting entry
        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
External instance of the constraint type Num Int
External instance of the constraint type Integral Fd
fromIntegral Fd
fd) [FdData]
saved IntTable [FdData]
tbl

        case EventLifetime -> Lifetime
I.elLifetime EventLifetime
allEls of
          -- we previously armed the fd for multiple shots, no need to rearm
          Lifetime
MultiShot | EventLifetime
allEls EventLifetime -> EventLifetime -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq EventLifetime
== EventLifetime
savedEls ->
            () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ()

          -- either we previously registered for one shot or the
          -- events of interest have changed, we must re-arm
          Lifetime
_ ->
            case EventLifetime -> Lifetime
I.elLifetime EventLifetime
savedEls of
              Lifetime
OneShot | Bool
haveOneShot ->
                -- if there are no saved events and we registered with one-shot
                -- semantics then there is no need to re-arm
                Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => Bool -> m () -> m ()
External instance of the constraint type Monad IO
unless (Lifetime
OneShot Lifetime -> Lifetime -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Lifetime
== EventLifetime -> Lifetime
I.elLifetime EventLifetime
allEls
                        Bool -> Bool -> Bool
&& Event
forall a. Monoid a => a
External instance of the constraint type Monoid Event
mempty Event -> Event -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Event
== EventLifetime -> Event
I.elEvent EventLifetime
savedEls) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                  IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
External instance of the constraint type Functor IO
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
_ ->
                -- we need to re-arm with multi-shot semantics
                IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
External instance of the constraint type Functor IO
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
External instance of the constraint type Monad IO
return [FdData]
triggered

nullToNothing :: [a] -> Maybe [a]
nullToNothing :: [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 :: Bool -> m () -> m ()
unless Bool
p = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type forall (m :: * -> *). Monad m => Applicative m
Evidence bound by a type signature of the constraint type Monad m
when (Bool -> Bool
not Bool
p)