{-# LANGUAGE CPP #-}

module Network.Wai.Handler.Warp.Counter (
    Counter
  , newCounter
  , waitForZero
  , increase
  , decrease
  ) where

import Control.Concurrent.STM

import Network.Wai.Handler.Warp.Imports


newtype Counter = Counter (TVar Int)

newCounter :: IO Counter
newCounter :: IO Counter
newCounter = TVar Int -> Counter
Counter (TVar Int -> Counter) -> IO (TVar Int) -> IO Counter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
newTVarIO Int
0

waitForZero :: Counter -> IO ()
waitForZero :: Counter -> IO ()
waitForZero (Counter TVar Int
ref) = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Int
x <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
ref
    Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) STM ()
forall a. STM a
retry

increase :: Counter -> IO ()
increase :: Counter -> IO ()
increase (Counter TVar Int
ref) = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
ref ((Int -> Int) -> STM ()) -> (Int -> Int) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Int
x -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

decrease :: Counter -> IO ()
decrease :: Counter -> IO ()
decrease (Counter TVar Int
ref) = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
ref ((Int -> Int) -> STM ()) -> (Int -> Int) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Int
x -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1