{-# LANGUAGE AllowAmbiguousTypes #-}
-- | Convenience functions for the 'Labeled' 'State' effect.
--
-- @since 2.4.0.0
module Effectful.Labeled.State
  ( -- * Effect
    State(..)

    -- ** Handlers

    -- *** Local
  , runStateLocal
  , evalStateLocal
  , execStateLocal

    -- *** Shared
  , runStateShared
  , evalStateShared
  , execStateShared

    -- ** Operations
  , 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

----------------------------------------
-- Local

-- | Run the 'State' effect with the given initial state and return the final
-- value along with the final state (via "Effectful.State.Static.Local").
runStateLocal
  :: forall label s es a
   . HasCallStack
  => s
   -- ^ The initial state.
  -> 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

-- | Run the 'State' effect with the given initial state and return the final
-- value, discarding the final state (via "Effectful.State.Static.Local").
evalStateLocal
  :: forall label s es a
   . HasCallStack
  => s
   -- ^ The initial state.
  -> 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

-- | Run the 'State' effect with the given initial state and return the final
-- state, discarding the final value (via "Effectful.State.Static.Local").
execStateLocal
  :: forall label s es a
   . HasCallStack
  => s
   -- ^ The initial state.
  -> 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

----------------------------------------
-- Shared

-- | Run the 'State' effect with the given initial state and return the final
-- value along with the final state (via "Effectful.State.Static.Shared").
runStateShared
  :: forall label s es a
   . HasCallStack
  => s
   -- ^ The initial state.
  -> 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

-- | Run the 'State' effect with the given initial state and return the final
-- value, discarding the final state (via "Effectful.State.Static.Shared").
evalStateShared
  :: forall label s es a
   . HasCallStack
  => s
   -- ^ The initial state.
  -> 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

-- | Run the 'State' effect with the given initial state and return the final
-- state, discarding the final value (via "Effectful.State.Static.Shared").
execStateShared
  :: forall label s es a
   . HasCallStack
  => s
   -- ^ The initial state.
  -> 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

----------------------------------------
-- Operations

-- | Fetch the current value of the state.
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

-- | Get a function of the current state.
--
-- @'gets' f ≡ f '<$>' '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

-- | Set the current state to the given value.
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

-- | Apply the function to the current state and return a value.
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

-- | Apply the function to the current state.
--
-- @'modify' f ≡ 'state' (\\s -> ((), f s))@
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))

-- | Apply the monadic function to the current state and return a value.
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

-- | Apply the monadic function to the current state.
--
-- @'modifyM' f ≡ 'stateM' (\\s -> ((), ) '<$>' f s)@
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)