-- |
-- Module      : Control.Concurrent.Classy.QSem
-- Copyright   : (c) 2016 Michael Walker
-- License     : MIT
-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
-- Stability   : stable
-- Portability : portable
--
-- Simple quantity semaphores.
module Control.Concurrent.Classy.QSem
  ( -- * Simple Quantity Semaphores
    QSem
  , newQSem
  , waitQSem
  , signalQSem
  ) where

import           Control.Concurrent.Classy.QSemN
import           Control.Monad.Conc.Class        (MonadConc)
import           Control.Monad.Fail              (MonadFail)

-- | @QSem@ is a quantity semaphore in which the resource is acquired
-- and released in units of one. It provides guaranteed FIFO ordering
-- for satisfying blocked 'waitQSem' calls.
--
-- The pattern
--
-- > bracket_ qaitQSem signalSSem (...)
--
-- is safe; it never loses a unit of the resource.
--
-- @since 1.0.0.0
newtype QSem m = QSem (QSemN m)

-- | Build a new 'QSem' with a supplied initial quantity. The initial
-- quantity must be at least 0.
--
-- @since 1.0.0.0
newQSem :: (MonadConc m, MonadFail m) => Int -> m (QSem m)
newQSem :: Int -> m (QSem m)
newQSem Int
initial
  | Int
initial Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> m (QSem m)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"newQSem: Initial quantity mus tbe non-negative."
  | Bool
otherwise   = QSemN m -> QSem m
forall (m :: * -> *). QSemN m -> QSem m
QSem (QSemN m -> QSem m) -> m (QSemN m) -> m (QSem m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (QSemN m)
forall (m :: * -> *).
(MonadConc m, MonadFail m) =>
Int -> m (QSemN m)
newQSemN Int
initial

-- | Wait for a unit to become available.
--
-- @since 1.0.0.0
waitQSem :: MonadConc m => QSem m -> m ()
waitQSem :: QSem m -> m ()
waitQSem (QSem QSemN m
qSemN) = QSemN m -> Int -> m ()
forall (m :: * -> *). MonadConc m => QSemN m -> Int -> m ()
waitQSemN QSemN m
qSemN Int
1

-- | Signal that a unit of the 'QSem' is available.
--
-- @since 1.0.0.0
signalQSem :: MonadConc m => QSem m -> m ()
signalQSem :: QSem m -> m ()
signalQSem (QSem QSemN m
qSemN) = QSemN m -> Int -> m ()
forall (m :: * -> *). MonadConc m => QSemN m -> Int -> m ()
signalQSemN QSemN m
qSemN Int
1