-- |Gate interpreters, Internal
module Polysemy.Conc.Interpreter.Gate where

import Polysemy.Conc.Effect.Gate (Gate (Gate, Signal))
import Polysemy.Conc.Effect.Scoped (Scoped_)
import Polysemy.Conc.Interpreter.Scoped (interpretScopedAs)

-- |Interpret 'Gate' with an 'MVar'.
interpretGate ::
  ∀ r .
  Member (Embed IO) r =>
  InterpreterFor Gate r
interpretGate :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor Gate r
interpretGate Sem (Gate : r) a
sem = do
  MVar ()
mv <- IO (MVar ()) -> Sem r (MVar ())
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  MVar () -> InterpreterFor Gate r
int MVar ()
mv Sem (Gate : r) a
sem
  where
    int :: MVar () -> InterpreterFor Gate r
    int :: MVar () -> InterpreterFor Gate r
int MVar ()
mv =
      (forall (rInitial :: [(* -> *) -> * -> *]) x.
 Gate (Sem rInitial) x -> Sem r x)
-> Sem (Gate : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
        Gate (Sem rInitial) x
Signal ->
          Sem r Bool -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> Sem r Bool
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar () -> () -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar ()
mv ()))
        Gate (Sem rInitial) x
Gate ->
          IO () -> Sem r ()
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar () -> IO ()
forall a. MVar a -> IO a
readMVar MVar ()
mv)

-- |Interpret @'Scoped_' 'Gate'@ with an @'MVar' ()@.
interpretGates ::
  Member (Embed IO) r =>
  InterpreterFor (Scoped_ Gate) r
interpretGates :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor (Scoped_ Gate) r
interpretGates =
  forall resource param (effect :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
(param -> Sem r resource)
-> (forall (m :: * -> *) x. resource -> effect m x -> Sem r x)
-> InterpreterFor (Scoped param effect) r
interpretScopedAs @(MVar ()) (Sem r (MVar ()) -> () -> Sem r (MVar ())
forall a b. a -> b -> a
const (IO (MVar ()) -> Sem r (MVar ())
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar)) \ MVar ()
mv -> \case
    Gate m x
Signal ->
      Sem r Bool -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> Sem r Bool
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar () -> () -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar ()
mv ()))
    Gate m x
Gate ->
      IO () -> Sem r ()
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar () -> IO ()
forall a. MVar a -> IO a
readMVar MVar ()
mv)