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