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

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 :: forall d (r :: [(* -> *) -> * -> *]).
Members '[Race, Embed IO] r =>
MVar d -> InterpreterFor (Sync d) r
interpretSyncWith MVar d
var =
  (forall (rInitial :: [(* -> *) -> * -> *]) x.
 Sync d (Sem rInitial) x -> Sem r x)
-> Sem (Sync d : 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
    Sync d (Sem rInitial) x
Sync.Block ->
      IO d -> Sem r d
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) 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.Wait u
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 :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]) 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 (Maybe d) -> Sem r (Maybe d)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) 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 d -> Sem r d
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) 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.TakeWait u
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 :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]) 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 (Maybe d) -> Sem r (Maybe d)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) 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 () -> Sem r ()
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) 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 ->
      Bool -> u -> Sem r Bool -> Sem r Bool
forall u (r :: [(* -> *) -> * -> *]) 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
<$ IO () -> Sem r ()
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) 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 Bool -> Sem r Bool
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) 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 Bool -> Sem r Bool
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]).
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 :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]).
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 :: [(* -> *) -> * -> *]).
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 :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]).
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 :: forall d (r :: [(* -> *) -> * -> *]).
Members '[Resource, Race, Embed IO] r =>
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 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
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
<$> IO (MVar d) -> Sem r (MVar d)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO (MVar d)
forall a. IO (MVar a)
newEmptyMVar) \ SyncResources (MVar d)
r -> MVar d -> InterpreterFor (Sync d) r
forall d (r :: [(* -> *) -> * -> *]).
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 :: forall d (r :: [(* -> *) -> * -> *]).
Members '[Resource, Race, Embed IO] r =>
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 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
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
<$> IO (MVar d) -> Sem r (MVar d)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (d -> IO (MVar d)
forall a. a -> IO (MVar a)
newMVar d
d)) \ SyncResources (MVar d)
r -> MVar d -> InterpreterFor (Sync d) r
forall d (r :: [(* -> *) -> * -> *]).
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)