{-# LANGUAGE AllowAmbiguousTypes #-}
module Control.Monad.Freer.State
(
State(..)
, get
, put
, modify
, gets
, runState
, evalState
, execState
, transactionState
, transactionState'
) where
import Data.Proxy (Proxy)
import Control.Monad.Freer (Eff, Member, send)
import Control.Monad.Freer.Internal (Arr, handleRelayS, interposeS)
data State s r where
Get :: State s s
Put :: !s -> State s ()
get :: forall s effs. Member (State s) effs => Eff effs s
get :: Eff effs s
get = State s s -> Eff effs s
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send State s s
forall s. State s s
Get
put :: forall s effs. Member (State s) effs => s -> Eff effs ()
put :: s -> Eff effs ()
put s
s = State s () -> Eff effs ()
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send (s -> State s ()
forall s. s -> State s ()
Put s
s)
modify :: forall s effs. Member (State s) effs => (s -> s) -> Eff effs ()
modify :: (s -> s) -> Eff effs ()
modify s -> s
f = (s -> s) -> Eff effs s -> Eff effs s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> s
f Eff effs s
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get Eff effs s -> (s -> Eff effs ()) -> Eff effs ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
put
gets :: forall s a effs. Member (State s) effs => (s -> a) -> Eff effs a
gets :: (s -> a) -> Eff effs a
gets s -> a
f = s -> a
f (s -> a) -> Eff effs s -> Eff effs a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff effs s
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get
runState :: forall s effs a. s -> Eff (State s ': effs) a -> Eff effs (a, s)
runState :: s -> Eff (State s : effs) a -> Eff effs (a, s)
runState s
s0 = s
-> (s -> a -> Eff effs (a, s))
-> (forall v.
s -> State s v -> (s -> Arr effs v (a, s)) -> Eff effs (a, s))
-> Eff (State s : effs) a
-> Eff effs (a, s)
forall s a (effs :: [* -> *]) b (eff :: * -> *).
s
-> (s -> a -> Eff effs b)
-> (forall v. s -> eff v -> (s -> Arr effs v b) -> Eff effs b)
-> Eff (eff : effs) a
-> Eff effs b
handleRelayS s
s0 (\s
s a
x -> (a, s) -> Eff effs (a, s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, s
s)) ((forall v.
s -> State s v -> (s -> Arr effs v (a, s)) -> Eff effs (a, s))
-> Eff (State s : effs) a -> Eff effs (a, s))
-> (forall v.
s -> State s v -> (s -> Arr effs v (a, s)) -> Eff effs (a, s))
-> Eff (State s : effs) a
-> Eff effs (a, s)
forall a b. (a -> b) -> a -> b
$ \s
s State s v
x s -> Arr effs v (a, s)
k -> case State s v
x of
State s v
Get -> s -> Arr effs v (a, s)
k s
s s
v
s
Put s' -> s -> Arr effs v (a, s)
k s
s' ()
execState :: forall s effs a. s -> Eff (State s ': effs) a -> Eff effs s
execState :: s -> Eff (State s : effs) a -> Eff effs s
execState s
s = ((a, s) -> s) -> Eff effs (a, s) -> Eff effs s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, s) -> s
forall a b. (a, b) -> b
snd (Eff effs (a, s) -> Eff effs s)
-> (Eff (State s : effs) a -> Eff effs (a, s))
-> Eff (State s : effs) a
-> Eff effs s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Eff (State s : effs) a -> Eff effs (a, s)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs (a, s)
runState s
s
evalState :: forall s effs a. s -> Eff (State s ': effs) a -> Eff effs a
evalState :: s -> Eff (State s : effs) a -> Eff effs a
evalState s
s = ((a, s) -> a) -> Eff effs (a, s) -> Eff effs a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, s) -> a
forall a b. (a, b) -> a
fst (Eff effs (a, s) -> Eff effs a)
-> (Eff (State s : effs) a -> Eff effs (a, s))
-> Eff (State s : effs) a
-> Eff effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Eff (State s : effs) a -> Eff effs (a, s)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs (a, s)
runState s
s
transactionState
:: forall s effs a
. Member (State s) effs
=> Eff effs a
-> Eff effs a
transactionState :: Eff effs a -> Eff effs a
transactionState Eff effs a
m = do
s
s0 <- forall (effs :: [* -> *]). Member (State s) effs => Eff effs s
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get @s
(a
x, s
s) <- s
-> (s -> a -> Eff effs (a, s))
-> (forall v.
s -> State s v -> (s -> Arr effs v (a, s)) -> Eff effs (a, s))
-> Eff effs a
-> Eff effs (a, s)
forall (eff :: * -> *) (effs :: [* -> *]) s a b.
Member eff effs =>
s
-> (s -> a -> Eff effs b)
-> (forall v. s -> eff v -> (s -> Arr effs v b) -> Eff effs b)
-> Eff effs a
-> Eff effs b
interposeS s
s0 (\s
s a
x -> (a, s) -> Eff effs (a, s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, s
s)) forall v.
s -> State s v -> (s -> Arr effs v (a, s)) -> Eff effs (a, s)
forall v b. s -> State s v -> (s -> Arr effs v b) -> Eff effs b
handle Eff effs a
m
s -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
put s
s
a -> Eff effs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
where
handle :: s -> State s v -> (s -> Arr effs v b) -> Eff effs b
handle :: s -> State s v -> (s -> Arr effs v b) -> Eff effs b
handle s
s State s v
x s -> Arr effs v b
k = case State s v
x of
State s v
Get -> s -> Arr effs v b
k s
s s
v
s
Put s
s' -> s -> Arr effs v b
k s
s' ()
transactionState'
:: forall s effs a
. Member (State s) effs
=> Proxy s
-> Eff effs a
-> Eff effs a
transactionState' :: Proxy s -> Eff effs a -> Eff effs a
transactionState' Proxy s
_ = forall (effs :: [* -> *]) a.
Member (State s) effs =>
Eff effs a -> Eff effs a
forall s (effs :: [* -> *]) a.
Member (State s) effs =>
Eff effs a -> Eff effs a
transactionState @s
{-# INLINE transactionState' #-}