{-# options_haddock prune #-}

-- |Description: Sync Combinators
module Polysemy.Conc.Sync (
  module Polysemy.Conc.Sync,
  module Polysemy.Conc.Effect.Sync,
) where

import qualified Polysemy.Time as Time
import Polysemy.Time (Time, TimeUnit)

import Polysemy.Conc.Effect.Scoped (scoped)
import qualified Polysemy.Conc.Effect.Sync as Sync
import Polysemy.Conc.Effect.Sync (
  ScopedSync,
  Sync,
  SyncResources,
  block,
  empty,
  putBlock,
  putTry,
  putWait,
  takeBlock,
  takeTry,
  takeWait,
  try,
  wait,
  )

-- |Run an action repeatedly until the 'Sync' variable is available.
whileEmpty ::
  ∀ a r .
  Member (Sync a) r =>
  Sem r () ->
  Sem r ()
whileEmpty :: forall a (r :: [(* -> *) -> * -> *]).
Member (Sync a) r =>
Sem r () -> Sem r ()
whileEmpty Sem r ()
action =
  Sem r ()
spin
  where
    spin :: Sem r ()
spin = do
      Sem r ()
action
      Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Bool -> Bool
not (Bool -> Bool) -> Sem r Bool -> Sem r Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Sync d) r =>
Sem r Bool
Sync.empty @a) Sem r ()
spin

-- |Run an action repeatedly until the 'Sync' variable is available, waiting for the specified time between executions.
whileEmptyInterval ::
  ∀ a u t d r .
  TimeUnit u =>
  Members [Time t d, Sync a] r =>
  u ->
  Sem r () ->
  Sem r ()
whileEmptyInterval :: forall a u t d (r :: [(* -> *) -> * -> *]).
(TimeUnit u, Members '[Time t d, Sync a] r) =>
u -> Sem r () -> Sem r ()
whileEmptyInterval u
interval Sem r ()
action =
  Sem r ()
spin
  where
    spin :: Sem r ()
spin = do
      Sem r ()
action
      Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Bool -> Bool
not (Bool -> Bool) -> Sem r Bool -> Sem r Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Sync d) r =>
Sem r Bool
Sync.empty @a) (forall t d u (r :: [(* -> *) -> * -> *]).
(TimeUnit u, Member (Time t d) r) =>
u -> Sem r ()
Time.sleep @t @d u
interval Sem r () -> Sem r () -> Sem r ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Sem r ()
spin)

-- |Run an action with a locally scoped 'Sync' variable.
-- This avoids a dependency on @'Embed' 'IO'@ in application logic while still allowing the variable to be scoped.
withSync ::
  ∀ d res r .
  Member (ScopedSync res d) r =>
  InterpreterFor (Sync d) r
withSync :: forall d res (r :: [(* -> *) -> * -> *]).
Member (ScopedSync res d) r =>
InterpreterFor (Sync d) r
withSync =
  forall resource (effect :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
Member (Scoped resource effect) r =>
InterpreterFor effect r
scoped @(SyncResources res)

-- |Run the action @ma@ with an exclusive lock (mutex).
-- When multiple threads call the action concurrently, only one is allowed to execute it at a time.
-- The value @l@ is used to disambiguate the 'Sync' from other uses of the combinator.
-- You can pass in something like @Proxy @"db-write"@.
--
-- /Note:/ The 'Sync' must be interpreted with an initially full @MVar@, e.g. using 'Polysemy.Conc.interpretSyncAs'.
lock ::
  ∀ l r a .
  Members [Sync l, Resource] r =>
  l ->
  Sem r a ->
  Sem r a
lock :: forall l (r :: [(* -> *) -> * -> *]) a.
Members '[Sync l, Resource] r =>
l -> Sem r a -> Sem r a
lock l
l Sem r a
ma =
  Sem r a -> Sem r Bool -> Sem r a
forall (r :: [(* -> *) -> * -> *]) a b.
Member Resource r =>
Sem r a -> Sem r b -> Sem r a
finally (forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Sync d) r =>
Sem r d
takeBlock @l Sem r l -> Sem r a -> Sem r a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Sem r a
ma) (l -> Sem r Bool
forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Sync d) r =>
d -> Sem r Bool
putTry l
l)

-- |Remove the content of the 'Sync' variable if it is present.
clear ::
  ∀ a r .
  Member (Sync a) r =>
  Sem r ()
clear :: forall a (r :: [(* -> *) -> * -> *]). Member (Sync a) r => Sem r ()
clear =
  Sem r (Maybe a) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Sync d) r =>
Sem r (Maybe d)
takeTry @a)