-- |Semaphore interpreters, Internal.
module Polysemy.Conc.Interpreter.Semaphore where

import Control.Concurrent (QSem, newQSem, signalQSem, waitQSem)
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TSem (TSem, newTSem, signalTSem, waitTSem)

import qualified Polysemy.Conc.Effect.Semaphore as Semaphore
import Polysemy.Conc.Effect.Semaphore (Semaphore)

-- |Interpret 'Semaphore' using the supplied 'QSem'.
interpretSemaphoreQWith ::
  Member (Embed IO) r =>
  QSem ->
  InterpreterFor Semaphore r
interpretSemaphoreQWith :: forall (r :: EffectRow).
Member (Embed IO) r =>
QSem -> InterpreterFor Semaphore r
interpretSemaphoreQWith QSem
qsem =
  (forall (rInitial :: EffectRow) x.
 Semaphore (Sem rInitial) x -> Sem r x)
-> Sem (Semaphore : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (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
    Semaphore (Sem rInitial) x
Semaphore.Wait ->
      IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (QSem -> IO ()
waitQSem QSem
qsem)
    Semaphore (Sem rInitial) x
Semaphore.Signal ->
      IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (QSem -> IO ()
signalQSem QSem
qsem)
{-# inline interpretSemaphoreQWith #-}

-- |Interpret 'Semaphore' as a 'QSem'.
interpretSemaphoreQ ::
  Member (Embed IO) r =>
  Int ->
  InterpreterFor Semaphore r
interpretSemaphoreQ :: forall (r :: EffectRow).
Member (Embed IO) r =>
Int -> InterpreterFor Semaphore r
interpretSemaphoreQ Int
n Sem (Semaphore : r) a
sem = do
  QSem
qsem <- IO QSem -> Sem r QSem
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (Int -> IO QSem
newQSem Int
n)
  QSem -> InterpreterFor Semaphore r
forall (r :: EffectRow).
Member (Embed IO) r =>
QSem -> InterpreterFor Semaphore r
interpretSemaphoreQWith QSem
qsem Sem (Semaphore : r) a
sem
{-# inline interpretSemaphoreQ #-}

-- |Interpret 'Semaphore' using the supplied 'TSem'.
interpretSemaphoreTWith ::
  Member (Embed IO) r =>
  TSem ->
  InterpreterFor Semaphore r
interpretSemaphoreTWith :: forall (r :: EffectRow).
Member (Embed IO) r =>
TSem -> InterpreterFor Semaphore r
interpretSemaphoreTWith TSem
qsem =
  (forall (rInitial :: EffectRow) x.
 Semaphore (Sem rInitial) x -> Sem r x)
-> Sem (Semaphore : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (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
    Semaphore (Sem rInitial) x
Semaphore.Wait ->
      IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (STM () -> IO ()
forall a. STM a -> IO a
atomically (TSem -> STM ()
waitTSem TSem
qsem))
    Semaphore (Sem rInitial) x
Semaphore.Signal ->
      IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (STM () -> IO ()
forall a. STM a -> IO a
atomically (TSem -> STM ()
signalTSem TSem
qsem))
{-# inline interpretSemaphoreTWith #-}

-- |Interpret 'Semaphore' as a 'TSem'.
interpretSemaphoreT ::
  Member (Embed IO) r =>
  Integer ->
  InterpreterFor Semaphore r
interpretSemaphoreT :: forall (r :: EffectRow).
Member (Embed IO) r =>
Integer -> InterpreterFor Semaphore r
interpretSemaphoreT Integer
n Sem (Semaphore : r) a
sem = do
  TSem
qsem <- IO TSem -> Sem r TSem
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (STM TSem -> IO TSem
forall a. STM a -> IO a
atomically (Integer -> STM TSem
newTSem Integer
n))
  TSem -> InterpreterFor Semaphore r
forall (r :: EffectRow).
Member (Embed IO) r =>
TSem -> InterpreterFor Semaphore r
interpretSemaphoreTWith TSem
qsem Sem (Semaphore : r) a
sem
{-# inline interpretSemaphoreT #-}