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

    -- |
    -- 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 ( FdKey -> FdKey -> Bool
    (FdKey -> FdKey -> Bool) -> (FdKey -> FdKey -> Bool) -> Eq FdKey
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FdKey -> FdKey -> Bool
    == :: FdKey -> FdKey -> Bool
    $c/= :: FdKey -> FdKey -> Bool
    /= :: FdKey -> FdKey -> Bool
    Eq   -- ^ @since 4.4.0.0
                   , 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
    $cshowsPrec :: Int -> FdKey -> ShowS
    showsPrec :: Int -> FdKey -> ShowS
    $cshow :: FdKey -> String
    show :: FdKey -> String
    $cshowList :: [FdKey] -> ShowS
    showList :: [FdKey] -> ShowS
    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 ( State -> State -> Bool
    (State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: State -> State -> Bool
    == :: State -> State -> Bool
    $c/= :: State -> State -> Bool
    /= :: State -> State -> Bool
    Eq   -- ^ @since 4.4.0.0
                          , 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
    $cshowsPrec :: Int -> State -> ShowS
    showsPrec :: Int -> State -> ShowS
    $cshow :: State -> String
    show :: State -> String
    $cshowList :: [State] -> ShowS
    showList :: [State] -> ShowS
    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
    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 :: Bool
    haveOneShot = Bool
    False
    #elif defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)
    haveOneShot = 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 a. a -> IO a
    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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    newDefaultBackend :: IO Backend
    #if defined(HAVE_KQUEUE)
    newDefaultBackend :: IO Backend
    newDefaultBackend = IO Backend
    KQueue.new
    #elif defined(HAVE_EPOLL)
    newDefaultBackend = 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
    =<< 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 a b. (a -> b) -> IO a -> IO b
    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 a. a -> IO a
    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

    -- | 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 ()
    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)

    -- | Asynchronously tell the thread executing the event
    -- manager loop to exit.
    release :: EventManager -> IO ()
    release :: EventManager -> IO ()
    release EventManager{Array Int (MVar (IntTable [FdData]))
    MVar ()
    UniqueSource
    IORef State
    Control
    Backend
    emControl :: EventManager -> Control
    emBackend :: EventManager -> Backend
    emFds :: EventManager -> Array Int (MVar (IntTable [FdData]))
    emState :: EventManager -> IORef State
    emUniqueSource :: EventManager -> UniqueSource
    emLock :: EventManager -> MVar ()
    emBackend :: Backend
    emFds :: Array Int (MVar (IntTable [FdData]))
    emState :: IORef State
    emUniqueSource :: UniqueSource
    emControl :: Control
    emLock :: MVar ()
    ..} = 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{Array Int (MVar (IntTable [FdData]))
    MVar ()
    UniqueSource
    IORef State
    Control
    Backend
    emControl :: EventManager -> Control
    emBackend :: EventManager -> Backend
    emFds :: EventManager -> Array Int (MVar (IntTable [FdData]))
    emState :: EventManager -> IORef State
    emUniqueSource :: EventManager -> UniqueSource
    emLock :: EventManager -> MVar ()
    emBackend :: Backend
    emFds :: Array Int (MVar (IntTable [FdData]))
    emState :: IORef State
    emUniqueSource :: UniqueSource
    emControl :: Control
    emLock :: MVar ()
    ..} = 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

    ------------------------------------------------------------------------
    -- 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{Array Int (MVar (IntTable [FdData]))
    MVar ()
    UniqueSource
    IORef State
    Control
    Backend
    emControl :: EventManager -> Control
    emBackend :: EventManager -> Backend
    emFds :: EventManager -> Array Int (MVar (IntTable [FdData]))
    emState :: EventManager -> IORef State
    emUniqueSource :: EventManager -> UniqueSource
    emLock :: EventManager -> MVar ()
    emBackend :: Backend
    emFds :: Array Int (MVar (IntTable [FdData]))
    emState :: IORef State
    emUniqueSource :: UniqueSource
    emControl :: Control
    emLock :: MVar ()
    ..} = 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
        -- 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 a. a -> IO a
    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 a b. IO a -> IO b -> IO b
    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

    -- | 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{Array Int (MVar (IntTable [FdData]))
    MVar ()
    UniqueSource
    IORef State
    Control
    Backend
    emControl :: EventManager -> Control
    emBackend :: EventManager -> Backend
    emFds :: EventManager -> Array Int (MVar (IntTable [FdData]))
    emState :: EventManager -> IORef State
    emUniqueSource :: EventManager -> UniqueSource
    emLock :: EventManager -> MVar ()
    emBackend :: Backend
    emFds :: Array Int (MVar (IntTable [FdData]))
    emState :: IORef State
    emUniqueSource :: UniqueSource
    emControl :: Control
    emLock :: MVar ()
    ..} = 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
    forall a b. a -> b -> b
    `seq` State -> IO State
    forall a. a -> IO a
    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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    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{Array Int (MVar (IntTable [FdData]))
    MVar ()
    UniqueSource
    IORef State
    Control
    Backend
    emControl :: EventManager -> Control
    emBackend :: EventManager -> Backend
    emFds :: EventManager -> Array Int (MVar (IntTable [FdData]))
    emState :: EventManager -> IORef State
    emUniqueSource :: EventManager -> UniqueSource
    emLock :: EventManager -> MVar ()
    emBackend :: Backend
    emFds :: Array Int (MVar (IntTable [FdData]))
    emState :: IORef State
    emUniqueSource :: UniqueSource
    emControl :: Control
    emLock :: MVar ()
    ..}) 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
          -- 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 a. a -> IO a
    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 a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Bool, Bool) -> IO (Bool, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    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
    /= 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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
            if Bool
    ok
              then (Bool, Bool) -> IO (Bool, Bool)
    forall a. a -> IO a
    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 a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Bool, Bool) -> IO (Bool, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    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 ()
    when (Bool -> Bool
    not Bool
    ok) (IOCallback
    cb FdKey
    reg Event
    evs)
      (FdKey, Bool) -> IO (FdKey, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    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 ()
    when Bool
    wake (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ EventManager -> IO ()
    wakeManager EventManager
    mgr
      FdKey -> IO FdKey
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FdKey
    r
    {-# INLINE registerFd #-}

    {-
        Building GHC with parallel IO manager on Mac freezes when
        compiling the dph libraries in the phase 2. As workaround, we
        don't use oneshot and we wake up an IO manager on Mac every time
        when we register an event.

        For more information, please read:
            https://gitlab.haskell.org/ghc/ghc/issues/7651
    -}
    -- | Wake up the event manager.
    wakeManager :: EventManager -> IO ()
    #if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
    wakeManager :: EventManager -> IO ()
    wakeManager EventManager
    mgr = Control -> IO ()
    sendWakeup (EventManager -> Control
    emControl EventManager
    mgr)
    #elif defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)
    wakeManager _ = 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

    -- | 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{Array Int (MVar (IntTable [FdData]))
    MVar ()
    UniqueSource
    IORef State
    Control
    Backend
    emControl :: EventManager -> Control
    emBackend :: EventManager -> Backend
    emFds :: EventManager -> Array Int (MVar (IntTable [FdData]))
    emState :: EventManager -> IORef State
    emUniqueSource :: EventManager -> UniqueSource
    emLock :: EventManager -> MVar ()
    emBackend :: Backend
    emFds :: Array Int (MVar (IntTable [FdData]))
    emState :: IORef State
    emUniqueSource :: UniqueSource
    emControl :: Control
    emLock :: MVar ()
    ..}) (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 a b. (a -> b) -> IO a -> IO b
    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 a. a -> IO a
    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 a b. IO a -> (a -> IO b) -> IO b
    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 a. a -> IO a
    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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    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 ()
    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.  It might block, although for
    -- a very short time; and thus it is interruptible by asynchronous exceptions.
    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 a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [FdData] -> IO [FdData]
    forall a. a -> IO a
    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 a. a -> IO a
    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)

    -- | 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
    fromIntegral Fd
    fd) IntTable [FdData]
    tbl
      case Maybe [FdData]
    prev of
        Maybe [FdData]
    Nothing  -> IO () -> IO (IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (() -> IO ()
    forall a. a -> IO a
    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 a. a -> IO a
    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)

    ------------------------------------------------------------------------
    -- 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
    == 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 a b. IO a -> (a -> IO b) -> IO b
    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 a. a -> IO a
    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
        -- | 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
    == 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
    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
    == EventLifetime
    savedEls ->
                () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    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 ()
    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
    _ ->
                    -- we need to re-arm with multi-shot semantics
                    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 a. a -> IO a
    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)