Stateful.hs

{-# LANGUAGE RecursiveDo #-}

{- | "Crank the world"-style stateful process.

An input event comes in, an update step runs and an output event is fired.
-}

module Engine.ReactiveBanana.Stateful
  ( setup
  , runWorldWith
  , Thaw
  ) where

import Prelude

import Control.Monad.ST (ST)
import Reactive.Banana qualified as RB

setup
  :: RB.MonadMoment m
  => m acc -- ^ An action to produce the initial stat
  -> (a -> acc -> (x, acc)) -- ^ Step function
  -> RB.Event a -- ^ Step  event
  -> m (RB.Event x, RB.Behavior acc) -- ^ A post-step event and a current state snapshot
setup initialWorld action triggerE = mdo
  initial <- initialWorld
  RB.mapAccum initial $
    fmap action triggerE

-- | A helper to connect a world snapshot with its dynamic representation under an existential @s@.
type family Thaw world s

runWorldWith
  :: forall world update s
  .  (world -> ST s (Thaw world s)) -- ^ Thaw the world into 'STRef's
  -> (Thaw world s -> ST s world) -- ^ Read the world STRefs and freeze
  -> world -- ^ Previous world snapshot
  -> (Thaw world s -> ST s update) -- ^ Update procedure yielding a result and a new world snapshot
  -> ST s (update, world)
runWorldWith t f old action = do
  st <- t old
  res <- action st
  new <- f st
  pure (res, new)