packages feed

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

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

import RIO

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

import Engine.Events.Sink (Sink)
import Engine.Events.Sink qualified as Sink
import Engine.Types (StageRIO)

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

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

  pure (key, sink)

registerMany :: [StageRIO st ReleaseKey] -> StageRIO st ReleaseKey
registerMany actions =
  sequenceA actions >>=
    Resource.register . traverse_ Resource.release