-- |Description: Pure Queue Interpreters
module Polysemy.Conc.Interpreter.Queue.Pure where

import Polysemy.Conc.AtomicState (interpretAtomic)
import qualified Polysemy.Conc.Data.QueueResult as QueueResult
import Polysemy.Conc.Data.QueueResult (QueueResult)
import qualified Polysemy.Conc.Effect.Queue as Queue
import Polysemy.Conc.Effect.Queue (Queue)

-- |Reinterpret 'Queue' as 'AtomicState' with a list that cannot be written to.
-- Useful for testing.
interpretQueueListReadOnlyAtomicWith ::
  ∀ d r .
  Member (AtomicState [d]) r =>
  InterpreterFor (Queue d) r
interpretQueueListReadOnlyAtomicWith :: forall d (r :: [(* -> *) -> * -> *]).
Member (AtomicState [d]) r =>
InterpreterFor (Queue d) r
interpretQueueListReadOnlyAtomicWith =
  (forall (rInitial :: [(* -> *) -> * -> *]) x.
 Queue d (Sem rInitial) x -> Sem r x)
-> Sem (Queue 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
    Queue d (Sem rInitial) x
Queue.Read ->
      Sem r x
Sem r (QueueResult d)
read
    Queue d (Sem rInitial) x
Queue.TryRead ->
      Sem r x
Sem r (QueueResult d)
read
    Queue.ReadTimeout t
_ ->
      Sem r x
Sem r (QueueResult d)
read
    Queue d (Sem rInitial) x
Queue.Peek ->
      Sem r x
Sem r (QueueResult d)
peek
    Queue d (Sem rInitial) x
Queue.TryPeek ->
      Sem r x
Sem r (QueueResult d)
peek
    Queue.Write d
_ ->
      Sem r x
forall (f :: * -> *). Applicative f => f ()
unit
    Queue.TryWrite d
_ ->
      QueueResult () -> Sem r (QueueResult ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueResult ()
forall d. QueueResult d
QueueResult.NotAvailable
    Queue.WriteTimeout t
_ d
_ ->
      QueueResult () -> Sem r (QueueResult ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueResult ()
forall d. QueueResult d
QueueResult.NotAvailable
    Queue d (Sem rInitial) x
Queue.Closed ->
      forall s s' (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets @[d] [d] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
    Queue d (Sem rInitial) x
Queue.Close ->
      forall s (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
s -> Sem r ()
atomicPut @[d] []
  where
    read :: Sem r (QueueResult d)
    read :: Sem r (QueueResult d)
read =
      forall s a (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState' @[d] \case
        [] -> ([], QueueResult d
forall d. QueueResult d
QueueResult.Closed)
        d
h : [d]
t -> ([d]
t, d -> QueueResult d
forall d. d -> QueueResult d
QueueResult.Success d
h)
    peek :: Sem r (QueueResult d)
    peek :: Sem r (QueueResult d)
peek =
      forall s s' (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets @[d] \case
        [] -> QueueResult d
forall d. QueueResult d
QueueResult.Closed
        d
h : [d]
_ -> d -> QueueResult d
forall d. d -> QueueResult d
QueueResult.Success d
h
{-# inline interpretQueueListReadOnlyAtomicWith #-}

-- |Variant of 'interpretQueueListReadOnlyAtomicWith' that interprets the 'AtomicState'.
interpretQueueListReadOnlyAtomic ::
  ∀ d r .
  Member (Embed IO) r =>
  [d] ->
  InterpreterFor (Queue d) r
interpretQueueListReadOnlyAtomic :: forall d (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
[d] -> InterpreterFor (Queue d) r
interpretQueueListReadOnlyAtomic [d]
ds Sem (Queue d : r) a
sem =
  [d] -> InterpreterFor (AtomicState [d]) r
forall a (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
a -> InterpreterFor (AtomicState a) r
interpretAtomic [d]
ds (Sem (Queue d : AtomicState [d] : r) a
-> Sem (AtomicState [d] : r) a
forall d (r :: [(* -> *) -> * -> *]).
Member (AtomicState [d]) r =>
InterpreterFor (Queue d) r
interpretQueueListReadOnlyAtomicWith (Sem (Queue d : r) a -> Sem (Queue d : AtomicState [d] : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder Sem (Queue d : r) a
sem))
{-# inline interpretQueueListReadOnlyAtomic #-}

-- |Reinterpret 'Queue' as 'State' with a list that cannot be written to.
-- Useful for testing.
interpretQueueListReadOnlyStateWith ::
  ∀ d r .
  Member (State [d]) r =>
  InterpreterFor (Queue d) r
interpretQueueListReadOnlyStateWith :: forall d (r :: [(* -> *) -> * -> *]).
Member (State [d]) r =>
InterpreterFor (Queue d) r
interpretQueueListReadOnlyStateWith =
  (forall (rInitial :: [(* -> *) -> * -> *]) x.
 Queue d (Sem rInitial) x -> Sem r x)
-> Sem (Queue 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
    Queue d (Sem rInitial) x
Queue.Read ->
      Sem r x
Sem r (QueueResult d)
read
    Queue d (Sem rInitial) x
Queue.TryRead ->
      Sem r x
Sem r (QueueResult d)
read
    Queue.ReadTimeout t
_ ->
      Sem r x
Sem r (QueueResult d)
read
    Queue d (Sem rInitial) x
Queue.Peek ->
      Sem r x
Sem r (QueueResult d)
peek
    Queue d (Sem rInitial) x
Queue.TryPeek ->
      Sem r x
Sem r (QueueResult d)
peek
    Queue.Write d
_ ->
      Sem r x
forall (f :: * -> *). Applicative f => f ()
unit
    Queue.TryWrite d
_ ->
      QueueResult () -> Sem r (QueueResult ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueResult ()
forall d. QueueResult d
QueueResult.NotAvailable
    Queue.WriteTimeout t
_ d
_ ->
      QueueResult () -> Sem r (QueueResult ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueResult ()
forall d. QueueResult d
QueueResult.NotAvailable
    Queue d (Sem rInitial) x
Queue.Closed ->
      forall s a (r :: [(* -> *) -> * -> *]).
Member (State s) r =>
(s -> a) -> Sem r a
gets @[d] [d] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
    Queue d (Sem rInitial) x
Queue.Close ->
      forall s (r :: [(* -> *) -> * -> *]).
MemberWithError (State s) r =>
s -> Sem r ()
put @[d] []
  where
    read :: Sem r (QueueResult d)
    read :: Sem r (QueueResult d)
read =
      forall s (r :: [(* -> *) -> * -> *]).
MemberWithError (State s) r =>
Sem r s
get @[d] Sem r [d]
-> ([d] -> Sem r (QueueResult d)) -> Sem r (QueueResult d)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [] -> QueueResult d -> Sem r (QueueResult d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueResult d
forall d. QueueResult d
QueueResult.Closed
        d
h : [d]
t -> d -> QueueResult d
forall d. d -> QueueResult d
QueueResult.Success d
h QueueResult d -> Sem r () -> Sem r (QueueResult d)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [d] -> Sem r ()
forall s (r :: [(* -> *) -> * -> *]).
MemberWithError (State s) r =>
s -> Sem r ()
put [d]
t
    peek :: Sem r (QueueResult d)
    peek :: Sem r (QueueResult d)
peek =
      forall s a (r :: [(* -> *) -> * -> *]).
Member (State s) r =>
(s -> a) -> Sem r a
gets @[d] \case
        [] -> QueueResult d
forall d. QueueResult d
QueueResult.Closed
        d
h : [d]
_ -> d -> QueueResult d
forall d. d -> QueueResult d
QueueResult.Success d
h
{-# inline interpretQueueListReadOnlyStateWith #-}

-- |Variant of 'interpretQueueListReadOnlyAtomicWith' that interprets the 'State'.
interpretQueueListReadOnlyState ::
  ∀ d r .
  [d] ->
  InterpreterFor (Queue d) r
interpretQueueListReadOnlyState :: forall d (r :: [(* -> *) -> * -> *]).
[d] -> InterpreterFor (Queue d) r
interpretQueueListReadOnlyState [d]
ds Sem (Queue d : r) a
sem = do
  [d] -> Sem (State [d] : r) a -> Sem r a
forall s (r :: [(* -> *) -> * -> *]) a.
s -> Sem (State s : r) a -> Sem r a
evalState [d]
ds (Sem (Queue d : State [d] : r) a -> Sem (State [d] : r) a
forall d (r :: [(* -> *) -> * -> *]).
Member (State [d]) r =>
InterpreterFor (Queue d) r
interpretQueueListReadOnlyStateWith (Sem (Queue d : r) a -> Sem (Queue d : State [d] : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder Sem (Queue d : r) a
sem))
{-# inline interpretQueueListReadOnlyState #-}