module Control.Monad.Freer.State (
State,
get,
put,
modify,
runState,
transactionState
) where
import Control.Monad.Freer.Internal
import Data.Proxy
data State s v where
Get :: State s s
Put :: !s -> State s ()
get :: Member (State s) r => Eff r s
get = send Get
put :: Member (State s) r => s -> Eff r ()
put s = send (Put s)
modify :: Member (State s) r => (s -> s) -> Eff r ()
modify f = fmap f get >>= put
runState :: Eff (State s ': r) w -> s -> Eff r (w,s)
runState (Val x) s = return (x,s)
runState (E u q) s = case decomp u of
Right Get -> runState (qApp q s) s
Right (Put s') -> runState (qApp q ()) s'
Left u' -> E u' (tsingleton (\x -> runState (qApp q x) s))
transactionState :: forall s r w. Member (State s) r =>
Proxy s -> Eff r w -> Eff r w
transactionState _ m = do s <- get; loop s m
where
loop :: s -> Eff r w -> Eff r w
loop s (Val x) = put s >> return x
loop s (E (u :: Union r b) q) = case prj u :: Maybe (State s b) of
Just Get -> loop s (qApp q s)
Just (Put s') -> loop s'(qApp q ())
_ -> E u (tsingleton k) where k = qComp q (loop s)