-- |
-- Module      : Control.Concurrent.Classy.STM.TSem
-- Copyright   : (c) 2018 Michael Walker
-- License     : MIT
-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
-- Stability   : stable
-- Portability : portable
--
-- 'TSem': transactional semaphores.
--
-- __Deviations:__ There is no @Eq@ instance for @TSem@ type.
module Control.Concurrent.Classy.STM.TSem
  ( TSem
  , newTSem
  , waitTSem
  , signalTSem
  , signalTSemN
  ) where

import           Control.Monad           (when)
import           Control.Monad.STM.Class
import           Numeric.Natural         (Natural)

-- | 'TSem' is a transactional semaphore.  It holds a certain number
-- of units, and units may be acquired or released by 'waitTSem' and
-- 'signalTSem' respectively.  When the 'TSem' is empty, 'waitTSem'
-- blocks.
--
-- Note that 'TSem' has no concept of fairness, and there is no
-- guarantee that threads blocked in `waitTSem` will be unblocked in
-- the same order; in fact they will all be unblocked at the same time
-- and will fight over the 'TSem'.  Hence 'TSem' is not suitable if
-- you expect there to be a high number of threads contending for the
-- resource.  However, like other STM abstractions, 'TSem' is
-- composable.
--
-- @since 1.6.1.0
newtype TSem stm = TSem (TVar stm Integer)

-- | Construct new 'TSem' with an initial counter value.
--
-- A positive initial counter value denotes availability of
-- units 'waitTSem' can acquire.
--
-- The initial counter value can be negative which denotes a resource
-- \"debt\" that requires a respective amount of 'signalTSem'
-- operations to counter-balance.
--
-- @since 1.6.1.0
newTSem :: MonadSTM stm => Integer -> stm (TSem stm)
newTSem :: forall (stm :: * -> *). MonadSTM stm => Integer -> stm (TSem stm)
newTSem Integer
i = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (stm :: * -> *). TVar stm Integer -> TSem stm
TSem (forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar forall a b. (a -> b) -> a -> b
$! Integer
i)

-- | Wait on 'TSem' (aka __P__ operation).
--
-- This operation acquires a unit from the semaphore (i.e. decreases
-- the internal counter) and blocks (via 'retry') if no units are
-- available (i.e. if the counter is /not/ positive).
--
-- @since 2.4.2
waitTSem :: MonadSTM stm => TSem stm -> stm ()
waitTSem :: forall (stm :: * -> *). MonadSTM stm => TSem stm -> stm ()
waitTSem (TSem TVar stm Integer
t) = do
  Integer
i <- forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm Integer
t
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i forall a. Ord a => a -> a -> Bool
<= Integer
0) forall (stm :: * -> *) a. MonadSTM stm => stm a
retry
  forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm Integer
t forall a b. (a -> b) -> a -> b
$! (Integer
iforall a. Num a => a -> a -> a
-Integer
1)

-- | Signal a 'TSem' (aka __V__ operation).
--
-- This operation adds\/releases a unit back to the semaphore
-- (i.e. increments the internal counter).
--
-- @since 1.6.1.0
signalTSem :: MonadSTM stm => TSem stm -> stm ()
signalTSem :: forall (stm :: * -> *). MonadSTM stm => TSem stm -> stm ()
signalTSem (TSem TVar stm Integer
t) = do
  Integer
i <- forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm Integer
t
  forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm Integer
t forall a b. (a -> b) -> a -> b
$! Integer
iforall a. Num a => a -> a -> a
+Integer
1

-- | Multi-signal a 'TSem'
--
-- This operation adds\/releases multiple units back to the semaphore
-- (i.e. increments the internal counter).
--
-- > signalTSem == signalTSemN 1
--
-- @since 1.6.1.0
signalTSemN :: MonadSTM stm => Natural -> TSem stm -> stm ()
signalTSemN :: forall (stm :: * -> *).
MonadSTM stm =>
Natural -> TSem stm -> stm ()
signalTSemN Natural
0 TSem stm
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
signalTSemN Natural
1 TSem stm
s = forall (stm :: * -> *). MonadSTM stm => TSem stm -> stm ()
signalTSem TSem stm
s
signalTSemN Natural
n (TSem TVar stm Integer
t) = do
  Integer
i <- forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm Integer
t
  forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm Integer
t forall a b. (a -> b) -> a -> b
$! Integer
i forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Integer
toInteger Natural
n