Sink.hs

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

import RIO

import Control.Concurrent.Chan.Unagi qualified as Unagi
import Control.Exception (AsyncException(ThreadKilled))
import UnliftIO.Concurrent (forkFinally, killThread)
import UnliftIO.Resource (ReleaseKey)
import UnliftIO.Resource qualified as Resource

import Engine.Types (StageRIO)

newtype Sink event st = Sink
  { signal :: event -> StageRIO st ()
  }

spawn
  :: (event -> StageRIO rs ())
  -> StageRIO rs (ReleaseKey, Sink event rs)
spawn handleEvent = do
  (eventsIn, eventsOut) <- liftIO Unagi.newChan
  let sink = Sink \event -> liftIO (Unagi.writeChan eventsIn event)

  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)