{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DerivingStrategies, ExplicitForAll, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
module Control.Effect.State.Internal
( -- * State effect
  State(..)
, get
, gets
, put
, modify
, modifyLazy
  -- * Re-exports
, Member
) where

import Control.Effect.Carrier
import GHC.Generics (Generic1)
import Prelude hiding (fail)

data State s m k
  = Get (s -> m k)
  | Put s (m k)
  deriving stock (a -> State s m b -> State s m a
(a -> b) -> State s m a -> State s m b
(forall a b. (a -> b) -> State s m a -> State s m b)
-> (forall a b. a -> State s m b -> State s m a)
-> Functor (State s m)
forall a b. a -> State s m b -> State s m a
forall a b. (a -> b) -> State s m a -> State s m b
forall s (m :: * -> *) a b.
Functor m =>
a -> State s m b -> State s m a
forall s (m :: * -> *) a b.
Functor m =>
(a -> b) -> State s m a -> State s m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> State s m b -> State s m a
$c<$ :: forall s (m :: * -> *) a b.
Functor m =>
a -> State s m b -> State s m a
fmap :: (a -> b) -> State s m a -> State s m b
$cfmap :: forall s (m :: * -> *) a b.
Functor m =>
(a -> b) -> State s m a -> State s m b
Functor, (forall a. State s m a -> Rep1 (State s m) a)
-> (forall a. Rep1 (State s m) a -> State s m a)
-> Generic1 (State s m)
forall a. Rep1 (State s m) a -> State s m a
forall a. State s m a -> Rep1 (State s m) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
forall s (m :: * -> *) a. Rep1 (State s m) a -> State s m a
forall s (m :: * -> *) a. State s m a -> Rep1 (State s m) a
$cto1 :: forall s (m :: * -> *) a. Rep1 (State s m) a -> State s m a
$cfrom1 :: forall s (m :: * -> *) a. State s m a -> Rep1 (State s m) a
Generic1)
  deriving anyclass ((forall (f :: * -> *) a b.
 Functor (State s f) =>
 (a -> b) -> State s f a -> State s f b)
-> (forall (m :: * -> *) (n :: * -> *) a.
    Functor m =>
    (forall x. m x -> n x) -> State s m a -> State s n a)
-> HFunctor (State s)
forall s (f :: * -> *) a b.
Functor (State s f) =>
(a -> b) -> State s f a -> State s f b
forall s (m :: * -> *) (n :: * -> *) a.
Functor m =>
(forall x. m x -> n x) -> State s m a -> State s n a
forall (f :: * -> *) a b.
Functor (State s f) =>
(a -> b) -> State s f a -> State s f b
forall (m :: * -> *) (n :: * -> *) a.
Functor m =>
(forall x. m x -> n x) -> State s m a -> State s n a
forall (h :: (* -> *) -> * -> *).
(forall (f :: * -> *) a b.
 Functor (h f) =>
 (a -> b) -> h f a -> h f b)
-> (forall (m :: * -> *) (n :: * -> *) a.
    Functor m =>
    (forall x. m x -> n x) -> h m a -> h n a)
-> HFunctor h
hmap :: (forall x. m x -> n x) -> State s m a -> State s n a
$chmap :: forall s (m :: * -> *) (n :: * -> *) a.
Functor m =>
(forall x. m x -> n x) -> State s m a -> State s n a
fmap' :: (a -> b) -> State s f a -> State s f b
$cfmap' :: forall s (f :: * -> *) a b.
Functor (State s f) =>
(a -> b) -> State s f a -> State s f b
HFunctor, HFunctor (State s)
HFunctor (State s) =>
(forall (f :: * -> *) (m :: * -> *) (n :: * -> *) a.
 (Functor f, Monad m) =>
 f ()
 -> (forall x. f (m x) -> n (f x))
 -> State s m a
 -> State s n (f a))
-> Effect (State s)
forall s. HFunctor (State s)
forall s (f :: * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor f, Monad m) =>
f ()
-> (forall x. f (m x) -> n (f x)) -> State s m a -> State s n (f a)
forall (f :: * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor f, Monad m) =>
f ()
-> (forall x. f (m x) -> n (f x)) -> State s m a -> State s n (f a)
forall (sig :: (* -> *) -> * -> *).
HFunctor sig =>
(forall (f :: * -> *) (m :: * -> *) (n :: * -> *) a.
 (Functor f, Monad m) =>
 f () -> (forall x. f (m x) -> n (f x)) -> sig m a -> sig n (f a))
-> Effect sig
handle :: f ()
-> (forall x. f (m x) -> n (f x)) -> State s m a -> State s n (f a)
$chandle :: forall s (f :: * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor f, Monad m) =>
f ()
-> (forall x. f (m x) -> n (f x)) -> State s m a -> State s n (f a)
$cp1Effect :: forall s. HFunctor (State s)
Effect)

-- | Get the current state value.
--
--   prop> snd (run (runState a get)) === a
get :: (Member (State s) sig, Carrier sig m) => m s
get :: m s
get = State s m s -> m s
forall (effect :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(Member effect sig, Carrier sig m) =>
effect m a -> m a
send ((s -> m s) -> State s m s
forall s (m :: * -> *) k. (s -> m k) -> State s m k
Get s -> m s
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
{-# INLINEABLE get #-}

-- | Project a function out of the current state value.
--
--   prop> snd (run (runState a (gets (applyFun f)))) === applyFun f a
gets :: (Member (State s) sig, Carrier sig m) => (s -> a) -> m a
gets :: (s -> a) -> m a
gets f :: s -> a
f = State s m a -> m a
forall (effect :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(Member effect sig, Carrier sig m) =>
effect m a -> m a
send ((s -> m a) -> State s m a
forall s (m :: * -> *) k. (s -> m k) -> State s m k
Get (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> (s -> a) -> s -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a
f))
{-# INLINEABLE gets #-}

-- | Replace the state value with a new value.
--
--   prop> fst (run (runState a (put b))) === b
--   prop> snd (run (runState a (get <* put b))) === a
--   prop> snd (run (runState a (put b *> get))) === b
put :: (Member (State s) sig, Carrier sig m) => s -> m ()
put :: s -> m ()
put s :: s
s = State s m () -> m ()
forall (effect :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(Member effect sig, Carrier sig m) =>
effect m a -> m a
send (s -> m () -> State s m ()
forall s (m :: * -> *) k. s -> m k -> State s m k
Put s
s (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
{-# INLINEABLE put #-}

-- | Replace the state value with the result of applying a function to the current state value.
--   This is strict in the new state.
--
--   prop> fst (run (runState a (modify (+1)))) === (1 + a :: Integer)
modify :: (Member (State s) sig, Carrier sig m) => (s -> s) -> m ()
modify :: (s -> s) -> m ()
modify f :: s -> s
f = do
  s
a <- m s
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Member (State s) sig, Carrier sig m) =>
m s
get
  s -> m ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Member (State s) sig, Carrier sig m) =>
s -> m ()
put (s -> m ()) -> s -> m ()
forall a b. (a -> b) -> a -> b
$! s -> s
f s
a
{-# INLINEABLE modify #-}

-- | Replace the state value with the result of applying a function to the current state value.
--   This is lazy in the new state; injudicious use of this function may lead to space leaks.
modifyLazy :: (Member (State s) sig, Carrier sig m) => (s -> s) -> m ()
modifyLazy :: (s -> s) -> m ()
modifyLazy f :: s -> s
f = m s
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Member (State s) sig, Carrier sig m) =>
m s
get m s -> (s -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Member (State s) sig, Carrier sig m) =>
s -> m ()
put (s -> m ()) -> (s -> s) -> s -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
f
{-# INLINEABLE modifyLazy #-}

-- $setup
-- >>> :seti -XFlexibleContexts
-- >>> import Test.QuickCheck
-- >>> import Control.Effect.Pure
-- >>> import Control.Effect.State.Strict