{-# LANGUAGE RecursiveDo #-}

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
  -> (a -> acc -> (x, acc))
  -> RB.Event a
  -> m (RB.Event x, RB.Behavior acc)
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
  acc
initial <- m acc
initialWorld
  acc -> Event (acc -> (x, acc)) -> m (Event x, Behavior acc)
forall (m :: * -> *) acc x.
MonadMoment m =>
acc -> Event (acc -> (x, acc)) -> m (Event x, Behavior acc)
RB.mapAccum acc
initial (Event (acc -> (x, acc)) -> m (Event x, Behavior acc))
-> Event (acc -> (x, acc)) -> m (Event x, Behavior acc)
forall a b. (a -> b) -> a -> b
$
    (a -> acc -> (x, acc)) -> Event a -> Event (acc -> (x, acc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> acc -> (x, acc)
action Event a
triggerE

type family Thaw world s

runWorldWith
  :: (world -> ST s (Thaw world s))
  -> (Thaw world s -> ST s world)
  -> world
  -> (Thaw world s -> ST s update)
  -> ST s (update, world)
runWorldWith :: forall world s update.
(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)