-- | The 'State' as an effect.
--
-- Represented as an MVar underneath, therefore:
--
-- - slower than "Effective.State"
--
-- - suitable for sharing between multiple threads.
--
module Effectful.State.MVar
  ( State
  , runState
  , evalState
  , execState
  , get
  , put
  , state
  , modify
  , stateM
  , modifyM
  ) where

import Control.Concurrent.MVar

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

-- | Provide access to a synchronized, mutable state of type @s@.
newtype State s = State (MVar s)

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 = 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
State 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

evalState :: s -> Eff (State s : es) a -> Eff es a
evalState :: s -> Eff (State s : es) a -> Eff es a
evalState 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
State MVar s
v) Eff (State s : es) a
m

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 = 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
State 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

get :: State s :> es => Eff es s
get :: Eff es s
get = do
  State MVar s
v <- Eff es (State s)
forall e (es :: [*]). (e :> es) => Eff es e
getEffect
  IO s -> Eff es s
forall a (es :: [*]). IO a -> Eff es a
impureEff_ (IO s -> Eff es s) -> IO s -> Eff es s
forall a b. (a -> b) -> a -> b
$ MVar s -> IO s
forall a. MVar a -> IO a
readMVar MVar s
v

put :: State s :> es => s -> Eff es ()
put :: s -> Eff es ()
put s
s = do
  State MVar s
v <- Eff es (State s)
forall e (es :: [*]). (e :> es) => Eff es e
getEffect
  IO () -> Eff es ()
forall a (es :: [*]). IO a -> Eff es a
impureEff_ (IO () -> Eff es ())
-> ((s -> IO s) -> IO ()) -> (s -> IO s) -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar s -> (s -> IO s) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar s
v ((s -> IO s) -> Eff es ()) -> (s -> IO s) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ \s
_ -> s
s s -> IO s -> IO s
`seq` s -> IO s
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s

state :: State s :> es => (s -> (a, s)) -> Eff es a
state :: (s -> (a, s)) -> Eff es a
state s -> (a, s)
f = do
  State MVar s
v <- Eff es (State s)
forall e (es :: [*]). (e :> es) => Eff es e
getEffect
  IO a -> Eff es a
forall a (es :: [*]). IO a -> Eff es a
impureEff_ (IO a -> Eff es a)
-> ((s -> IO (s, a)) -> IO a) -> (s -> IO (s, a)) -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar s -> (s -> IO (s, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar s
v ((s -> IO (s, a)) -> Eff es a) -> (s -> IO (s, a)) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \s
s0 -> let (a
a, s
s) = s -> (a, s)
f s
s0 in s
s s -> IO (s, a) -> IO (s, a)
`seq` (s, a) -> IO (s, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
s, a
a)

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 = do
  State MVar s
v <- Eff es (State s)
forall e (es :: [*]). (e :> es) => Eff es e
getEffect
  (Env es -> IO a) -> Eff es a
forall (es :: [*]) a. (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> MVar s -> (s -> IO (s, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar s
v ((s -> IO (s, a)) -> IO a) -> (s -> IO (s, a)) -> IO a
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) -> IO (s, a)
`seq` (s, a) -> IO (s, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
s, a
a)

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)