#if MTL
#endif
module Control.Effect.State (
EffectState, State, runState,
evalState, execState,
get, gets, put,
modify, modify',
state, withState
) where
import Control.Applicative ((<$>))
import Control.Monad.Effect
#ifdef MTL
import qualified Control.Monad.State.Class as S
import Data.Type.Row
instance (Member (State s) l, State s ~ InstanceOf State l) => S.MonadState s (Effect l) where
get = get
put = put
state = state
#endif
newtype State s a = State (s -> (a, s))
type instance Is State f = IsState f
type family IsState f where
IsState (State s) = True
IsState f = False
class MemberEffect State (State s) l => EffectState s l
instance MemberEffect State (State s) l => EffectState s l
get :: EffectState s l => Effect l s
get = state $ \s -> (s, s)
gets :: EffectState s l => (s -> a) -> Effect l a
gets f = f <$> get
put :: EffectState s l => s -> Effect l ()
put x = state $ const ((), x)
modify :: EffectState s l => (s -> s) -> Effect l ()
modify f = get >>= put . f
modify' :: EffectState s l => (s -> s) -> Effect l ()
modify' f = do
x <- get
put $! f x
state :: EffectState s l => (s -> (a, s)) -> Effect l a
state = send . State
withState :: EffectState s l => (s -> s) -> Effect l a -> Effect l a
withState f x = modify f >> x
runState :: s -> Effect (State s :+ l) a -> Effect l (a, s)
runState = flip $ eliminate
(\x s -> return (x, s))
(\(State f) k s -> let (x, s') = f s in k x s')
evalState :: s -> Effect (State s :+ l) a -> Effect l a
evalState s = fmap fst . runState s
execState :: s -> Effect (State s :+ l) a -> Effect l s
execState s = fmap snd . runState s