{-# LANGUAGE AllowAmbiguousTypes #-}
module Effectful.Labeled.State
(
State(..)
, runStateLocal
, evalStateLocal
, execStateLocal
, runStateShared
, evalStateShared
, execStateShared
, get
, gets
, put
, state
, modify
, stateM
, modifyM
) where
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Labeled
import Effectful.State.Dynamic (State(..))
import Effectful.State.Dynamic qualified as S
runStateLocal
:: forall label s es a
. HasCallStack
=> s
-> Eff (Labeled label (State s) : es) a
-> Eff es (a, s)
runStateLocal :: forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type])
a.
HasCallStack =>
s -> Eff (Labeled label (State s) : es) a -> Eff es (a, s)
runStateLocal = forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
runLabeled @label ((Eff (State s : es) a -> Eff es (a, s))
-> Eff (Labeled label (State s) : es) a -> Eff es (a, s))
-> (s -> Eff (State s : es) a -> Eff es (a, s))
-> s
-> Eff (Labeled label (State s) : es) a
-> Eff es (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Eff (State s : es) a -> Eff es (a, s)
forall s (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es (a, s)
S.runStateLocal
evalStateLocal
:: forall label s es a
. HasCallStack
=> s
-> Eff (Labeled label (State s) : es) a
-> Eff es a
evalStateLocal :: forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type])
a.
HasCallStack =>
s -> Eff (Labeled label (State s) : es) a -> Eff es a
evalStateLocal = forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
runLabeled @label ((Eff (State s : es) a -> Eff es a)
-> Eff (Labeled label (State s) : es) a -> Eff es a)
-> (s -> Eff (State s : es) a -> Eff es a)
-> s
-> Eff (Labeled label (State s) : es) a
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Eff (State s : es) a -> Eff es a
forall s (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es a
S.evalStateLocal
execStateLocal
:: forall label s es a
. HasCallStack
=> s
-> Eff (Labeled label (State s) : es) a
-> Eff es s
execStateLocal :: forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type])
a.
HasCallStack =>
s -> Eff (Labeled label (State s) : es) a -> Eff es s
execStateLocal = forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
runLabeled @label ((Eff (State s : es) a -> Eff es s)
-> Eff (Labeled label (State s) : es) a -> Eff es s)
-> (s -> Eff (State s : es) a -> Eff es s)
-> s
-> Eff (Labeled label (State s) : es) a
-> Eff es s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Eff (State s : es) a -> Eff es s
forall s (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es s
S.execStateLocal
runStateShared
:: forall label s es a
. HasCallStack
=> s
-> Eff (Labeled label (State s) : es) a
-> Eff es (a, s)
runStateShared :: forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type])
a.
HasCallStack =>
s -> Eff (Labeled label (State s) : es) a -> Eff es (a, s)
runStateShared = forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
runLabeled @label ((Eff (State s : es) a -> Eff es (a, s))
-> Eff (Labeled label (State s) : es) a -> Eff es (a, s))
-> (s -> Eff (State s : es) a -> Eff es (a, s))
-> s
-> Eff (Labeled label (State s) : es) a
-> Eff es (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Eff (State s : es) a -> Eff es (a, s)
forall s (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es (a, s)
S.runStateShared
evalStateShared
:: forall label s es a
. HasCallStack
=> s
-> Eff (Labeled label (State s) : es) a
-> Eff es a
evalStateShared :: forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type])
a.
HasCallStack =>
s -> Eff (Labeled label (State s) : es) a -> Eff es a
evalStateShared = forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
runLabeled @label ((Eff (State s : es) a -> Eff es a)
-> Eff (Labeled label (State s) : es) a -> Eff es a)
-> (s -> Eff (State s : es) a -> Eff es a)
-> s
-> Eff (Labeled label (State s) : es) a
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Eff (State s : es) a -> Eff es a
forall s (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es a
S.evalStateShared
execStateShared
:: forall label s es a
. HasCallStack
=> s
-> Eff (Labeled label (State s) : es) a
-> Eff es s
execStateShared :: forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type])
a.
HasCallStack =>
s -> Eff (Labeled label (State s) : es) a -> Eff es s
execStateShared = forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
runLabeled @label ((Eff (State s : es) a -> Eff es s)
-> Eff (Labeled label (State s) : es) a -> Eff es s)
-> (s -> Eff (State s : es) a -> Eff es s)
-> s
-> Eff (Labeled label (State s) : es) a
-> Eff es s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Eff (State s : es) a -> Eff es s
forall s (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es s
S.execStateShared
get
:: forall label s es
. (HasCallStack, Labeled label (State s) :> es)
=> Eff es s
get :: forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Labeled label (State s) :> es) =>
Eff es s
get = Labeled label (State s) (Eff es) s -> Eff es s
forall (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Labeled label (State s) (Eff es) s -> Eff es s)
-> Labeled label (State s) (Eff es) s -> Eff es s
forall a b. (a -> b) -> a -> b
$ forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(a :: Type -> Type) b.
e a b -> Labeled label e a b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(a :: Type -> Type) b.
e a b -> Labeled label e a b
Labeled @label State s (Eff es) s
forall s (a :: Type -> Type). State s a s
Get
gets
:: forall label s es a
. (HasCallStack, Labeled label (State s) :> es)
=> (s -> a)
-> Eff es a
gets :: forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (State s) :> es) =>
(s -> a) -> Eff es a
gets s -> a
f = s -> a
f (s -> a) -> Eff es s -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (label :: k) s (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Labeled label (State s) :> es) =>
Eff es s
forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Labeled label (State s) :> es) =>
Eff es s
get @label
put
:: forall label s es
. (HasCallStack, Labeled label (State s) :> es)
=> s
-> Eff es ()
put :: forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Labeled label (State s) :> es) =>
s -> Eff es ()
put = Labeled label (State s) (Eff es) () -> Eff es ()
forall (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Labeled label (State s) (Eff es) () -> Eff es ())
-> (s -> Labeled label (State s) (Eff es) ()) -> s -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(a :: Type -> Type) b.
e a b -> Labeled label e a b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(a :: Type -> Type) b.
e a b -> Labeled label e a b
Labeled @label (State s (Eff es) () -> Labeled label (State s) (Eff es) ())
-> (s -> State s (Eff es) ())
-> s
-> Labeled label (State s) (Eff es) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> State s (Eff es) ()
forall s (a :: Type -> Type). s -> State s a ()
Put
state
:: forall label s es a
. (HasCallStack, Labeled label (State s) :> es)
=> (s -> (a, s))
-> Eff es a
state :: forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (State s) :> es) =>
(s -> (a, s)) -> Eff es a
state = Labeled label (State s) (Eff es) a -> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Labeled label (State s) (Eff es) a -> Eff es a)
-> ((s -> (a, s)) -> Labeled label (State s) (Eff es) a)
-> (s -> (a, s))
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(a :: Type -> Type) b.
e a b -> Labeled label e a b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(a :: Type -> Type) b.
e a b -> Labeled label e a b
Labeled @label (State s (Eff es) a -> Labeled label (State s) (Eff es) a)
-> ((s -> (a, s)) -> State s (Eff es) a)
-> (s -> (a, s))
-> Labeled label (State s) (Eff es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> State s (Eff es) a
forall s b (a :: Type -> Type). (s -> (b, s)) -> State s a b
State
modify
:: forall label s es
. (HasCallStack, Labeled label (State s) :> es)
=> (s -> s)
-> Eff es ()
modify :: forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Labeled label (State s) :> es) =>
(s -> s) -> Eff es ()
modify s -> s
f = forall (label :: k) s (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Labeled label (State s) :> es) =>
(s -> (a, s)) -> Eff es a
forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (State s) :> es) =>
(s -> (a, s)) -> Eff es a
state @label (\s
s -> ((), s -> s
f s
s))
stateM
:: forall label s es a
. (HasCallStack, Labeled label (State s) :> es)
=> (s -> Eff es (a, s))
-> Eff es a
stateM :: forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (State s) :> es) =>
(s -> Eff es (a, s)) -> Eff es a
stateM = Labeled label (State s) (Eff es) a -> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Labeled label (State s) (Eff es) a -> Eff es a)
-> ((s -> Eff es (a, s)) -> Labeled label (State s) (Eff es) a)
-> (s -> Eff es (a, s))
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(a :: Type -> Type) b.
e a b -> Labeled label e a b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(a :: Type -> Type) b.
e a b -> Labeled label e a b
Labeled @label (State s (Eff es) a -> Labeled label (State s) (Eff es) a)
-> ((s -> Eff es (a, s)) -> State s (Eff es) a)
-> (s -> Eff es (a, s))
-> Labeled label (State s) (Eff es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> Eff es (a, s)) -> State s (Eff es) a
forall s (a :: Type -> Type) b. (s -> a (b, s)) -> State s a b
StateM
modifyM
:: forall label s es
. (HasCallStack, Labeled label (State s) :> es)
=> (s -> Eff es s)
-> Eff es ()
modifyM :: forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Labeled label (State s) :> es) =>
(s -> Eff es s) -> Eff es ()
modifyM s -> Eff es s
f = forall (label :: k) s (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Labeled label (State s) :> es) =>
(s -> Eff es (a, s)) -> Eff es a
forall {k} (label :: k) s (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (State s) :> es) =>
(s -> Eff es (a, s)) -> Eff es a
stateM @label (\s
s -> ((), ) (s -> ((), s)) -> Eff es s -> Eff es ((), s)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Eff es s
f s
s)