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

import Control.Concurrent (isEmptyMVar)
import Polysemy.Resource (Resource)

import Polysemy.Conc.Effect.Race (Race)
import Polysemy.Conc.Effect.Scoped (Scoped)
import qualified Polysemy.Conc.Effect.Sync as Sync
import Polysemy.Conc.Effect.Sync (Sync, SyncResources (SyncResources), unSyncResources)
import Polysemy.Conc.Interpreter.Scoped (runScopedAs)
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 :: 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 :: Effect) (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 ->
      MVar d -> Sem r d
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar MVar d
var
    Sync.Wait interval ->
      Either () d -> Maybe d
forall l r. Either l r -> Maybe r
rightToMaybe (Either () d -> Maybe d) -> Sem r (Either () d) -> Sem r (Maybe d)
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 (MVar d -> Sem r d
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar MVar d
var)
    Sync d (Sem rInitial) x
Sync.Try ->
      MVar d -> Sem r (Maybe d)
forall (m :: * -> *) a. MonadIO m => MVar a -> m (Maybe a)
tryReadMVar MVar d
var
    Sync d (Sem rInitial) x
Sync.TakeBlock ->
      MVar d -> Sem r d
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar d
var
    Sync.TakeWait interval ->
      Either () d -> Maybe d
forall l r. Either l r -> Maybe r
rightToMaybe (Either () d -> Maybe d) -> Sem r (Either () d) -> Sem r (Maybe d)
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 (MVar d -> Sem r d
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar d
var)
    Sync d (Sem rInitial) x
Sync.TakeTry ->
      MVar d -> Sem r (Maybe d)
forall (m :: * -> *) a. MonadIO m => MVar a -> m (Maybe a)
tryTakeMVar MVar d
var
    Sync d (Sem rInitial) x
Sync.ReadBlock ->
      MVar d -> Sem r d
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar MVar d
var
    Sync.ReadWait interval ->
      Either () d -> Maybe d
forall l r. Either l r -> Maybe r
rightToMaybe (Either () d -> Maybe d) -> Sem r (Either () d) -> Sem r (Maybe d)
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 (MVar d -> Sem r d
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar MVar d
var)
    Sync d (Sem rInitial) x
Sync.ReadTry ->
      MVar d -> Sem r (Maybe d)
forall (m :: * -> *) a. MonadIO m => MVar a -> m (Maybe a)
tryReadMVar MVar d
var
    Sync.PutBlock d ->
      MVar d -> d -> Sem r ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar d
var d
d
    Sync.PutWait interval d ->
      Bool -> u -> Sem r Bool -> Sem r Bool
forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
a -> u -> Sem r a -> Sem r a
Race.timeoutAs_ Bool
False u
interval (Bool
True Bool -> Sem r () -> Sem r Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar d -> d -> Sem r ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar d
var d
d)
    Sync.PutTry d ->
      MVar d -> d -> Sem r Bool
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m Bool
tryPutMVar MVar d
var d
d
    Sync d (Sem rInitial) x
Sync.Empty ->
      IO Bool -> Sem r Bool
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 :: InterpreterFor (Sync d) r
interpretSync Sem (Sync d : r) a
sem = do
  MVar d
var <- Sem r (MVar d)
forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar
  MVar d -> Sem (Sync d : r) a -> Sem r a
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 :: d -> InterpreterFor (Sync d) r
interpretSyncAs d
d Sem (Sync d : r) a
sem = do
  MVar d
var <- d -> Sem r (MVar d)
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar d
d
  MVar d -> Sem (Sync d : r) a -> Sem r a
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 (SyncResources (MVar d)) (Sync d)) r
interpretScopedSync :: InterpreterFor (Scoped (SyncResources (MVar d)) (Sync d)) r
interpretScopedSync =
  Sem r (SyncResources (MVar d))
-> (SyncResources (MVar d) -> InterpreterFor (Sync d) r)
-> InterpreterFor (Scoped (SyncResources (MVar d)) (Sync d)) r
forall resource (effect :: Effect) (r :: EffectRow).
Sem r resource
-> (resource -> InterpreterFor effect r)
-> InterpreterFor (Scoped resource effect) r
runScopedAs (MVar d -> SyncResources (MVar d)
forall a. a -> SyncResources a
SyncResources (MVar d -> SyncResources (MVar d))
-> Sem r (MVar d) -> Sem r (SyncResources (MVar d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r (MVar d)
forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar) \ SyncResources (MVar d)
r -> MVar d -> InterpreterFor (Sync d) r
forall d (r :: EffectRow).
Members '[Race, Embed IO] r =>
MVar d -> InterpreterFor (Sync d) r
interpretSyncWith (SyncResources (MVar d) -> MVar d
forall a. SyncResources a -> a
unSyncResources SyncResources (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 (SyncResources (MVar d)) (Sync d)) r
interpretScopedSyncAs :: d -> InterpreterFor (Scoped (SyncResources (MVar d)) (Sync d)) r
interpretScopedSyncAs d
d =
  Sem r (SyncResources (MVar d))
-> (SyncResources (MVar d) -> InterpreterFor (Sync d) r)
-> InterpreterFor (Scoped (SyncResources (MVar d)) (Sync d)) r
forall resource (effect :: Effect) (r :: EffectRow).
Sem r resource
-> (resource -> InterpreterFor effect r)
-> InterpreterFor (Scoped resource effect) r
runScopedAs (MVar d -> SyncResources (MVar d)
forall a. a -> SyncResources a
SyncResources (MVar d -> SyncResources (MVar d))
-> Sem r (MVar d) -> Sem r (SyncResources (MVar d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d -> Sem r (MVar d)
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar d
d) \ SyncResources (MVar d)
r -> MVar d -> InterpreterFor (Sync d) r
forall d (r :: EffectRow).
Members '[Race, Embed IO] r =>
MVar d -> InterpreterFor (Sync d) r
interpretSyncWith (SyncResources (MVar d) -> MVar d
forall a. SyncResources a -> a
unSyncResources SyncResources (MVar d)
r)