keid-frp-banana-0.1.0.0: src/Engine/ReactiveBanana/Stateful.hs

{-# 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 initialWorld action triggerE = mdo
  initial <- initialWorld
  RB.mapAccum initial $
    fmap action 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 t f old action = do
  st <- t old
  res <- action st
  new <- f st
  pure (res, new)