{-# 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 :: forall (m :: * -> *) acc a x.
MonadMoment m =>
m acc
-> (a -> acc -> (x, acc)) -> Event a -> m (Event x, Behavior acc)
setup m acc
initialWorld a -> acc -> (x, acc)
action Event a
triggerE = mdo
  initial <- m acc
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 :: forall world update s.
(world -> ST s (Thaw world s))
-> (Thaw world s -> ST s world)
-> world
-> (Thaw world s -> ST s update)
-> ST s (update, world)
runWorldWith world -> ST s (Thaw world s)
t Thaw world s -> ST s world
f world
old Thaw world s -> ST s update
action = do
  Thaw world s
st <- world -> ST s (Thaw world s)
t world
old
  update
res <- Thaw world s -> ST s update
action Thaw world s
st
  world
new <- Thaw world s -> ST s world
f Thaw world s
st
  pure (update
res, world
new)