    {-# 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
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: FdKey -> FdKey -> Bool
    $c/= :: FdKey -> FdKey -> Bool
    == :: FdKey -> FdKey -> Bool
    $c== :: FdKey -> FdKey -> Bool
    Eq   -- ^ @since 4.4.0.0
                   , Int -> FdKey -> ShowS
    [FdKey] -> ShowS
    FdKey -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [FdKey] -> ShowS
    $cshowList :: [FdKey] -> ShowS
    show :: FdKey -> String
    $cshow :: FdKey -> String
    showsPrec :: Int -> FdKey -> ShowS
    $cshowsPrec :: Int -> FdKey -> ShowS
    Show -- ^ @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
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: State -> State -> Bool
    $c/= :: State -> State -> Bool
    == :: State -> State -> Bool
    $c== :: State -> State -> Bool
    Eq   -- ^ @since 4.4.0.0
                          , Int -> State -> ShowS
    [State] -> ShowS
    State -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [State] -> ShowS
    $cshowList :: [State] -> ShowS
    show :: State -> String
    $cshow :: State -> String
    showsPrec :: Int -> State -> ShowS
    $cshowsPrec :: Int -> State -> ShowS
    Show -- ^ @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 = forall a b. (Integral a, Num b) => a -> b
    fromIntegral Fd
    fd forall a. Bits a => a -> a -> a
    .&. (Int
    callbackArraySize 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 forall i e. Ix i => Array i e -> i -> e
    ! Fd -> Int
    hashFd Fd
    fd
    {-# INLINE callbackTableVar #-}

    haveOneShot :: Bool
    {-# INLINE haveOneShot #-}
    #if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
    haveOneShot = False
    #elif defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)
    haveOneShot :: Bool
    haveOneShot = Bool
    True
    #else
    haveOneShot = False
    #endif
    ------------------------------------------------------------------------
    -- 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      -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        ControlMessage
    CMsgDie         -> forall a. IORef a -> a -> IO ()
    writeIORef (EventManager -> IORef State
    emState EventManager
    mgr) State
    Finished
        ControlMessage
    _               -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    newDefaultBackend :: IO Backend
    #if defined(HAVE_KQUEUE)
    newDefaultBackend = KQueue.new
    #elif defined(HAVE_EPOLL)
    newDefaultBackend :: IO Backend
    newDefaultBackend = IO Backend
    EPoll.new
    #elif defined(HAVE_POLL)
    newDefaultBackend = Poll.new
    #else
    newDefaultBackend = errorWithoutStackTrace "no back end for this platform"
    #endif

    -- | Create a new event manager.
    new :: IO EventManager
    new :: IO EventManager
    new = Backend -> IO EventManager
    newWith 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 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (forall i e. Ix i => (i, i) -> [e] -> Array i e
    listArray (Int
    0, Int
    callbackArraySizeforall a. Num a => a -> a -> a
    -Int
    1)) forall a b. (a -> b) -> a -> b
    $
               forall {m :: * -> *} {a}. Monad m => Int -> m a -> m [a]
    replicateM Int
    callbackArraySize (forall a. a -> IO (MVar a)
    newMVar forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< forall a. Int -> IO (IntTable a)
    IT.new Int
    8)
      Control
    ctrl <- Bool -> IO Control
    newControl Bool
    False
      IORef State
    state <- forall a. a -> IO (IORef a)
    newIORef State
    Created
      UniqueSource
    us <- IO UniqueSource
    newSource
      Weak (IORef State)
    _ <- forall a. IORef a -> IO () -> IO (Weak (IORef a))
    mkWeakIORef IORef State
    state forall a b. (a -> b) -> a -> b
    $ do
                   State
    st <- forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef State
    state forall a b. (a -> b) -> a -> b
    $ \State
    s -> (State
    Finished, State
    s)
                   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (State
    st forall a. Eq a => a -> a -> Bool
    /= State
    Finished) forall a b. (a -> b) -> a -> b
    $ do
                     Backend -> IO ()
    I.delete Backend
    be
                     Control -> IO ()
    closeControl Control
    ctrl
      MVar ()
    lockVar <- 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
      forall (m :: * -> *) a. Monad m => a -> m a
    return EventManager
    mgr
      where
        replicateM :: Int -> m a -> m [a]
    replicateM Int
    n m a
    x = forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence (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
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    ok) forall a b. (a -> b) -> a -> b
    $
        let msg :: String
    msg = String
    "Failed while attempting to modify registration of file " forall a. [a] -> [a] -> [a]
    ++
                  forall a. Show a => a -> String
    show Fd
    fd forall a. [a] -> [a] -> [a]
    ++ String
    " at location " forall a. [a] -> [a] -> [a]
    ++ String
    loc
        in 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 forall a b. (a -> b) -> a -> b
    $
      Backend -> Fd -> Event -> Event -> IO Bool
    I.modifyFd (EventManager -> Backend
    emBackend EventManager
    mgr) Fd
    fd 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 <- forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' (EventManager -> IORef State
    emState EventManager
    mgr) forall a b. (a -> b) -> a -> b
    $ \State
    s -> (State
    Dying, State
    s)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (State
    state forall a. Eq a => a -> a -> Bool
    == State
    Running) 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 <- forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef State
    emState forall a b. (a -> b) -> a -> b
    $ \State
    s -> (State
    Releasing, State
    s)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (State
    state forall a. Eq a => a -> a -> Bool
    == State
    Running) forall a b. (a -> b) -> a -> b
    $ Control -> IO ()
    sendWakeup Control
    emControl

    finished :: EventManager -> IO Bool
    finished :: EventManager -> IO Bool
    finished EventManager
    mgr = (forall a. Eq a => a -> a -> Bool
    == State
    Finished) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` 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
      forall a. IORef a -> a -> IO ()
    writeIORef IORef State
    emState State
    Finished
      forall (f :: * -> *) a. Functor f => f a -> f ()
    void forall a b. (a -> b) -> a -> b
    $ 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
      forall (f :: * -> *) a. Functor f => f a -> f ()
    void forall a b. (a -> b) -> a -> b
    $ forall a. MVar a -> IO a
    takeMVar MVar ()
    emLock
      State
    state <- forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef State
    emState 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 forall a b. IO a -> IO b -> IO a
    `onException` EventManager -> IO ()
    cleanup EventManager
    mgr
        State
    Releasing -> IO ()
    go 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  -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        State
    _         -> do EventManager -> IO ()
    cleanup EventManager
    mgr
                        forall a. String -> a
    errorWithoutStackTrace forall a b. (a -> b) -> a -> b
    $ String
    "GHC.Event.Manager.loop: state is already " forall a. [a] -> [a] -> [a]
    ++
                                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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    go
                State
    Releasing -> 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 <- forall a. IORef a -> IO a
    readIORef IORef State
    emState
      State
    state seq :: forall a b. a -> b -> b
    `seq` 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 forall a. Maybe a
    Nothing (EventManager -> Fd -> Event -> IO ()
    onFdEvent EventManager
    mgr)
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    n1 forall a. Ord a => a -> a -> Bool
    <= Int
    0) forall a b. (a -> b) -> a -> b
    $ do
            IO ()
    yield
            Int
    n2 <- Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
    I.poll Backend
    emBackend forall a. Maybe a
    Nothing (EventManager -> Fd -> Event -> IO ()
    onFdEvent EventManager
    mgr)
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    n2 forall a. Ord a => a -> a -> Bool
    <= Int
    0) forall a b. (a -> b) -> a -> b
    $ do
              Int
    _ <- Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
    I.poll Backend
    emBackend (forall a. a -> Maybe a
    Just Timeout
    Forever) (EventManager -> Fd -> Event -> IO ()
    onFdEvent EventManager
    mgr)
              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{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'  = 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) <- forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar (EventManager -> Fd -> MVar (IntTable [FdData])
    callbackTableVar EventManager
    mgr Fd
    fd) forall a b. (a -> b) -> a -> b
    $ \IntTable [FdData]
    tbl -> do
        Maybe [FdData]
    oldFdd <- forall a. (a -> a -> a) -> Int -> a -> IntTable a -> IO (Maybe a)
    IT.insertWith forall a. [a] -> [a] -> [a]
    (++) Int
    fd' [FdData
    fdd] IntTable [FdData]
    tbl
        let prevEvs :: EventLifetime
            prevEvs :: EventLifetime
    prevEvs = forall b a. b -> (a -> b) -> Maybe a -> b
    maybe forall a. Monoid a => a
    mempty [FdData] -> EventLifetime
    eventsOf Maybe [FdData]
    oldFdd

            el' :: EventLifetime
            el' :: EventLifetime
    el' = EventLifetime
    prevEvs 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 forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, Bool
    True)
              else forall a. Int -> Maybe a -> IntTable a -> IO ()
    IT.reset Int
    fd' Maybe [FdData]
    oldFdd IntTable [FdData]
    tbl forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> 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 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 forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
            if Bool
    ok
              then forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    modify, Bool
    True)
              else forall a. Int -> Maybe a -> IntTable a -> IO ()
    IT.reset Int
    fd' Maybe [FdData]
    oldFdd IntTable [FdData]
    tbl forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> 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.
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    ok) (IOCallback
    cb FdKey
    reg Event
    evs)
      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
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    wake forall a b. (a -> b) -> a -> b
    $ EventManager -> IO ()
    wakeManager EventManager
    mgr
      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 mgr = sendWakeup (emControl mgr)
    #elif defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)
    wakeManager :: EventManager -> IO ()
    wakeManager EventManager
    _ = forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #else
    wakeManager mgr = sendWakeup (emControl mgr)
    #endif

    eventsOf :: [FdData] -> EventLifetime
    eventsOf :: [FdData] -> EventLifetime
    eventsOf [FdData
    fdd] = FdData -> EventLifetime
    fdEvents FdData
    fdd
    eventsOf [FdData]
    fdds  = forall a. Monoid a => [a] -> a
    mconcat forall a b. (a -> b) -> a -> b
    $ 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) =
      forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar (EventManager -> Fd -> MVar (IntTable [FdData])
    callbackTableVar EventManager
    mgr Fd
    fd) forall a b. (a -> b) -> a -> b
    $ \IntTable [FdData]
    tbl -> do
        let dropReg :: [FdData] -> Maybe [FdData]
    dropReg = forall a. [a] -> Maybe [a]
    nullToNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. (a -> Bool) -> [a] -> [a]
    filter ((forall a. Eq a => a -> a -> Bool
    /= Unique
    u) forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FdKey -> Unique
    keyUnique forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FdData -> FdKey
    fdKey)
            fd' :: Int
    fd' = 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 <- forall b a. b -> (a -> b) -> Maybe a -> b
    maybe forall a. Monoid a => a
    mempty [FdData] -> EventLifetime
    eventsOf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` forall a. Int -> IntTable a -> IO (Maybe a)
    IT.lookup Int
    fd' IntTable [FdData]
    tbl
              forall (m :: * -> *) a. Monad m => a -> m a
    return ([FdData] -> EventLifetime
    eventsOf [FdData]
    prev, EventLifetime
    r)
        (EventLifetime
    oldEls, EventLifetime
    newEls) <- forall a. (a -> Maybe a) -> Int -> IntTable a -> IO (Maybe a)
    IT.updateWith [FdData] -> Maybe [FdData]
    dropReg Int
    fd' IntTable [FdData]
    tbl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                            forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. Monoid a => a
    mempty, forall a. Monoid a => a
    mempty)) [FdData] -> IO (EventLifetime, EventLifetime)
    pairEvents
        let modify :: Bool
    modify = EventLifetime
    oldEls forall a. Eq a => a -> a -> Bool
    /= EventLifetime
    newEls
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    modify forall a b. (a -> b) -> a -> b
    $ String -> Fd -> IO Bool -> IO ()
    failOnInvalidFile String
    "unregisterFd_" Fd
    fd forall a b. (a -> b) -> a -> b
    $
          case EventLifetime -> Lifetime
    I.elLifetime EventLifetime
    newEls of
            Lifetime
    OneShot | EventLifetime -> Event
    I.elEvent EventLifetime
    newEls forall a. Eq a => a -> a -> Bool
    /= 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)
        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
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    wake 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 <- forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar (EventManager -> Fd -> MVar (IntTable [FdData])
    callbackTableVar EventManager
    mgr Fd
    fd) forall a b. (a -> b) -> a -> b
    $ \IntTable [FdData]
    tbl -> do
        Maybe [FdData]
    prev <- forall a. Int -> IntTable a -> IO (Maybe a)
    IT.delete (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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> forall (m :: * -> *) a. Monad m => a -> m a
    return []
          Just [FdData]
    fds -> do
            let oldEls :: EventLifetime
    oldEls = [FdData] -> EventLifetime
    eventsOf [FdData]
    fds
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (EventLifetime -> Event
    I.elEvent EventLifetime
    oldEls forall a. Eq a => a -> a -> Bool
    /= forall a. Monoid a => a
    mempty) 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) forall a. Monoid a => a
    mempty
              EventManager -> IO ()
    wakeManager EventManager
    mgr
            Fd -> IO ()
    close Fd
    fd
            forall (m :: * -> *) a. Monad m => a -> m a
    return [FdData]
    fds
      forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [FdData]
    fds forall a b. (a -> b) -> a -> b
    $ \(FdData FdKey
    reg EventLifetime
    el IOCallback
    cb) -> IOCallback
    cb FdKey
    reg (EventLifetime -> Event
    I.elEvent EventLifetime
    el 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 <- forall a. Int -> IntTable a -> IO (Maybe a)
    IT.delete (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Fd
    fd) IntTable [FdData]
    tbl
      case Maybe [FdData]
    prev of
        Maybe [FdData]
    Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
    return (forall (m :: * -> *) a. Monad m => a -> m a
    return ())
        Just [FdData]
    fds -> do
          let oldEls :: EventLifetime
    oldEls = [FdData] -> EventLifetime
    eventsOf [FdData]
    fds
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (EventLifetime
    oldEls forall a. Eq a => a -> a -> Bool
    /= forall a. Monoid a => a
    mempty) 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) forall a. Monoid a => a
    mempty
            EventManager -> IO ()
    wakeManager EventManager
    mgr
          forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $
            forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [FdData]
    fds forall a b. (a -> b) -> a -> b
    $ \(FdData FdKey
    reg EventLifetime
    el IOCallback
    cb) ->
              IOCallback
    cb FdKey
    reg (EventLifetime -> Event
    I.elEvent EventLifetime
    el 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 forall a. Eq a => a -> a -> Bool
    == Control -> Fd
    controlReadFd (EventManager -> Control
    emControl EventManager
    mgr) Bool -> Bool -> Bool
    || Fd
    fd 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 <- forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar (EventManager -> Fd -> MVar (IntTable [FdData])
    callbackTableVar EventManager
    mgr Fd
    fd) forall a b. (a -> b) -> a -> b
    $ \IntTable [FdData]
    tbl ->
            forall a. Int -> IntTable a -> IO (Maybe a)
    IT.delete (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Fd
    fd) IntTable [FdData]
    tbl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (forall (m :: * -> *) a. Monad m => a -> m a
    return []) (IntTable [FdData] -> [FdData] -> IO [FdData]
    selectCallbacks IntTable [FdData]
    tbl)
        forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [FdData]
    fdds 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) = 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') forall a. Eq a => a -> a -> Bool
    == Lifetime
    MultiShot
                saved :: [FdData]
    saved = [FdData]
    notTriggered forall a. [a] -> [a] -> [a]
    ++ 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]
    _ <- forall a. (a -> a -> a) -> Int -> a -> IntTable a -> IO (Maybe a)
    IT.insertWith (\[FdData]
    _ [FdData]
    _ -> [FdData]
    saved) (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 forall a. Eq a => a -> a -> Bool
    == EventLifetime
    savedEls ->
                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
                    forall (m :: * -> *). Monad m => Bool -> m () -> m ()
    unless (Lifetime
    OneShot forall a. Eq a => a -> a -> Bool
    == EventLifetime -> Lifetime
    I.elLifetime EventLifetime
    allEls
                      Bool -> Bool -> Bool
    && forall a. Monoid a => a
    mempty forall a. Eq a => a -> a -> Bool
    == EventLifetime -> Event
    I.elEvent EventLifetime
    savedEls) forall a b. (a -> b) -> a -> b
    $
                        forall (f :: * -> *) a. Functor f => f a -> f ()
    void 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
                    forall (f :: * -> *) a. Functor f => f a -> f ()
    void 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)

            forall (m :: * -> *) a. Monad m => a -> m a
    return [FdData]
    triggered

    nullToNothing :: [a] -> Maybe [a]
    nullToNothing :: forall a. [a] -> Maybe [a]
    nullToNothing []       = forall a. Maybe a
    Nothing
    nullToNothing xs :: [a]
    xs@(a
    _:[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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    p)