{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
module LiveCoding.LiveProgram.Monad.Trans where

-- base
import Data.Data

-- transformers
import Control.Monad.Trans.State.Strict

-- essence-of-live-coding
import LiveCoding.LiveProgram
import LiveCoding.Cell.Monad.Trans

-- | Remove a stateful effect from the monad stack by supplying the initial state.
--   This state then becomes part of the internal live program state,
--   and is subject to migration as any other state.
--   Live programs are automatically migrated to and from applications of 'runStateL'.
runStateL
  :: (Data stateT, Monad m)
  => LiveProgram (StateT stateT m)
  ->                     stateT
  -> LiveProgram                m
runStateL :: LiveProgram (StateT stateT m) -> stateT -> LiveProgram m
runStateL LiveProgram { s
s -> StateT stateT m s
liveStep :: ()
liveState :: ()
liveStep :: s -> StateT stateT m s
liveState :: s
.. } stateT
stateT = LiveProgram :: forall (m :: * -> *) s. Data s => s -> (s -> m s) -> LiveProgram m
LiveProgram
  { liveState :: State stateT s
liveState = State :: forall stateT stateInternal.
stateT -> stateInternal -> State stateT stateInternal
State { stateInternal :: s
stateInternal = s
liveState, stateT
stateT :: stateT
stateT :: stateT
.. }
  , liveStep :: State stateT s -> m (State stateT s)
liveStep = \State { stateT
s
stateInternal :: s
stateT :: stateT
stateT :: forall stateT stateInternal. State stateT stateInternal -> stateT
stateInternal :: forall stateT stateInternal.
State stateT stateInternal -> stateInternal
.. } -> do
      (s
stateInternal, stateT
stateT) <- StateT stateT m s -> stateT -> m (s, stateT)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (s -> StateT stateT m s
liveStep s
stateInternal) stateT
stateT
      State stateT s -> m (State stateT s)
forall (m :: * -> *) a. Monad m => a -> m a
return State :: forall stateT stateInternal.
stateT -> stateInternal -> State stateT stateInternal
State { stateT
s
stateT :: stateT
stateInternal :: s
stateT :: stateT
stateInternal :: s
.. }
  }