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

import qualified Polysemy.Conc.Data.QueueResult as QueueResult
import qualified Polysemy.Conc.Effect.Queue as Queue
import Polysemy.Conc.Effect.Queue (
  Queue,
  close,
  closed,
  peek,
  read,
  readTimeout,
  tryPeek,
  tryRead,
  tryWrite,
  write,
  writeTimeout,
  )

-- |Read from a 'Queue' repeatedly until it is closed.
--
-- When an element is received, call @action@ and recurse if it returns 'True'.
-- When no element is available, evaluate @na@ and recurse if it returns 'True'.
loopOr ::
  Member (Queue d) r =>
  Sem r Bool ->
  (d -> Sem r Bool) ->
  Sem r ()
loopOr :: Sem r Bool -> (d -> Sem r Bool) -> Sem r ()
loopOr Sem r Bool
na d -> Sem r Bool
action =
  Sem r ()
spin
  where
    spin :: Sem r ()
spin =
      Sem r (QueueResult d)
forall d (r :: [Effect]).
MemberWithError (Queue d) r =>
Sem r (QueueResult d)
Queue.read Sem r (QueueResult d) -> (QueueResult d -> Sem r ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        QueueResult.Success d
d -> Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (d -> Sem r Bool
action d
d) Sem r ()
spin
        QueueResult d
QueueResult.NotAvailable -> Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM Sem r Bool
na Sem r ()
spin
        QueueResult d
QueueResult.Closed -> Sem r ()
forall (f :: * -> *). Applicative f => f ()
pass

-- |Read from a 'Queue' repeatedly until it is closed.
--
-- When an element is received, call @action@ and recurse.
loop ::
  Member (Queue d) r =>
  (d -> Sem r ()) ->
  Sem r ()
loop :: (d -> Sem r ()) -> Sem r ()
loop d -> Sem r ()
action =
  Sem r Bool -> (d -> Sem r Bool) -> Sem r ()
forall d (r :: [Effect]).
Member (Queue d) r =>
Sem r Bool -> (d -> Sem r Bool) -> Sem r ()
loopOr (Bool -> Sem r Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) \ d
d -> Bool
True Bool -> Sem r () -> Sem r Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ d -> Sem r ()
action d
d