-- |Description: Sync Interpreters
module Polysemy.Conc.Interpreter.Sync where

import Polysemy.Conc.Effect.Race (Race)
import qualified Polysemy.Conc.Effect.Sync as Sync
import Polysemy.Conc.Effect.Sync (Sync)
import qualified Polysemy.Conc.Race as Race

-- |Interpret 'Sync' with the provided 'MVar'.
interpretSyncWith ::
  ∀ d r .
  Members [Race, Embed IO] r =>
  MVar d ->
  InterpreterFor (Sync d) r
interpretSyncWith :: forall d (r :: EffectRow).
Members '[Race, Embed IO] r =>
MVar d -> InterpreterFor (Sync d) r
interpretSyncWith MVar d
var =
  (forall (rInitial :: EffectRow) x.
 Sync d (Sem rInitial) x -> Sem r x)
-> Sem (Sync d : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Sync d (Sem rInitial) x
Sync.Block ->
      IO x -> Sem r x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar x -> IO x
forall a. MVar a -> IO a
readMVar MVar d
MVar x
var)
    Sync.Wait u
interval ->
      Either () d -> x
Either () d -> Maybe d
forall l r. Either l r -> Maybe r
rightToMaybe (Either () d -> x) -> Sem r (Either () d) -> Sem r x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> u -> Sem r d -> Sem r (Either () d)
forall u (r :: EffectRow) a b.
(TimeUnit u, Member Race r) =>
a -> u -> Sem r b -> Sem r (Either a b)
Race.timeoutAs () u
interval (IO d -> Sem r d
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar d -> IO d
forall a. MVar a -> IO a
readMVar MVar d
var))
    Sync d (Sem rInitial) x
Sync.Try ->
      IO x -> Sem r x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar d -> IO (Maybe d)
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar d
var)
    Sync d (Sem rInitial) x
Sync.TakeBlock ->
      IO x -> Sem r x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar x -> IO x
forall a. MVar a -> IO a
takeMVar MVar d
MVar x
var)
    Sync.TakeWait u
interval ->
      Either () d -> x
Either () d -> Maybe d
forall l r. Either l r -> Maybe r
rightToMaybe (Either () d -> x) -> Sem r (Either () d) -> Sem r x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> u -> Sem r d -> Sem r (Either () d)
forall u (r :: EffectRow) a b.
(TimeUnit u, Member Race r) =>
a -> u -> Sem r b -> Sem r (Either a b)
Race.timeoutAs () u
interval (IO d -> Sem r d
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar d -> IO d
forall a. MVar a -> IO a
takeMVar MVar d
var))
    Sync d (Sem rInitial) x
Sync.TakeTry ->
      IO x -> Sem r x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar d -> IO (Maybe d)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar d
var)
    Sync.PutBlock d
d ->
      IO x -> Sem r x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar d -> d -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar d
var d
d)
    Sync.PutWait u
interval d
d ->
      x -> u -> Sem r x -> Sem r x
forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
a -> u -> Sem r a -> Sem r a
Race.timeoutAs_ x
Bool
False u
interval (x
Bool
True x -> Sem r () -> Sem r x
forall a b. a -> Sem r b -> Sem r a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar d -> d -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar d
var d
d))
    Sync.PutTry d
d ->
      IO x -> Sem r x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar d -> d -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar d
var d
d)
    Sync d (Sem rInitial) x
Sync.Empty ->
      IO x -> Sem r x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (MVar d -> IO Bool
forall a. MVar a -> IO Bool
isEmptyMVar MVar d
var)

-- |Interpret 'Sync' with an empty 'MVar'.
interpretSync ::
  ∀ d r .
  Members [Race, Embed IO] r =>
  InterpreterFor (Sync d) r
interpretSync :: forall d (r :: EffectRow).
Members '[Race, Embed IO] r =>
InterpreterFor (Sync d) r
interpretSync Sem (Sync d : r) a
sem = do
  MVar d
var <- IO (MVar d) -> Sem r (MVar d)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO (MVar d)
forall a. IO (MVar a)
newEmptyMVar
  MVar d -> InterpreterFor (Sync d) r
