metrics-0.4.0.1: tests/HistogramTest.hs

module HistogramTest where
import Control.Concurrent.Async
import Control.Monad
import Data.Metrics.Histogram
import Data.Metrics.Snapshot
import System.Random.MWC
import Test.HUnit

histogramTests :: [Test]
histogramTests =
  [ testUniformSampleMin
  , testUniformSampleMax
  , testUniformSampleMean
  , testUniformSampleMeanThreaded
  , testUniformSample2000
--  , testUniformSample2000Threaded
  , testUniformSampleSnapshot
  , testUniformSampleSnapshotThreaded
  , testExponentialSampleMin
  , testExponentialSampleMax
  , testExponentialSampleMean
  , testExponentialSampleMeanThreaded
  , testExponentialSample2000
  --, testExponentialSample2000Threaded
  , testExponentialSampleSnapshot
  , testExponentialSampleSnapshotThreaded
--  , testExponentialSampleLongIdle
  ]


withUniform :: (Histogram IO -> IO a) -> IO a
withUniform f = do
  seed <- withSystemRandom (asGenIO save)
  h <- uniformHistogram seed
  f h

withExponential :: (Histogram IO -> IO a) -> IO a
withExponential f = do
  -- seed <- withSystemRandom (asGenIO save)
  -- t <- epochTime
  h <- exponentiallyDecayingHistogram -- t seed
  f h

uniformTest :: Assertable a => String -> (Histogram IO -> IO a) -> Test
uniformTest d f = d ~: test $ assert $ withUniform f

exponentialTest :: Assertable a => String -> (Histogram IO -> IO a) -> Test
exponentialTest d f = d ~: test $ assert $ withExponential f

testUniformSampleMin :: Test
testUniformSampleMin = uniformTest "uniform min value" $ \h -> do
  update h 5
  update h 10
  x <- minVal h
  assertEqual "min" 5 x

testUniformSampleMax :: Test
testUniformSampleMax = uniformTest "uniform max value" $ \h -> do
  update h 5
  update h 10
  x <- maxVal h
  assertEqual "max" 10 x

testUniformSampleMean :: Test
testUniformSampleMean = uniformTest "uniform mean value" $ \h -> do
  update h 5
  update h 10
  x <- mean h
  assertEqual "mean" 7.5 x

testUniformSampleMeanThreaded :: Test
testUniformSampleMeanThreaded = uniformTest "async uniform mean value" $ \h -> do
  let task = update h 5 >> update h 10
  asyncs <- replicateM 10 (async task)
  mapM_ wait asyncs
  x <- mean h
  assert $ x == 7.5

testUniformSample2000 :: Test
testUniformSample2000 = uniformTest "uniform sample 2000" $ \h -> do
  mapM_ (update h) [0..1999]
  x <- maxVal h
  assert $ x == 1999

--testUniformSample2000Threaded :: Test
--testUniformSample2000Threaded ="" ~: test $ do
--	x <- with

testUniformSampleSnapshot :: Test
testUniformSampleSnapshot = uniformTest "uniform snapshot" $ \h -> do
  mapM_ (update h) [0..99]
  s <- snapshot h
  assert $ median s == 49.5

testUniformSampleSnapshotThreaded :: Test
testUniformSampleSnapshotThreaded = uniformTest "async uniform snapshot" $ \h -> do
  let task = mapM_ (update h) [0..99]
  asyncs <- replicateM 10 (async task)
  mapM_ wait asyncs
  s <- snapshot h
  assertEqual "median" 49.5 $ median s

testExponentialSampleMin :: Test
testExponentialSampleMin = exponentialTest "minVal" $ \h -> do
  update h 5
  update h 10
  x <- minVal h
  assertEqual "min" 5 x

testExponentialSampleMax :: Test
testExponentialSampleMax = exponentialTest "maxVal" $ \h -> do
  update h 5
  update h 10
  x <- maxVal h
  assertEqual "max" 10 x

testExponentialSampleMean :: Test
testExponentialSampleMean = exponentialTest "mean" $ \h -> do
  update h 5
  update h 10
  x <- mean h
  assertEqual "mean" 7.5 x

testExponentialSampleMeanThreaded :: Test
testExponentialSampleMeanThreaded = exponentialTest "mean threaded" $ \h -> do
  let task = update h 5 >> update h 10
  asyncs <- replicateM 10 (async task)
  mapM_ wait asyncs
  x <- mean h
  assertEqual "mean" 7.5 x

testExponentialSample2000 :: Test
testExponentialSample2000 = exponentialTest "sample 2000" $ \h -> do
  mapM_ (update h) [0..1999]
  x <- maxVal h
  assertEqual "max" 1999 x

--testExponentialSample2000Threaded :: Test
--testExponentialSample2000Threaded = exponentialTest "async sample 2000" $ \h -> do
--	x <- with

testExponentialSampleSnapshot :: Test
testExponentialSampleSnapshot = exponentialTest "snapshot" $ \h -> do
    mapM_ (update h) [0..99]
    s <- snapshot h
    assertEqual "median" 49.5 $ median s

testExponentialSampleSnapshotThreaded :: Test
testExponentialSampleSnapshotThreaded = exponentialTest "async snapshot" $ \h -> do
  let task = mapM_ (update h) [0..99]
  asyncs <- replicateM 10 (async task)
  mapM_ wait asyncs
  s <- snapshot h
  assertEqual "median" 49.5 $ median s

--testExponentialSampleLongIdle :: Test
--testExponentialSampleLongIdle ="" ~: test $ do
--	x <- with