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 :: forall st (m :: * -> *) event.
MonadSink st m =>
(event -> m ())
-> [Sink event st -> m ReleaseKey] -> m (ReleaseKey, Sink event st)
spawn event -> m ()
handleEvent [Sink event st -> m ReleaseKey]
sources = do
  (ReleaseKey
sinkKey, Sink event st
sink) <- (event -> m ()) -> m (ReleaseKey, Sink event st)
forall rs (m :: * -> *) event.
MonadSink rs m =>
(event -> m ()) -> m (ReleaseKey, Sink event rs)
Sink.spawn event -> m ()
handleEvent

  ReleaseKey
key <- [m ReleaseKey] -> m ReleaseKey
forall (m :: * -> *).
MonadResource m =>
[m ReleaseKey] -> m ReleaseKey
registerMany ([m ReleaseKey] -> m ReleaseKey) -> [m ReleaseKey] -> m ReleaseKey
forall a b. (a -> b) -> a -> b
$
    ReleaseKey -> m ReleaseKey
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReleaseKey
sinkKey m ReleaseKey -> [m ReleaseKey] -> [m ReleaseKey]
forall a. a -> [a] -> [a]
:
    ((Sink event st -> m ReleaseKey) -> m ReleaseKey)
-> [Sink event st -> m ReleaseKey] -> [m ReleaseKey]
forall a b. (a -> b) -> [a] -> [b]
map ((Sink event st -> m ReleaseKey) -> Sink event st -> m ReleaseKey
forall a b. (a -> b) -> a -> b
$ Sink event st
sink) [Sink event st -> m ReleaseKey]
sources

  pure (ReleaseKey
key, Sink event st
sink)

registerMany
  :: MonadResource m
  => [m ReleaseKey]
  -> m ReleaseKey
registerMany :: forall (m :: * -> *).
MonadResource m =>
[m ReleaseKey] -> m ReleaseKey
registerMany [m ReleaseKey]
actions =
  [m ReleaseKey] -> m [ReleaseKey]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [m ReleaseKey]
actions m [ReleaseKey] -> ([ReleaseKey] -> m ReleaseKey) -> m ReleaseKey
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    IO () -> m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register (IO () -> m ReleaseKey)
-> ([ReleaseKey] -> IO ()) -> [ReleaseKey] -> m ReleaseKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReleaseKey -> IO ()) -> [ReleaseKey] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ReleaseKey -> IO ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
Resource.release