-- |
-- Description: Higher-order Events
--
-- 'Event's and combinators for them.
module Events.Events(
   Result(..),
   Event(..),
      -- The event type.  Instance of HasEvent and Monad.
   HasEvent(..), -- things which can be lifted to an Event

   never, -- the event which never happens
   always, -- the event which always happens

   sync, poll,  -- synchronises or polls an event
   (>>>=), (>>>), -- wraps Events
   (+>), -- choice between Events

   choose, -- chooses between many Events.
   tryEV, -- Replaces an event by one which checks for errors in the
          -- continuations.
   computeEvent, -- Allows you to compute the event with an IO action.
   wrapAbort,
      -- Allows you to specify pre- and post-registration actions.
      -- The post-registration action is executed when the pre-registration
      -- was, and some other event is registered.

   noWait, -- :: Event a -> Event ()
      -- Execute event asynchronously and immediately return.
   HasSend(..), -- overloaded send function
   HasReceive(..), -- overloaded receive function
   -- functions to send and receive without going via events.
   sendIO, -- :: HasSend chan => chan a -> a -> IO ()
   receiveIO, -- :: HasReceive chan => chan a -> IO a


   allowWhile,
      -- :: Event () -> Event a -> Event a
      -- Allow one event to happen while waiting for another.

   Request(..),
      -- Datatype encapsulating server calls which get a delayed
      -- response.
   request,
      -- :: Request a b -> a -> IO b
      -- Simple use of Request.
   doRequest, -- :: Request a b -> a -> IO (Event b,IO ())
      -- More complicated use
   spawnEvent, -- :: Event () -> IO (IO ())
   -- spawnEvent syncs on the given event in a thread.
   -- the returned action should be executed to kill the thread.

   getAllQueued, -- :: Event a -> IO [a]
   -- getAllQueued synchronises on the event as much as possible
   -- without having to wait.

   -- Functions for monadic events.  (Don't use these directly, they
   -- are only here so GHC can export the inlined versions of them . . .)
   thenGetEvent, -- :: Event a -> (a -> Event b) -> Event b
   thenEvent, -- :: Event a -> Event b -> Event b
   doneEvent, -- :: a -> Event a

   syncNoWait

   ) where

import Control.Exception
import Control.Concurrent
import Control.Applicative
import Control.Monad
import Control.Monad.Fail

import Util.Computation

import Events.Toggle
import Events.Spawn

data Result = Immediate  | Awaiting (IO ()) | AwaitingAlways (IO ())

-- ----------------------------------------------------------------------
-- Events and the HasEvent class.
-- ----------------------------------------------------------------------

newtype Event a = Event (Toggle -> (IO a -> IO ()) -> IO Result)
-- The function inside an Event registers that event for the synchronisation
-- associated with this toggle.  The three results
-- can be interpreted as follows:
-- Immediate can occur in two cases.  Either
--    (1) the event was immediately matched and we performed the provided
--        action fun with an action returning an a.
--    (2) the event was not immediately matched because someone else had
--        already flipped the toggle.
--    In both cases, the event is not registered after the function returns.
-- Awaiting action means that the event was registered.
--    The caller should always ensure that the action is executed after the
--    synchronisation has succeeded.
-- AwaitingAlways action means that the event must be done after the
--    synchronisation whether or not the action succeeds.

-- | HasEvent represents those event-like things which can be converted to
-- an event.
class HasEvent eventType where
   ---
   -- converts to an event.
   toEvent :: eventType a -> Event a

instance HasEvent Event where
   toEvent :: Event a -> Event a
toEvent = Event a -> Event a
forall a. a -> a
id

-- ----------------------------------------------------------------------
-- Three trivial events.
-- ----------------------------------------------------------------------


