-- | The 'State' as an effect with dynamic dispatch.
--
-- It's not clear in which situation it's beneficial to use this instead of
-- "Effective.State" or "Effective.State.MVar" as you either:
--
-- - Share state between threads and need the synchonized version.
--
-- - Don't share state between threads and are free to use the faster, pure
--   version.
--
-- However, let's include this for now.
--
module Effectful.State.Dynamic
  ( State

  -- * Pure
  , runState
  , evalState
  , execState

  -- * MVar
  , runStateMVar
  , evalStateMVar
  , execStateMVar

  -- * Operations
  , get
  , put
  , state
  , modify
  , stateM
  , modifyM
  ) where

import Control.Concurrent.MVar

import Effectful.Internal.Has
import Effectful.Internal.Monad

-- | Provide access to a mutable state of type @s@.
--
-- Whether the state is represented as a pure value or an 'MVar' depends on the
-- interpretation.
data State s = forall ref. State
  { ()
_ref     :: ref
  , ()
_get     :: forall es.   ref -> Eff es s
  , ()
_put     :: forall es.   ref -> s -> Eff es ref
  , ()
_state   :: forall es a. ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
  }

----------------------------------------
-- Pure

runState :: s -> Eff (State s : es) a -> Eff es (a, s)
runState :: s -> Eff (State s : es) a -> Eff es (a, s)
runState s
s Eff (State s : es) a
m = State s -> Eff (State s : es) (a, s) -> Eff es (a, s)
forall e (es :: [*]) a. e -> Eff (e : es) a -> Eff es a
evalEffect (s -> State s
forall s. s -> State s
statePure s
s) (Eff (State s : es) (a, s) -> Eff es (a, s))
-> Eff (State s : es) (a, s) -> Eff es (a, s)
forall a b. (a -> b) -> a -> b
$ (,) (a -> s -> (a, s))
-> Eff (State s : es) a -> Eff (State s : es) (s -> (a, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff (State s : es) a
m Eff (State s : es) (s -> (a, s))
-> Eff (State s : es) s -> Eff (State s : es) (a, s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eff (State s : es) s
forall s (es :: [*]). (State s :> es) => Eff es s
get

evalState :: s -> Eff (State s : es) a -> Eff es a
evalState :: s -> Eff (State s : es) a -> Eff es a
evalState s
s = State s -> Eff (State s : es) a -> Eff es a
forall e (es :: [*]) a. e -> Eff (e : es) a -> Eff es a
evalEffect (s -> State s
forall s. s -> State s
statePure s
s)

execState :: s -> Eff (State s : es) a -> Eff es s
execState :: s -> Eff (State s : es) a -> Eff es s
execState s
s Eff (State s : es) a
m = State s -> Eff (State s : es) s -> Eff es s
forall e (es :: [*]) a. e -> Eff (e : es) a -> Eff es a
evalEffect (s -> State s
forall s. s -> State s
statePure s
s) (Eff (State s : es) s -> Eff es s)
-> Eff (State s : es) s -> Eff es s
forall a b. (a -> b) -> a -> b
$ Eff (State s : es) a
m Eff (State s : es) a
-> Eff (State s : es) s -> Eff (State s : es) s
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Eff (State s : es) s
forall s (es :: [*]). (State s :> es) => Eff es s
get

statePure :: s -> State s
statePure :: s -> State s
statePure s
s0 = State :: forall s ref.
ref
-> (forall (es :: [*]). ref -> Eff es s)
-> (forall (es :: [*]). ref -> s -> Eff es ref)
-> (forall (es :: [*]) a.
    ref -> (s -> Eff es (a, s)) -> Eff es (a, ref))
-> State s
State
  { _ref :: s
_ref     = s
s0
  , _get :: forall (es :: [*]). s -> Eff es s
_get     = forall (es :: [*]). s -> Eff es s
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  , _put :: forall (es :: [*]). s -> s -> Eff es s
_put     = \s
_ -> s -> Eff es s
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  , _state :: forall (es :: [*]) a. s -> (s -> Eff es (a, s)) -> Eff es (a, s)
_state   = \s
s s -> Eff es (a, s)
f -> s -> Eff es (a, s)
f s
s
  }

----------------------------------------
-- MVar

runStateMVar :: s -> Eff (State s : es) a -> Eff es (a, s)
runStateMVar :: s -> Eff (State s : es) a -> Eff es (a, s)
runStateMVar s
s Eff (State s : es) a
m = do
  MVar s
v <- IO (MVar s) -> Eff es (MVar s)
forall a (es :: [*]). IO a -> Eff es a
impureEff_ (IO (MVar s) -> Eff es (MVar s)) -> IO (MVar s) -> Eff es (MVar s)
forall a b. (a -> b) -> a -> b
$ s -> IO (MVar s)
forall a. a -> IO (MVar a)
newMVar s
s
  State s -> Eff (State s : es) (a, s) -> Eff es (a, s)
forall e (es :: [*]) a. e -> Eff (e : es) a -> Eff es a
evalEffect (MVar s -> State s
forall s. MVar s -> State s
stateMVar MVar s
v) (Eff (State s : es) (a, s) -> Eff es (a, s))
-> Eff (State s : es) (a, s) -> Eff es (a, s)
forall a b. (a -> b) -> a -> b
$ (,) (a -> s -> (a, s))
-> Eff (State s : es) a -> Eff (State s : es) (s -> (a, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff (State s : es) a
m Eff (State s : es) (s -> (a, s))
-> Eff (State s : es) s -> Eff (State s : es) (a, s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eff (State s : es) s
forall s (es :: [*]). (State s :> es) => Eff es s
get

evalStateMVar :: s -> Eff (State s : es) a -> Eff es a
evalStateMVar :: s -> Eff (State s : es) a -> Eff es a
evalStateMVar s
s Eff (State s : es) a
m = do
  MVar s
v <- IO (MVar s) -> Eff es (MVar s)
forall a (es :: [*]). IO a -> Eff es a
impureEff_ (IO (MVar s) -> Eff es (MVar s)) -> IO (MVar s) -> Eff es (MVar s)
forall a b. (a -> b) -> a -> b
$ s -> IO (MVar s)
forall a. a -> IO (MVar a)
newMVar s
s
  State s -> Eff (State s : es) a -> Eff es a
forall e (es :: [*]) a. e -> Eff (e : es) a -> Eff es a
evalEffect (MVar s -> State s
forall s. MVar s -> State s
stateMVar MVar s
v) Eff (State s : es) a
m

execStateMVar :: s -> Eff (State s : es) a -> Eff es s
execStateMVar :: s -> Eff (State s : es) a -> Eff es s
execStateMVar s
s Eff (State s : es) a
m = do
  MVar s
v <- IO (MVar s) -> Eff es (MVar s)
forall a (es :: [*]). IO a -> Eff es a
impureEff_ (IO (MVar s) -> Eff es (MVar s)) -> IO (MVar s) -> Eff es (MVar s)
forall a b. (a -> b) -> a -> b
$ s -> IO (MVar s)
forall a. a -> IO (MVar a)
newMVar s
s
  State s -> Eff (State s : es) s -> Eff es s
forall e (es :: [*]) a. e -> Eff (e : es) a -> Eff es a
evalEffect (MVar s -> State s
forall s. MVar s -> State s
stateMVar MVar s
v) (Eff (State s : es) s -> Eff es s)
-> Eff (State s : es) s -> Eff es s
forall a b. (a -> b) -> a -> b
$ Eff (State s : es) a
m Eff (State s : es) a
-> Eff (State s : es) s -> Eff (State s : es) s
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Eff (State s : es) s
forall s (es :: [*]). (State s :> es) => Eff es s
get

stateMVar :: MVar s -> State s
stateMVar :: MVar s -> State s
stateMVar MVar s
v0 = State :: forall s ref.
ref
-> (forall (es :: [*]). ref -> Eff es s)
-> (forall (es :: [*]). ref -> s -> Eff es ref)
-> (forall (es :: [*]) a.
    ref -> (s -> Eff es (a, s)) -> Eff es (a, ref))
-> State s
State
  { _ref :: MVar s
_ref     = MVar s
v0
  , _get :: forall (es :: [*]). MVar s -> Eff es s
_get     = IO s -> Eff es s
forall a (es :: [*]). IO a -> Eff es a
impureEff_ (IO s -> Eff es s) -> (MVar s -> IO s) -> MVar s -> Eff es s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar s -> IO s
forall a. MVar a -> IO a
readMVar
  , _put :: forall (es :: [*]). MVar s -> s -> Eff es (MVar s)
_put     = \MVar s
v s
s -> IO (MVar s) -> Eff es (MVar s)
forall a (es :: [*]). IO a -> Eff es a
impureEff_ (IO (MVar s) -> Eff es (MVar s))
-> ((s -> IO (s, MVar s)) -> IO (MVar s))
-> (s -> IO (s, MVar s))
-> Eff es (MVar s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar s -> (s -> IO (s, MVar s)) -> IO (MVar s)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar s
v ((s -> IO (s, MVar s)) -> Eff es (MVar s))
-> (s -> IO (s, MVar s)) -> Eff es (MVar s)
forall a b. (a -> b) -> a -> b
$ \s
_ ->
      s
s s -> IO (s, MVar s) -> IO (s, MVar s)
`seq` (s, MVar s) -> IO (s, MVar s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
s, MVar s
v)
  , _state :: forall (es :: [*]) a.
MVar s -> (s -> Eff es (a, s)) -> Eff es (a, MVar s)
_state   = \MVar s
v s -> Eff es (a, s)
f -> (Env es -> IO (a, MVar s)) -> Eff es (a, MVar s)
forall (es :: [*]) a. (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO (a, MVar s)) -> Eff es (a, MVar s))
-> (Env es -> IO (a, MVar s)) -> Eff es (a, MVar s)
forall a b. (a -> b) -> a -> b
$ \Env es
es -> MVar s -> (s -> IO (s, (a, MVar s))) -> IO (a, MVar s)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar s
v ((s -> IO (s, (a, MVar s))) -> IO (a, MVar s))
-> (s -> IO (s, (a, MVar s))) -> IO (a, MVar s)
forall a b. (a -> b) -> a -> b
$ \s
s0 -> do
      (a
a, s
s) <- Eff es (a, s) -> Env es -> IO (a, s)
forall (es :: [*]) a. Eff es a -> Env es -> IO a
unEff (s -> Eff es (a, s)
f s
s0) Env es
es
      s
s s -> IO (s, (a, MVar s)) -> IO (s, (a, MVar s))
`seq` (s, (a, MVar s)) -> IO (s, (a, MVar s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
s, (a
a, MVar s
v))
  }

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

get :: State s :> es => Eff es s
get :: Eff es s
get = (State s -> Eff es s) -> Eff es s
forall e (es :: [*]) a. (e :> es) => (e -> Eff es a) -> Eff es a
readerEffectM ((State s -> Eff es s) -> Eff es s)
-> (State s -> Eff es s) -> Eff es s
forall a b. (a -> b) -> a -> b
$ \State{ref
forall (es :: [*]). ref -> Eff es s
forall (es :: [*]). ref -> s -> Eff es ref
forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_state :: forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_put :: forall (es :: [*]). ref -> s -> Eff es ref
_get :: forall (es :: [*]). ref -> Eff es s
_ref :: ref
_state :: ()
_put :: ()
_get :: ()
_ref :: ()
..} -> ref -> Eff es s
forall (es :: [*]). ref -> Eff es s
_get ref
_ref

put :: State s :> es => s -> Eff es ()
put :: s -> Eff es ()
put s
s = (State s -> Eff es ((), State s)) -> Eff es ()
forall e (es :: [*]) a.
(e :> es) =>
(e -> Eff es (a, e)) -> Eff es a
stateEffectM ((State s -> Eff es ((), State s)) -> Eff es ())
-> (State s -> Eff es ((), State s)) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ \State{ref
forall (es :: [*]). ref -> Eff es s
forall (es :: [*]). ref -> s -> Eff es ref
forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_state :: forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_put :: forall (es :: [*]). ref -> s -> Eff es ref
_get :: forall (es :: [*]). ref -> Eff es s
_ref :: ref
_state :: ()
_put :: ()
_get :: ()
_ref :: ()
..} -> do
  ref
ref <- ref -> s -> Eff es ref
forall (es :: [*]). ref -> s -> Eff es ref
_put ref
_ref s
s
  ((), State s) -> Eff es ((), State s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), State :: forall s ref.
ref
-> (forall (es :: [*]). ref -> Eff es s)
-> (forall (es :: [*]). ref -> s -> Eff es ref)
-> (forall (es :: [*]) a.
    ref -> (s -> Eff es (a, s)) -> Eff es (a, ref))
-> State s
State { _ref :: ref
_ref = ref
ref, forall (es :: [*]). ref -> Eff es s
forall (es :: [*]). ref -> s -> Eff es ref
forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_state :: forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_put :: forall (es :: [*]). ref -> s -> Eff es ref
_get :: forall (es :: [*]). ref -> Eff es s
_state :: forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_put :: forall (es :: [*]). ref -> s -> Eff es ref
_get :: forall (es :: [*]). ref -> Eff es s
.. })

state :: State s :> es => (s -> (a, s)) -> Eff es a
state :: (s -> (a, s)) -> Eff es a
state s -> (a, s)
f = (State s -> Eff es (a, State s)) -> Eff es a
forall e (es :: [*]) a.
(e :> es) =>
(e -> Eff es (a, e)) -> Eff es a
stateEffectM ((State s -> Eff es (a, State s)) -> Eff es a)
-> (State s -> Eff es (a, State s)) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \State{ref
forall (es :: [*]). ref -> Eff es s
forall (es :: [*]). ref -> s -> Eff es ref
forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_state :: forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_put :: forall (es :: [*]). ref -> s -> Eff es ref
_get :: forall (es :: [*]). ref -> Eff es s
_ref :: ref
_state :: ()
_put :: ()
_get :: ()
_ref :: ()
..} -> do
  (a
a, ref
ref) <- ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_state ref
_ref ((s -> Eff es (a, s)) -> Eff es (a, ref))
-> (s -> Eff es (a, s)) -> Eff es (a, ref)
forall a b. (a -> b) -> a -> b
$ (a, s) -> Eff es (a, s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, s) -> Eff es (a, s)) -> (s -> (a, s)) -> s -> Eff es (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> (a, s)
f
  (a, State s) -> Eff es (a, State s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, State :: forall s ref.
ref
-> (forall (es :: [*]). ref -> Eff es s)
-> (forall (es :: [*]). ref -> s -> Eff es ref)
-> (forall (es :: [*]) a.
    ref -> (s -> Eff es (a, s)) -> Eff es (a, ref))
-> State s
State { _ref :: ref
_ref = ref
ref, forall (es :: [*]). ref -> Eff es s
forall (es :: [*]). ref -> s -> Eff es ref
forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_state :: forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_put :: forall (es :: [*]). ref -> s -> Eff es ref
_get :: forall (es :: [*]). ref -> Eff es s
_state :: forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_put :: forall (es :: [*]). ref -> s -> Eff es ref
_get :: forall (es :: [*]). ref -> Eff es s
.. })

modify :: State s :> es => (s -> s) -> Eff es ()
modify :: (s -> s) -> Eff es ()
modify s -> s
f = (s -> ((), s)) -> Eff es ()
forall s (es :: [*]) a.
(State s :> es) =>
(s -> (a, s)) -> Eff es a
state (\s
s -> ((), s -> s
f s
s))

stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a
stateM :: (s -> Eff es (a, s)) -> Eff es a
stateM s -> Eff es (a, s)
f = (State s -> Eff es (a, State s)) -> Eff es a
forall e (es :: [*]) a.
(e :> es) =>
(e -> Eff es (a, e)) -> Eff es a
stateEffectM ((State s -> Eff es (a, State s)) -> Eff es a)
-> (State s -> Eff es (a, State s)) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \State{ref
forall (es :: [*]). ref -> Eff es s
forall (es :: [*]). ref -> s -> Eff es ref
forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_state :: forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_put :: forall (es :: [*]). ref -> s -> Eff es ref
_get :: forall (es :: [*]). ref -> Eff es s
_ref :: ref
_state :: ()
_put :: ()
_get :: ()
_ref :: ()
..} -> do
  (a
a, ref
ref) <- ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_state ref
_ref s -> Eff es (a, s)
f
  (a, State s) -> Eff es (a, State s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, State :: forall s ref.
ref
-> (forall (es :: [*]). ref -> Eff es s)
-> (forall (es :: [*]). ref -> s -> Eff es ref)
-> (forall (es :: [*]) a.
    ref -> (s -> Eff es (a, s)) -> Eff es (a, ref))
-> State s
State { _ref :: ref
_ref = ref
ref, forall (es :: [*]). ref -> Eff es s
forall (es :: [*]). ref -> s -> Eff es ref
forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_state :: forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_put :: forall (es :: [*]). ref -> s -> Eff es ref
_get :: forall (es :: [*]). ref -> Eff es s
_state :: forall (es :: [*]) a.
ref -> (s -> Eff es (a, s)) -> Eff es (a, ref)
_put :: forall (es :: [*]). ref -> s -> Eff es ref
_get :: forall (es :: [*]). ref -> Eff es s
.. })

modifyM :: State s :> es => (s -> Eff es s) -> Eff es ()
modifyM :: (s -> Eff es s) -> Eff es ()
modifyM s -> Eff es s
f = (s -> Eff es ((), s)) -> Eff es ()
forall s (es :: [*]) a.
(State s :> es) =>
(s -> Eff es (a, s)) -> Eff es a
stateM (\s
s -> ((), ) (s -> ((), s)) -> Eff es s -> Eff es ((), s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Eff es s
f s
s)