packages feed

keid-core-0.1.8.0: src/Engine/Events.hs

module Engine.Events
  ( Sink(..)
  , spawn
  , registerMany
  ) where

import RIO

import UnliftIO.Resource (MonadResource, ReleaseKey)
import UnliftIO.Resource qualified as Resource

import Engine.Events.Sink (MonadSink, Sink)
import Engine.Events.Sink qualified as Sink

spawn
  :: MonadSink st m
  => (event -> m ())
  -> [Sink event st -> m ReleaseKey]
  -> m (ReleaseKey, Sink event st)
spawn handleEvent sources = do
  (sinkKey, sink) <- Sink.spawn handleEvent

  key <- registerMany $
    pure sinkKey :
    map ($ sink) sources

  pure (key, sink)

registerMany
  :: MonadResource m
  => [m ReleaseKey]
  -> m ReleaseKey
registerMany actions =
  sequenceA actions >>=
    Resource.register . traverse_ Resource.release