{-# LANGUAGE DeriveDataTypeable #-}
module Control.Concurrent.STM.TSem
( TSem
, newTSem
, waitTSem
, signalTSem
, signalTSemN
) where
import Control.Concurrent.STM
import Control.Monad
import Data.Typeable
import Numeric.Natural
newtype TSem = TSem (TVar Integer)
deriving (TSem -> TSem -> Bool
(TSem -> TSem -> Bool) -> (TSem -> TSem -> Bool) -> Eq TSem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TSem -> TSem -> Bool
$c/= :: TSem -> TSem -> Bool
== :: TSem -> TSem -> Bool
$c== :: TSem -> TSem -> Bool
Eq, Typeable)
newTSem :: Integer -> STM TSem
newTSem :: Integer -> STM TSem
newTSem i :: Integer
i = (TVar Integer -> TSem) -> STM (TVar Integer) -> STM TSem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TVar Integer -> TSem
TSem (Integer -> STM (TVar Integer)
forall a. a -> STM (TVar a)
newTVar (Integer -> STM (TVar Integer)) -> Integer -> STM (TVar Integer)
forall a b. (a -> b) -> a -> b
$! Integer
i)
waitTSem :: TSem -> STM ()
waitTSem :: TSem -> STM ()
waitTSem (TSem t :: TVar Integer
t) = do
Integer
i <- TVar Integer -> STM Integer
forall a. TVar a -> STM a
readTVar TVar 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
<= 0) STM ()
forall a. STM a
retry
TVar Integer -> Integer -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Integer
t (Integer -> STM ()) -> Integer -> STM ()
forall a b. (a -> b) -> a -> b
$! (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)
signalTSem :: TSem -> STM ()
signalTSem :: TSem -> STM ()
signalTSem (TSem t :: TVar Integer
t) = do
Integer
i <- TVar Integer -> STM Integer
forall a. TVar a -> STM a
readTVar TVar Integer
t
TVar Integer -> Integer -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Integer
t (Integer -> STM ()) -> Integer -> STM ()
forall a b. (a -> b) -> a -> b
$! Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1
signalTSemN :: Natural -> TSem -> STM ()
signalTSemN :: Natural -> TSem -> STM ()
signalTSemN 0 _ = () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
signalTSemN 1 s :: TSem
s = TSem -> STM ()
signalTSem TSem
s
signalTSemN n :: Natural
n (TSem t :: TVar Integer
t) = do
Integer
i <- TVar Integer -> STM Integer
forall a. TVar a -> STM a
readTVar TVar Integer
t
TVar Integer -> Integer -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Integer
t (Integer -> STM ()) -> Integer -> STM ()
forall a b. (a -> b) -> a -> b
$! Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+(Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n)