-- | The event that never happens
never :: Event a
never :: Event a
never = (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
forall a. (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
Event (\ Toggle
toggle IO a -> IO ()
aActSink -> Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> Result
Awaiting IO ()
forall (m :: * -> *). Monad m => m ()
done))

-- | The event that always happens, immediately
always :: IO a -> Event a
always :: IO a -> Event a
always IO a
aAction = (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
forall a. (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
Event (
   \ Toggle
toggle IO a -> IO ()
aActSink ->
      do
         Toggle -> IO () -> IO ()
ifToggle Toggle
toggle (IO a -> IO ()
aActSink IO a
aAction)
         Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
Immediate
      )

-- ----------------------------------------------------------------------
-- Continuations
-- ----------------------------------------------------------------------

-- | Attach an action to be done after the event occurs.
(>>>=) :: Event a -> (a -> IO b) -> Event b
>>>= :: Event a -> (a -> IO b) -> Event b
(>>>=) (Event Toggle -> (IO a -> IO ()) -> IO Result
registerFn) a -> IO b
continuation = (Toggle -> (IO b -> IO ()) -> IO Result) -> Event b
forall a. (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
Event (
   \ Toggle
toggle IO b -> IO ()
bActionSink ->
      Toggle -> (IO a -> IO ()) -> IO Result
registerFn Toggle
toggle (
         \ IO a
aAction ->
            IO b -> IO ()
bActionSink (
               do
                  a
a <- IO a
aAction
                  a -> IO b
continuation a
a
               )
         )
   )
infixl 2 >>>=

-- | Attach an action to be done after the event occurs.
(>>>) :: Event a -> IO b -> Event b
>>> :: Event a -> IO b -> Event b
(>>>) Event a
event IO b
continuation = Event a
event Event a -> (a -> IO b) -> Event b
forall a b. Event a -> (a -> IO b) -> Event b
>>>= (IO b -> a -> IO b
forall a b. a -> b -> a
const IO b
continuation)
infixl 2 >>>

{-# INLINE (>>>) #-}

-- ----------------------------------------------------------------------
-- Choice
-- ----------------------------------------------------------------------

-- | Choose between two events.  The first one takes priority.
(+>) :: Event a -> Event a -> Event a
+> :: Event a -> Event a -> Event a
(+>) (Event Toggle -> (IO a -> IO ()) -> IO Result
registerFn1) (Event Toggle -> (IO a -> IO ()) -> IO Result
registerFn2) = (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
forall a. (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
Event (
   \ Toggle
toggle IO a -> IO ()
aActSink ->
      do
         Result
status1 <- Toggle -> (IO a -> IO ()) -> IO Result
registerFn1 Toggle
toggle IO a -> IO ()
aActSink
         let
            doSecond :: IO a -> IO Result
doSecond IO a
postAction1 =
               do
                  let
                     doThird :: IO () -> m Result
doThird IO ()
postAction2 =Result -> m Result
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> Result
AwaitingAlways (
                        do
                           IO a
postAction1
                           IO ()
postAction2
                        ))
                  Result
status2 <- Toggle -> (IO a -> IO ()) -> IO Result
registerFn2 Toggle
toggle IO a -> IO ()
aActSink
                  case Result
status2 of
                     Result
Immediate ->
                        do
                           IO a
postAction1
                           Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
Immediate
                     Awaiting IO ()
postAction2 -> IO () -> IO Result
forall (m :: * -> *). Monad m => IO () -> m Result
doThird IO ()
postAction2
                     AwaitingAlways IO ()
postAction2 -> IO () -> IO Result
forall (m :: * -> *). Monad m => IO () -> m Result
doThird IO ()
postAction2
         case Result
status1 of
            Result
Immediate -> Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
Immediate
            Awaiting IO ()
postAction1 -> IO () -> IO Result
forall a. IO a -> IO Result
doSecond IO ()
postAction1
            AwaitingAlways IO ()
postAction1 -> IO () -> IO Result
forall a. IO a -> IO Result
doSecond IO ()
postAction1
      )

infixl 1 +>

-- | Choose between a list of events.
choose :: [Event a] -> Event a
choose :: [Event a] -> Event a
choose [] = Event a
forall a. Event a
never
choose [Event a]
nonEmpty = (Event a -> Event a -> Event a) -> [Event a] -> Event a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Event a -> Event a -> Event a
forall a. Event a -> Event a -> Event a
(+>) [Event a]
nonEmpty

-- ----------------------------------------------------------------------
-- Catching Errors
-- ----------------------------------------------------------------------

-- | Catch an error if it occurs during an action attached to an event.
tryEV :: Event a -> Event (Either SomeException a)
tryEV :: Event a -> Event (Either SomeException a)
tryEV (Event Toggle -> (IO a -> IO ()) -> IO Result
registerFn) = (Toggle -> (IO (Either SomeException a) -> IO ()) -> IO Result)
-> Event (Either SomeException a)
forall a. (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
Event (
   \ Toggle
toggle IO (Either SomeException a) -> IO ()
errorOraSink ->
      Toggle -> (IO a -> IO ()) -> IO Result
registerFn Toggle
toggle (\ IO a
aAct ->
         IO (Either SomeException a) -> IO ()
errorOraSink (IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try IO a
aAct)
         )
      )

-- ----------------------------------------------------------------------
-- Allowing an event to vary
-- ---------------------------------------------------------------------

-- | Construct a new event using an action which is called at each
-- synchronisation
computeEvent :: IO (Event a) -> Event a
computeEvent :: IO (Event a) -> Event a
computeEvent IO (Event a)
getEvent = (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
forall a. (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
Event (
   \ Toggle
toggle IO a -> IO ()
aActSink ->
      do
         (Event Toggle -> (IO a -> IO ()) -> IO Result
registerFn) <- IO (Event a)
getEvent
         Toggle -> (IO a -> IO ()) -> IO Result
registerFn Toggle
toggle IO a -> IO ()
aActSink
      )

-- ----------------------------------------------------------------------
-- Getting information about when an event is aborted.
-- ---------------------------------------------------------------------

-- | When we synchronise on wrapAbort preAction
-- preAction is evaluated to yield (event,postAction).
-- Then exactly one of the following:
-- (1) thr event is satisfied, and postAction is not done.
-- (2) some other event in this synchronisation is satisfied
-- (so this one isn\'t), and postAction is done.
-- (3) no event is satisfied (and so we will deadlock).
wrapAbort :: IO (Event a,IO ()) -> Event a
wrapAbort :: IO (Event a, IO ()) -> Event a
wrapAbort IO (Event a, IO ())
preAction  =
   IO (Event a) -> Event a
forall a. IO (Event a) -> Event a
computeEvent (
      do
         SimpleToggle
postDone <- IO SimpleToggle
newSimpleToggle
         (Event Toggle -> (IO a -> IO ()) -> IO Result
registerFn,IO ()
postAction) <- IO (Event a, IO ())
preAction
         let doAfter :: IO ()
doAfter = SimpleToggle -> IO () -> IO ()
ifSimpleToggle SimpleToggle
postDone IO ()
postAction
         Event a -> IO (Event a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
forall a. (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
Event (
            \ Toggle
toggle IO a -> IO ()
aActSink ->
               do
                  Result
status <- Toggle -> (IO a -> IO ()) -> IO Result
registerFn Toggle
toggle
                     (\ IO a
aAct ->
                        do
                           SimpleToggle -> IO Bool
simpleToggle SimpleToggle
postDone
                           IO a -> IO ()
aActSink IO a
aAct
                        )
                  case Result
status of
                     -- Even with Immediate we must do doAfter, as
                     -- the toggle may have been flipped by someone else.
                     Result
Immediate -> (IO ()
doAfter IO () -> IO Result -> IO Result
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
Immediate)
                     Awaiting IO ()
action -> Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> Result
Awaiting (IO ()
doAfter IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
action))
                     AwaitingAlways IO ()
action ->
                        Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> Result
AwaitingAlways (IO ()
doAfter IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
action))
               ))
      )

-- ----------------------------------------------------------------------
-- Synchronisation and Polling.
-- Sigh.  Because GHC makes takeMVar/putMVar interruptible, I don't
-- know how to ensure that the postAction will get done if an
-- asynchronous exception is raised.
-- ---------------------------------------------------------------------

-- | Synchronise on an event, waiting on it until it happens, then returning
-- the attached value.
sync :: Event a -> IO a
sync :: Event a -> IO a
sync (Event Toggle -> (IO a -> IO ()) -> IO Result
registerFn) =
   do
      Toggle
toggle <- IO Toggle
newToggle
      MVar (IO a)
aActMVar <- IO (MVar (IO a))
forall a. IO (MVar a)
newEmptyMVar
      Result
status <- Toggle -> (IO a -> IO ()) -> IO Result
registerFn Toggle
toggle (\ IO a
aAct -> MVar (IO a) -> IO a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (IO a)
aActMVar IO a
aAct)
      IO a
aAct <- MVar (IO a) -> IO (IO a)
forall a. MVar a -> IO a
takeMVar MVar (IO a)
aActMVar
      case Result
status of
         AwaitingAlways IO ()
postAction -> IO ()
postAction
         Result
_ -> IO ()
forall (m :: * -> *). Monad m => m ()
done
      IO a
aAct

-- | Synchronise on an event, but return immediately with Nothing if it
-- can\'t be satisfied at once.
poll :: Event a -> IO (Maybe a)
poll :: Event a -> IO (Maybe a)
poll Event a
event =
   Event (Maybe a) -> IO (Maybe a)
forall a. Event a -> IO a
sync (
         (Event a
event Event a -> (a -> IO (Maybe a)) -> Event (Maybe a)
forall a b. Event a -> (a -> IO b) -> Event b
>>>= (\ a
a -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a)))
      Event (Maybe a) -> Event (Maybe a) -> Event (Maybe a)
forall a. Event a -> Event a -> Event a
+> (IO (Maybe a) -> Event (Maybe a)
forall a. IO a -> Event a
always (Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing))
      )

-- ----------------------------------------------------------------------
-- The noWait combinator
-- ----------------------------------------------------------------------

-- | Turns an event into one which is always satisfied at once but registers
-- the value to be done later.  WARNING - only to be used with events without
-- actions attached, as any actions will not get done.  noWait is typically
-- used with send events, where we don\'t want to wait for someone to pick up
-- the value.
noWait :: Event a -> Event ()
noWait :: Event a -> Event ()
noWait (Event Toggle -> (IO a -> IO ()) -> IO Result
registerFn) = (Toggle -> (IO () -> IO ()) -> IO Result) -> Event ()
forall a. (Toggle -> (IO a -> IO ()) -> IO Result) -> Event a
Event (
   \ Toggle
toggle IO () -> IO ()
unitActSink ->
      do
         Toggle -> IO () -> IO ()
ifToggle Toggle
toggle (
            do
               Toggle
toggle' <- IO Toggle
newToggle
               Toggle -> (IO a -> IO ()) -> IO Result
registerFn Toggle
toggle' (IO () -> IO a -> IO ()
forall a b. a -> b -> a
const IO ()
forall (m :: * -> *). Monad m => m ()
done)
               IO () -> IO ()
unitActSink (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
               IO ()
forall (m :: * -> *). Monad m => m ()
done
            )
         Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
Immediate
   )

-- | Register an event as synchronised but don\'t wait for it to complete.
-- WARNING - only to be used with events without
-- actions attached, as any actions will not get done.  noWait is typically
-- used with send events, where we don\'t want to wait for someone to pick up
-- the value.
-- synchronise on something without waiting
syncNoWait :: Event a -> IO ()
syncNoWait :: Event a -> IO ()
syncNoWait (Event Toggle -> (IO a -> IO ()) -> IO Result
registerFn) =
   do
      Toggle
toggle <- IO Toggle
newToggle
      Toggle -> (IO a -> IO ()) -> IO Result
registerFn Toggle
toggle (IO () -> IO a -> IO ()
forall a b. a -> b -> a
const IO ()
forall (m :: * -> *). Monad m => m ()
done)
      IO ()
forall (m :: * -> *). Monad m => m ()
done

{-# RULES
"syncNoWait" forall event . sync (noWait event) = syncNoWait event
"syncNoWait2"
   forall event continuation . sync ((noWait event) >>>= continuation) =
      (syncNoWait event >> continuation ())
  #-}


-- ----------------------------------------------------------------------
-- The HasSend and HasReceive classes
-- ----------------------------------------------------------------------

-- | HasSend represents things like channels on which we can send values
class HasSend chan where
   ---
   -- Returns an event which corresponds to sending something on a channel.
   -- For a synchronous channel (most channels are synchronous) this event
   -- is not satisfied until someone accepts the value.
   send :: chan a -> a -> Event ()

-- | HasReceive represents things like channels from which we can take values.
class HasReceive chan where
   ---
   -- Returns an event which corresponds to something arriving on a channel.
   receive :: chan a -> Event a

-- Two handy abbreviations

-- | Send a value along a channel (as an IO action)
sendIO :: HasSend chan => chan a -> a -> IO ()
sendIO :: chan a -> a -> IO ()
sendIO chan a
chan a
msg = Event () -> IO ()
forall a. Event a -> IO a
sync (chan a -> a -> Event ()
forall (chan :: * -> *) a. HasSend chan => chan a -> a -> Event ()
send chan a
chan  a
msg)

-- | Get a value from a channel (as an IO action)
receiveIO :: HasReceive chan => chan a -> IO a
receiveIO :: chan a -> IO a
receiveIO chan a
chan = Event a -> IO a
forall a. Event a -> IO a
sync (chan a -> Event a
forall (chan :: * -> *) a. HasReceive chan => chan a -> Event a
receive chan a
chan)

-- ----------------------------------------------------------------------
-- Monadic Events
-- We include some extra GHC magic here, so that using "always"
-- in monadic events is not especially inefficient.
-- ----------------------------------------------------------------------

instance Monad Event where
   >>= :: Event a -> (a -> Event b) -> Event b
(>>=) = Event a -> (a -> Event b) -> Event b
forall a b. Event a -> (a -> Event b) -> Event b
thenGetEvent
   >> :: Event a -> Event b -> Event b
(>>) = Event a -> Event b -> Event b
forall a b. Event a -> Event b -> Event b
thenEvent
   return :: a -> Event a
return = a -> Event a
forall a. a -> Event a
doneEvent

instance MonadFail Event where
   fail :: String -> Event a
fail String
str = IO a -> Event a
forall a. IO a -> Event a
always (IOError -> IO a
forall a. IOError -> IO a
ioError (String -> IOError
userError String
str))

instance Applicative Event where
   pure :: a -> Event a
pure = a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return
   <*> :: Event (a -> b) -> Event a -> Event b
(<*>) = Event (a -> b) -> Event a -> Event b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Functor Event where
   fmap :: (a -> b) -> Event a -> Event b
fmap  = (a -> b) -> Event a -> Event b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

thenGetEvent :: Event a -> (a -> Event b) -> Event b
thenGetEvent :: Event a -> (a -> Event b) -> Event b
thenGetEvent Event a
event1 a -> Event b
getEvent2 = Event a
event1 Event a -> (a -> IO b) -> Event b
forall a b. Event a -> (a -> IO b) -> Event b
>>>= (\ a
val -> Event b -> IO b
forall a. Event a -> IO a
sync(a -> Event b
getEvent2 a
val))

thenEvent :: Event a -> Event b -> Event b
thenEvent :: Event a -> Event b -> Event b
thenEvent Event a
event1 Event b
event2 = Event a
event1 Event a -> IO b -> Event b
forall a b. Event a -> IO b -> Event b
>>> (Event b -> IO b
forall a. Event a -> IO a
sync(Event b
event2))

doneEvent :: a -> Event a
doneEvent :: a -> Event a
doneEvent a
val = IO a -> Event a
forall a. IO a -> Event a
always (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val)

{-# INLINE thenGetEvent #-}
{-# INLINE thenEvent #-}
{-# INLINE doneEvent #-}

-- Rules allowing us to use "always" in monadic events efficiently.
{-# RULES
"always1" forall action . sync (always action) = action
"always" forall action continuation .
         (>>>=) (always action) continuation = always (action >>= continuation)
   #-}

-- ----------------------------------------------------------------------
-- Other miscellaneous event functions.
-- ----------------------------------------------------------------------

-- | allowWhile event1 event2 waits for event2, while handling event1.
allowWhile :: Event () -> Event a -> Event a
allowWhile :: Event () -> Event a -> Event a
allowWhile Event ()
event1 Event a
event2 =
      Event a
event2
   Event a -> Event a -> Event a
forall a. Event a -> Event a -> Event a
+>(do
         Event ()
event1
         Event () -> Event a -> Event a
forall a. Event () -> Event a -> Event a
allowWhile Event ()
event1 Event a
event2
     )

data Request a b = Request (a -> IO (Event b,IO ()))
-- A Request operation represents a call to a server to evaluate
-- a function :: a->b.  The Event b is activated with the result.
-- The client should call the supplied action if the event is
-- no longer needed.

request :: Request a b -> a -> IO b
request :: Request a b -> a -> IO b
request Request a b
rq a
a =
   do
      (Event b
event,IO ()
_) <- Request a b -> a -> IO (Event b, IO ())
forall a b. Request a b -> a -> IO (Event b, IO ())
doRequest Request a b
rq a
a
      Event b -> IO b
forall a. Event a -> IO a
sync Event b
event

doRequest :: Request a b -> a -> IO (Event b,IO ())
doRequest :: Request a b -> a -> IO (Event b, IO ())
doRequest (Request a -> IO (Event b, IO ())
rqFn) a
request = a -> IO (Event b, IO ())
rqFn a
request

-- | Synchronise on an event in a different thread.
-- The kill action it returns is unsafe since it can cause deadlocks if
-- it occurs at an awkward moment.  To avoid this use spawnEvent, if possible.
spawnEvent :: Event () -> IO (IO ())
spawnEvent :: Event () -> IO (IO ())
spawnEvent Event ()
reactor = IO () -> IO (IO ())
spawn (Event () -> IO ()
forall a. Event a -> IO a
sync Event ()
reactor)

-- | get all we can get from the event without waiting.
getAllQueued :: Event a -> IO [a]
getAllQueued :: Event a -> IO [a]
getAllQueued Event a
event = Event a -> [a] -> IO [a]
forall a. Event a -> [a] -> IO [a]
gAQ Event a
event []
   where
      gAQ :: Event a -> [a] -> IO [a]
gAQ Event a
event [a]
acc =
         do
            Maybe a
maybeA <- Event a -> IO (Maybe a)
forall a. Event a -> IO (Maybe a)
poll Event a
event
            case Maybe a
maybeA of
               Maybe a
Nothing -> [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc)
               Just a
a -> Event a -> [a] -> IO [a]
gAQ Event a
event (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc)