
  0 | module IO.Async.Event
  1 | 
  2 | import IO.Async
  3 | import Data.IORef
  4 | import System.Concurrency
  5 | 
  6 | %default total
  7 | 
  8 | export
  9 | record Event a where
 10 |   constructor Ev
 11 |   cb   : IORef (Maybe (a -> IO ()))
 12 |   ref  : IORef (Maybe a)
 13 |   lock : Mutex
 14 | 
 15 | withLock : Event a -> IO b -> IO b
 16 | withLock ev f = do
 17 |   mutexAcquire ev.lock
 18 |   v <- f
 19 |   mutexRelease ev.lock
 20 |   pure v
 21 | 
 22 | export
 23 | newEvent : HasIO io => io (Event a)
 24 | newEvent = [| Ev (newIORef Nothing) (newIORef Nothing) makeMutex |]
 25 | 
 26 | export
 27 | listen : Event a -> (a -> IO ()) -> IO ()
 28 | listen ev cb = do
 29 |   run <- withLock ev $ do
 30 |     readIORef ev.ref >>= \case
 31 |       Just v  => writeIORef ev.ref Nothing $> cb v
 32 |       Nothing => writeIORef ev.cb (Just cb) $> pure ()
 33 |   run
 34 | 
 35 | export
 36 | send : Event a -> b -> (b -> a) -> (a -> b -> a) -> IO ()
 37 | send ev v new acc = do
 38 |   run <- withLock ev $
 39 |     readIORef ev.cb >>= \case
 40 |       Nothing => readIORef ev.ref >>= \case
 41 |         Just x  => writeIORef ev.ref (Just $ acc x v) $> pure ()
 42 |         Nothing => writeIORef ev.ref (Just $ new v) $> pure ()
 43 |       Just cb   => writeIORef ev.cb Nothing $> cb (new v)
 44 |   run
 45 | 
 46 | stopListening : Event a -> IO ()
 47 | stopListening ev = withLock ev $ writeIORef ev.cb Nothing
 48 | 
 49 | export
 50 | onEvent : Event a -> Async es a
 51 | onEvent ev =
 52 |   cancelableAsync $ \cb =>
 53 |     listen ev (cb . Succeeded) $> liftIO (stopListening ev)
 54 | 
 55 | public export
 56 | 0 Buffer : Type -> Type
 57 | Buffer = Event . SnocList
 58 | 
 59 | export %inline
 60 | buffer : Buffer a -> a -> IO ()
 61 | buffer ev v = send ev v (Lin :<) (:<)
 62 |