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)
newtype TSem stm = TSem (TVar stm Integer)
newTSem :: MonadSTM stm => Integer -> stm (TSem stm)
newTSem :: forall (stm :: * -> *). MonadSTM stm => Integer -> stm (TSem stm)
newTSem Integer
i = (TVar stm Integer -> TSem stm)
-> stm (TVar stm Integer) -> stm (TSem stm)
forall a b. (a -> b) -> stm a -> stm b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TVar stm Integer -> TSem stm
forall (stm :: * -> *). TVar stm Integer -> TSem stm
TSem (Integer -> stm (TVar stm Integer)
forall a. a -> stm (TVar stm a)
forall (stm :: * -> *) a. MonadSTM stm => a -> stm (TVar stm a)
newTVar (Integer -> stm (TVar stm Integer))
-> Integer -> stm (TVar stm Integer)
forall a b. (a -> b) -> a -> b
$! Integer
i)
waitTSem :: MonadSTM stm => TSem stm -> stm ()
waitTSem :: forall (stm :: * -> *). MonadSTM stm => TSem stm -> stm ()
waitTSem (TSem TVar stm Integer
t) = do
Integer
i <- TVar stm Integer -> stm Integer
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm Integer
t
Bool -> stm () -> stm ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0) stm ()
forall (stm :: * -> *) a. MonadSTM stm => stm a
retry
TVar stm Integer -> Integer -> stm ()
forall a. TVar stm a -> a -> stm ()
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm Integer
t (Integer -> stm ()) -> Integer -> stm ()
forall a b. (a -> b) -> a -> b
$! (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)
signalTSem :: MonadSTM stm => TSem stm -> stm ()
signalTSem :: forall (stm :: * -> *). MonadSTM stm => TSem stm -> stm ()
signalTSem (TSem TVar stm Integer
t) = do
Integer
i <- TVar stm Integer -> stm Integer
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm Integer
t
TVar stm Integer -> Integer -> stm ()
forall a. TVar stm a -> a -> stm ()
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm Integer
t (Integer -> stm ()) -> Integer -> stm ()
forall a b. (a -> b) -> a -> b
$! Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1
signalTSemN :: MonadSTM stm => Natural -> TSem stm -> stm ()
signalTSemN :: forall (stm :: * -> *).
MonadSTM stm =>
Natural -> TSem stm -> stm ()
signalTSemN Natural
0 TSem stm
_ = () -> stm ()
forall a. a -> stm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
signalTSemN Natural
1 TSem stm
s = TSem stm -> stm ()
forall (stm :: * -> *). MonadSTM stm => TSem stm -> stm ()
signalTSem TSem stm
s
signalTSemN Natural
n (TSem TVar stm Integer
t) = do
Integer
i <- TVar stm Integer -> stm Integer
forall a. TVar stm a -> stm a
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> stm a
readTVar TVar stm Integer
t
TVar stm Integer -> Integer -> stm ()
forall a. TVar stm a -> a -> stm ()
forall (stm :: * -> *) a. MonadSTM stm => TVar stm a -> a -> stm ()
writeTVar TVar stm Integer
t (Integer -> stm ()) -> Integer -> stm ()
forall a b. (a -> b) -> a -> b
$! Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n