module Engine.Events.Sink ( Sink(..) , spawn , MonadSink ) where import RIO import Control.Concurrent.Chan.Unagi qualified as Unagi import Control.Exception (AsyncException(ThreadKilled)) import Engine.Types (GlobalHandles) import RIO.App (App) import RIO.State (MonadState) import UnliftIO.Concurrent (forkFinally, killThread) import UnliftIO.Resource (ReleaseKey, MonadResource) import UnliftIO.Resource qualified as Resource -- | A collection of properties that are available while handling events. -- Has access to a stage @RunState@, but not @Frame@ data. type MonadSink rs m = ( MonadReader (App GlobalHandles rs) m , MonadState rs m , MonadResource m , MonadUnliftIO m ) newtype Sink event rs = Sink { signal :: forall m . MonadSink rs m => event -> m () } spawn :: MonadSink rs m => (event -> m ()) -> m (ReleaseKey, Sink event rs) spawn handleEvent = do (eventsIn, eventsOut) <- liftIO Unagi.newChan let sink = Sink $ liftIO . Unagi.writeChan eventsIn let handler = forever $ liftIO (Unagi.readChan eventsOut) >>= handleEvent tid <- forkFinally handler \case Left exc -> case fromException exc of Just ThreadKilled -> logDebug "Event thread killed" _others -> logError $ "Event thread crashed: " <> displayShow exc Right () -> logWarn "Event thread exited prematurely" key <- Resource.register $ killThread tid pure (key, sink)