forall d (r :: EffectRow).
Members '[Race, Embed IO] r =>
MVar d -> InterpreterFor (Sync d) r
interpretSyncWith MVar d
var Sem (Sync d : r) a
sem

-- |Interpret 'Sync' with an 'MVar' containing the specified value.
interpretSyncAs ::
  ∀ d r .
  Members [Race, Embed IO] r =>
  d ->
  InterpreterFor (Sync d) r
interpretSyncAs :: forall d (r :: EffectRow).
Members '[Race, Embed IO] r =>
d -> InterpreterFor (Sync d) r
interpretSyncAs d
d Sem (Sync d : r) a
sem = do
  MVar d
var <- IO (MVar d) -> Sem r (MVar d)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (d -> IO (MVar d)
forall a. a -> IO (MVar a)
newMVar d
d)
  MVar d -> InterpreterFor (Sync d) r
forall d (r :: EffectRow).
Members '[Race, Embed IO] r =>
MVar d -> InterpreterFor (Sync d) r
interpretSyncWith MVar d
var Sem (Sync d : r) a
sem

-- |Interpret 'Sync' for locally scoped use with an empty 'MVar'.
interpretScopedSync ::
  ∀ d r .
  Members [Resource, Race, Embed IO] r =>
  InterpreterFor (Scoped_ (Sync d)) r
interpretScopedSync :: forall d (r :: EffectRow).
Members '[Resource, Race, Embed IO] r =>
InterpreterFor (Scoped_ (Sync d)) r
interpretScopedSync =
  (() -> Sem r (MVar d))
-> (forall (q :: (* -> *) -> * -> *).
    MVar d -> InterpreterFor (Sync d) (Opaque q : r))
-> InterpreterFor (Scoped () (Sync d)) r
forall resource param (effect :: (* -> *) -> * -> *)
       (r :: EffectRow).
(param -> Sem r resource)
-> (forall (q :: (* -> *) -> * -> *).
    resource -> InterpreterFor effect (Opaque q : r))
-> InterpreterFor (Scoped param effect) r
runScopedAs (Sem r (MVar d) -> () -> Sem r (MVar d)
forall a b. a -> b -> a
const (IO (MVar d) -> Sem r (MVar d)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO (MVar d)
forall a. IO (MVar a)
newEmptyMVar)) \ MVar d
r -> MVar d
-> forall {a}.
   Sem (Sync d : Opaque q : r) a -> Sem (Opaque q : r) a
forall d (r :: EffectRow).
Members '[Race, Embed IO] r =>
MVar d -> InterpreterFor (Sync d) r
interpretSyncWith MVar d
r

-- |Interpret 'Sync' for locally scoped use with an 'MVar' containing the specified value.
interpretScopedSyncAs ::
  ∀ d r .
  Members [Resource, Race, Embed IO] r =>
  d ->
  InterpreterFor (Scoped_ (Sync d)) r
interpretScopedSyncAs :: forall d (r :: EffectRow).
Members '[Resource, Race, Embed IO] r =>
d -> InterpreterFor (Scoped_ (Sync d)) r
interpretScopedSyncAs d
d =
  (() -> Sem r (MVar d))
-> (forall (q :: (* -> *) -> * -> *).
    MVar d -> InterpreterFor (Sync d) (Opaque q : r))
-> InterpreterFor (Scoped () (Sync d)) r
forall resource param (effect :: (* -> *) -> * -> *)
       (r :: EffectRow).
(param -> Sem r resource)
-> (forall (q :: (* -> *) -> * -> *).
    resource -> InterpreterFor effect (Opaque q : r))
-> InterpreterFor (Scoped param effect) r
runScopedAs (Sem r (MVar d) -> () -> Sem r (MVar d)
forall a b. a -> b -> a
const (IO (MVar d) -> Sem r (MVar d)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (d -> IO (MVar d)
forall a. a -> IO (MVar a)
newMVar d
d))) \ MVar d
r -> MVar d
-> forall {a}.
   Sem (Sync d : Opaque q : r) a -> Sem (Opaque q : r) a
forall d (r :: EffectRow).
Members '[Race, Embed IO] r =>
MVar d -> InterpreterFor (Sync d) r
interpretSyncWith MVar d
r