-- |A state effect that allows atomic updates with monadic actions.
module Ribosome.Host.Effect.MState where

import Conc (PScoped, pscoped)

-- |A state effect that allows atomic updates with monadic actions.
--
-- The constructor 'muse' is analogous to the usual @state@ combinator, in that it transforms the state monadically
-- alongside a return value, but unlike 'State' and 'AtomicState', the callback may be a 'Sem'.
--
-- This is accomplished by locking every call with an 'MVar'.
--
-- For read-only access to the state that doesn't care about currently running updates, the constructor 'mread' directly
-- returns the state without consulting the lock.
data MState s :: Effect where
  -- |Run a monadic action on the state in a mutually exclusive fashion that additionally returns a value.
  Use :: (s -> m (s, a)) -> MState s m a
  -- |Obtain the current state.
  Read :: MState s m s

-- |Run a monadic action on the state in a mutually exclusive fashion that additionally returns a value.
muse ::
  Member (MState s) r =>
  (s -> Sem r (s, a)) ->
  Sem r a
muse :: forall s (r :: EffectRow) a.
Member (MState s) r =>
(s -> Sem r (s, a)) -> Sem r a
muse =
  MState s (Sem r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send (MState s (Sem r) a -> Sem r a)
-> ((s -> Sem r (s, a)) -> MState s (Sem r) a)
-> (s -> Sem r (s, a))
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> Sem r (s, a)) -> MState s (Sem r) a
forall s (m :: * -> *) a. (s -> m (s, a)) -> MState s m a
Use

-- |Run a monadic action on the state in a mutually exclusive fashion.
mtrans ::
  Member (MState s) r =>
  (s -> Sem r s) ->
  Sem r ()
mtrans :: forall s (r :: EffectRow).
Member (MState s) r =>
(s -> Sem r s) -> Sem r ()
mtrans s -> Sem r s
f =
  (s -> Sem r (s, ())) -> Sem r ()
forall s (r :: EffectRow) a.
Member (MState s) r =>
(s -> Sem r (s, a)) -> Sem r a
muse ((s -> (s, ())) -> Sem r s -> Sem r (s, ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,()) (Sem r s -> Sem r (s, ())) -> (s -> Sem r s) -> s -> Sem r (s, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Sem r s
f)

-- |Apply a pure function to the state that additionally returns a value.
mstate ::
  Member (MState s) r =>
  (s -> (s, a)) ->
  Sem r a
mstate :: forall s (r :: EffectRow) a.
Member (MState s) r =>
(s -> (s, a)) -> Sem r a
mstate s -> (s, a)
f =
  (s -> Sem r (s, a)) -> Sem r a
forall s (r :: EffectRow) a.
Member (MState s) r =>
(s -> Sem r (s, a)) -> Sem r a
muse ((s, a) -> Sem r (s, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((s, a) -> Sem r (s, a)) -> (s -> (s, a)) -> s -> Sem r (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> (s, a)
f)

-- |Apply a pure function to the state.
mmodify ::
  Member (MState s) r =>
  (s -> s) ->
  Sem r ()
mmodify :: forall s (r :: EffectRow).
Member (MState s) r =>
(s -> s) -> Sem r ()
mmodify s -> s
f =
  (s -> Sem r s) -> Sem r ()
forall s (r :: EffectRow).
Member (MState s) r =>
(s -> Sem r s) -> Sem r ()
mtrans (s -> Sem r s
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s -> Sem r s) -> (s -> s) -> s -> Sem r s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
f)

-- |Replace the state.
mput ::
  Member (MState s) r =>
  s ->
  Sem r ()
mput :: forall s (r :: EffectRow). Member (MState s) r => s -> Sem r ()
mput s
s =
  (s -> s) -> Sem r ()
forall s (r :: EffectRow).
Member (MState s) r =>
(s -> s) -> Sem r ()
mmodify (s -> s -> s
forall a b. a -> b -> a
const s
s)

-- |Obtain the current state.
mread ::
  Member (MState s) r =>
  Sem r s
mread :: forall s (r :: EffectRow). Member (MState s) r => Sem r s
mread =
  MState s (Sem r) s -> Sem r s
forall (e :: Effect) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send MState s (Sem r) s
forall s (m :: * -> *). MState s m s
Read

-- |Obtain the current state, transformed by a pure function.
mreads ::
  Member (MState s) r =>
  (s -> a) ->
  Sem r a
mreads :: forall s (r :: EffectRow) a.
Member (MState s) r =>
(s -> a) -> Sem r a
mreads s -> a
f =
  s -> a
f (s -> a) -> Sem r s -> Sem r a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r s
forall s (r :: EffectRow). Member (MState s) r => Sem r s
mread

-- |Interpret 'State' in terms of 'MState'.
stateToMState ::
  Member (MState s) r =>
  InterpreterFor (State s) r
stateToMState :: forall s (r :: EffectRow).
Member (MState s) r =>
InterpreterFor (State s) r
stateToMState Sem (State s : r) a
sem =
  (s -> Sem r (s, a)) -> Sem r a
forall s (r :: EffectRow) a.
Member (MState s) r =>
(s -> Sem r (s, a)) -> Sem r a
muse \ s
s ->
    s -> Sem (State s : r) a -> Sem r (s, a)
forall s (r :: EffectRow) a.
s -> Sem (State s : r) a -> Sem r (s, a)
runState s
s Sem (State s : r) a
sem

-- |A 'PScoped' alias for 'MState' that allows running it on a local region without having to involve `IO` in the stack.
type ScopedMState s =
  PScoped s () (MState s)

-- |Run a 'PScoped' 'MState' on a local region without having to involve `IO` in the stack.
withMState ::
  Member (ScopedMState s) r =>
  s ->
  InterpreterFor (MState s) r
withMState :: forall s (r :: EffectRow).
Member (ScopedMState s) r =>
s -> InterpreterFor (MState s) r
withMState =
  s -> InterpreterFor (MState s) r
forall param resource (effect :: Effect) (r :: EffectRow).
Member (PScoped param resource effect) r =>
param -> InterpreterFor effect r
pscoped