metrics-0.3.0.1: tests/CounterTest.hs

module CounterTest where
import Control.Concurrent.Async
import Control.Monad
import Data.Metrics.Counter
import Data.Metrics.Types
import Test.QuickCheck
import Test.QuickCheck.Monadic

counterTests :: [Property]
counterTests =
  [ testIncrement
  , testIncrement'
  , testDecrement
  , testDecrement'
  , testConcurrent
  ]

smallCount :: Gen Int
smallCount = choose (0, 10000)

withCounter :: (Counter IO -> IO a) -> IO a
withCounter f = counter >>= f

testIncrement :: Property
testIncrement = label "single increment" $ monadicIO $ do
  x <- pick smallCount
  x' <- run $ do
    c <- counter
    replicateM_ x $ increment c
    count c
  assert (x == x')

testIncrement' :: Property
testIncrement' = label "higher increment" $ monadicIO $ do
  x <- pick smallCount
  x' <- run $ do
    c <- counter
    increment' c x
    count c
  assert $ x == x'

testDecrement :: Property
testDecrement = label "single decrement" $ monadicIO $ do
  x <- pick smallCount
  x' <- run $ do
    c <- counter
    replicateM_ x $ decrement c
    count c
  assert $ negate x == x'

testDecrement' :: Property
testDecrement' = label "higher decrement" $ monadicIO $ do
  x <- pick smallCount
  x' <- run $ do
    c <- counter
    decrement' c x
    count c
  assert $ negate x == x'

testConcurrent :: Property
testConcurrent = label "concurrently increment" $ monadicIO $ do
  x <- pick smallCount
  y <- pick (choose (0, 40) :: Gen Int)
  r <- run $ do
    c <- counter
    asyncs <- sequence $ take x $ repeat $ async $ replicateM_ y $ increment c
    mapM_ wait asyncs
    count c
  assert $ r == x * y