{-# 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
:: 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 :: 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)