-- |Interpreters for 'MState'.
module Ribosome.Host.Interpreter.MState where

import Conc (Lock, interpretAtomic, interpretLockReentrant, interpretPScopedWithH, lock)
import Polysemy.Internal.Tactics (liftT)

import qualified Ribosome.Host.Effect.MState as MState
import Ribosome.Host.Effect.MState (MState, ScopedMState)

-- |Interpret 'MState' using 'AtomicState' and 'Lock'.
interpretMState ::
  Members [Resource, Race, Mask mres, Embed IO] r =>
  s ->
  InterpreterFor (MState s) r
interpretMState :: forall mres (r :: EffectRow) s.
Members '[Resource, Race, Mask mres, Embed IO] r =>
s -> InterpreterFor (MState s) r
interpretMState s
initial =
  Sem (Lock : r) a -> Sem r a
forall mres (r :: EffectRow).
Members '[Resource, Race, Mask mres, Embed IO] r =>
InterpreterFor Lock r
interpretLockReentrant (Sem (Lock : r) a -> Sem r a)
-> (Sem (MState s : r) a -> Sem (Lock : r) a)
-> Sem (MState s : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  s -> InterpreterFor (AtomicState s) (Lock : r)
forall a (r :: EffectRow).
Member (Embed IO) r =>
a -> InterpreterFor (AtomicState a) r
interpretAtomic s
initial (Sem (AtomicState s : Lock : r) a -> Sem (Lock : r) a)
-> (Sem (MState s : r) a -> Sem (AtomicState s : Lock : r) a)
-> Sem (MState s : r) a
-> Sem (Lock : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall (rInitial :: EffectRow) x.
 MState s (Sem rInitial) x
 -> Tactical (MState s) (Sem rInitial) (AtomicState s : Lock : r) x)
-> Sem (MState s : r) a -> Sem (AtomicState s : Lock : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (e3 :: (* -> *) -> * -> *) (r :: EffectRow) a.
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : e3 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : r) a
reinterpret2H \case
    MState.Use s -> Sem rInitial (s, x)
f ->
      Sem
  (WithTactics
     (MState s) f (Sem rInitial) (AtomicState s : Lock : r))
  (f x)
-> Sem
     (WithTactics
        (MState s) f (Sem rInitial) (AtomicState s : Lock : r))
     (f x)
forall (r :: EffectRow) a. Member Lock r => Sem r a -> Sem r a
lock do
        s
s0 <- Sem
  (WithTactics
     (MState s) f (Sem rInitial) (AtomicState s : Lock : r))
  s
forall s (r :: EffectRow). Member (AtomicState s) r => Sem r s
atomicGet
        f (s, x)
res <- Sem rInitial (s, x)
-> Tactical
     (MState s) (Sem rInitial) (AtomicState s : Lock : r) (s, x)
forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (r :: EffectRow).
m a -> Tactical e m r a
runTSimple (s -> Sem rInitial (s, x)
f s
s0)
        Inspector forall x. f x -> Maybe x
ins <- Sem
  (WithTactics
     (MState s) f (Sem rInitial) (AtomicState s : Lock : r))
  (Inspector f)
forall (e :: (* -> *) -> * -> *) (f :: * -> *) (m :: * -> *)
       (r :: EffectRow).
Sem (WithTactics e f m r) (Inspector f)
getInspectorT
        Maybe (s, x)
-> ((s, x)
    -> Sem
         (WithTactics
            (MState s) f (Sem rInitial) (AtomicState s : Lock : r))
         ())
-> Sem
     (WithTactics
        (MState s) f (Sem rInitial) (AtomicState s : Lock : r))
     ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (f (s, x) -> Maybe (s, x)
forall x. f x -> Maybe x
ins f (s, x)
res) \ (s
s, x
_) -> s
-> Sem
     (WithTactics
        (MState s) f (Sem rInitial) (AtomicState s : Lock : r))
     ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
s -> Sem r ()
atomicPut s
s
        pure ((s, x) -> x
forall a b. (a, b) -> b
snd ((s, x) -> x) -> f (s, x) -> f x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (s, x)
res)
    MState s (Sem rInitial) x
MState.Read ->
      Sem (AtomicState s : Lock : r) x
-> Sem
     (WithTactics
        (MState s) f (Sem rInitial) (AtomicState s : Lock : r))
     (f x)
forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
       (e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT Sem (AtomicState s : Lock : r) x
forall s (r :: EffectRow). Member (AtomicState s) r => Sem r s
atomicGet

-- |Interpret 'MState' as 'State'.
evalMState ::
  s ->
  InterpreterFor (MState s) r
evalMState :: forall s (r :: EffectRow). s -> InterpreterFor (MState s) r
evalMState s
initial =
  s -> Sem (State s : r) a -> Sem r a
forall s (r :: EffectRow) a. s -> Sem (State s : r) a -> Sem r a
evalState s
initial (Sem (State s : r) a -> Sem r a)
-> (Sem (MState s : r) a -> Sem (State s : r) a)
-> Sem (MState s : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall (rInitial :: EffectRow) x.
 MState s (Sem rInitial) x
 -> Tactical (MState s) (Sem rInitial) (State s : r) x)
-> Sem (MState s : r) a -> Sem (State s : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpretH \case
    MState.Use s -> Sem rInitial (s, x)
f -> do
      s
s0 <- Sem (State s : r) s
-> Sem (WithTactics (MState s) f (Sem rInitial) (State s : r)) s
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise Sem (State s : r) s
forall s (r :: EffectRow). Member (State s) r => Sem r s
get
      f (s, x)
res <- Sem rInitial (s, x)
-> Tactical (MState s) (Sem rInitial) (State s : r) (s, x)
forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (r :: EffectRow).
m a -> Tactical e m r a
runTSimple (s -> Sem rInitial (s, x)
f s
s0)
      Inspector forall x. f x -> Maybe x
ins <- Sem
  (WithTactics (MState s) f (Sem rInitial) (State s : r))
  (Inspector f)
forall (e :: (* -> *) -> * -> *) (f :: * -> *) (m :: * -> *)
       (r :: EffectRow).
Sem (WithTactics e f m r) (Inspector f)
getInspectorT
      Maybe (s, x)
-> ((s, x)
    -> Sem (WithTactics (MState s) f (Sem rInitial) (State s : r)) ())
-> Sem (WithTactics (MState s) f (Sem rInitial) (State s : r)) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (f (s, x) -> Maybe (s, x)
forall x. f x -> Maybe x
ins f (s, x)
res) \ (s
s, x
_) -> s -> Sem (WithTactics (MState s) f (Sem rInitial) (State s : r)) ()
forall s (r :: EffectRow). Member (State s) r => s -> Sem r ()
put s
s
      pure ((s, x) -> x
forall a b. (a, b) -> b
snd ((s, x) -> x) -> f (s, x) -> f x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (s, x)
res)
    MState s (Sem rInitial) x
MState.Read ->
      Sem (State s : r) x
-> Sem
     (WithTactics (MState s) f (Sem rInitial) (State s : r)) (f x)
forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
       (e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT Sem (State s : r) x
forall s (r :: EffectRow). Member (State s) r => Sem r s
get

-- |Internal combinator that runs the dependencies of the scope for 'MState'.
scope ::
  Members [Mask mres, Resource, Race, Embed IO] r =>
  s ->
  (() ->
  Sem (AtomicState s : Lock : r) a) ->
  Sem r a
scope :: forall mres (r :: EffectRow) s a.
Members '[Mask mres, Resource, Race, Embed IO] r =>
s -> (() -> Sem (AtomicState s : Lock : r) a) -> Sem r a
scope s
initial () -> Sem (AtomicState s : Lock : r) a
use =
  Sem (Lock : r) a -> Sem r a
forall mres (r :: EffectRow).
Members '[Resource, Race, Mask mres, Embed IO] r =>
InterpreterFor Lock r
interpretLockReentrant (Sem (Lock : r) a -> Sem r a) -> Sem (Lock : r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$ s -> InterpreterFor (AtomicState s) (Lock : r)
forall a (r :: EffectRow).
Member (Embed IO) r =>
a -> InterpreterFor (AtomicState a) r
interpretAtomic s
initial (Sem (AtomicState s : Lock : r) a -> Sem (Lock : r) a)
-> Sem (AtomicState s : Lock : r) a -> Sem (Lock : r) a
forall a b. (a -> b) -> a -> b
$ () -> Sem (AtomicState s : Lock : r) a
use ()

-- |Interpret 'MState' as a scoped effect.
interpretMStates ::
  ∀ s mres r .
  Members [Mask mres, Resource, Race, Embed IO] r =>
  InterpreterFor (ScopedMState s) r
interpretMStates :: forall s mres (r :: EffectRow).
Members '[Mask mres, Resource, Race, Embed IO] r =>
InterpreterFor (ScopedMState s) r
interpretMStates =
  forall (extra :: EffectRow) param resource
       (effect :: (* -> *) -> * -> *) (r :: EffectRow) (r1 :: EffectRow).
(r1 ~ (extra ++ r),
 InsertAtIndex
   1
   '[PScoped param resource effect]
   r1
   r
   (PScoped param resource effect : r1)
   extra) =>
(forall x. param -> (resource -> Sem r1 x) -> Sem r x)
-> (forall (r0 :: EffectRow) x.
    resource -> effect (Sem r0) x -> Tactical effect (Sem r0) r1 x)
-> InterpreterFor (PScoped param resource effect) r
interpretPScopedWithH @[AtomicState s, Lock] forall x. s -> (() -> Sem (AtomicState s : Lock : r) x) -> Sem r x
forall mres (r :: EffectRow) s a.
Members '[Mask mres, Resource, Race, Embed IO] r =>
s -> (() -> Sem (AtomicState s : Lock : r) a) -> Sem r a
scope \ () -> \case
    MState.Use s -> Sem r0 (s, x)
f ->
      Sem
  (WithTactics (MState s) f (Sem r0) (AtomicState s : Lock : r))
  (f x)
-> Sem
     (WithTactics (MState s) f (Sem r0) (AtomicState s : Lock : r))
     (f x)
forall (r :: EffectRow) a. Member Lock r => Sem r a -> Sem r a
lock do
        s
s0 <- Sem
  (WithTactics (MState s) f (Sem r0) (AtomicState s : Lock : r)) s
forall s (r :: EffectRow). Member (AtomicState s) r => Sem r s
atomicGet
        f (s, x)
res <- Sem r0 (s, x)
-> Tactical (MState s) (Sem r0) (AtomicState s : Lock : r) (s, x)
forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (r :: EffectRow).
m a -> Tactical e m r a
runTSimple (s -> Sem r0 (s, x)
f s
s0)
        Inspector forall x. f x -> Maybe x
ins <- Sem
  (WithTactics (MState s) f (Sem r0) (AtomicState s : Lock : r))
  (Inspector f)
forall (e :: (* -> *) -> * -> *) (f :: * -> *) (m :: * -> *)
       (r :: EffectRow).
Sem (WithTactics e f m r) (Inspector f)
getInspectorT
        Maybe (s, x)
-> ((s, x)
    -> Sem
         (WithTactics (MState s) f (Sem r0) (AtomicState s : Lock : r)) ())
-> Sem
     (WithTactics (MState s) f (Sem r0) (AtomicState s : Lock : r)) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (f (s, x) -> Maybe (s, x)
forall x. f x -> Maybe x
ins f (s, x)
res) \ (s
s, x
_) -> s
-> Sem
     (WithTactics (MState s) f (Sem r0) (AtomicState s : Lock : r)) ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
s -> Sem r ()
atomicPut s
s
        pure ((s, x) -> x
forall a b. (a, b) -> b
snd ((s, x) -> x) -> f (s, x) -> f x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (s, x)
res)
    MState s (Sem r0) x
MState.Read ->
      Sem (AtomicState s : Lock : r) x
-> Sem
     (WithTactics (MState s) f (Sem r0) (AtomicState s : Lock : r))
     (f x)
forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
       (e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT Sem (AtomicState s : Lock : r) x
forall s (r :: EffectRow). Member (AtomicState s) r => Sem r s
atomicGet