metrics 0.3.0.0 → 0.3.0.1

raw patch · 9 files changed

+376/−3 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

metrics.cabal +3/−3
tests/CounterTest.hs +70/−0
tests/EDR.hs +17/−0
tests/EWMA.hs +37/−0
tests/GaugeTest.hs +35/−0
tests/HistogramTest.hs +159/−0
tests/MeterTest.hs +49/−0
tests/RegistryTest.hs +2/−0
tests/TimerTest.hs +4/−0

metrics.cabal view

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                metrics-version:             0.3.0.0+version:             0.3.0.1 synopsis:            High-performance application metric tracking description:   A port of Coda Hale's excellent metrics library for the JVM@@ -27,7 +27,7 @@ cabal-version:       >=1.10 source-repository    head   type:                git-  location:            http://github.com/sanetracker/metrics+  location:            http://github.com/iand675/metrics  library   exposed-modules:     Data.HealthCheck@@ -72,7 +72,7 @@  test-suite             tests   main-is:             Main.hs-  -- other-modules:       CounterTest, ExponentiallyDecayingReservoirTest, GaugeTest, HistogramTest, MeterTest, RegistryTest, TimerTest+  other-modules:       CounterTest, EDR, EWMA, GaugeTest, HistogramTest, MeterTest, RegistryTest, TimerTest   hs-source-dirs:      tests   type:                exitcode-stdio-1.0   build-depends:       base,

+ tests/CounterTest.hs view

@@ -0,0 +1,70 @@+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+

+ tests/EDR.hs view

@@ -0,0 +1,17 @@+module EDR where+import Control.Monad.ST+import Data.Metrics.Reservoir+import Data.Metrics.Reservoir.ExponentiallyDecaying (reservoir)+import System.Random.MWC+import Test.QuickCheck++edrTests = [reservoirSizeIsLimited]++seed = runST (create >>= save)+testReservoir = testReservoir' 1028+testReservoir' size = reservoir 0.015 size 0 seed++reservoirSizeIsLimited :: Property+reservoirSizeIsLimited = forAll (choose (1, 5000)) $ \x ->+  forAll (choose (0, x * 2)) $ \y ->+    size ((iterate (update 1 1) $ testReservoir' x) !! y) <= x

+ tests/EWMA.hs view

@@ -0,0 +1,37 @@+module EWMA where+import Data.Metrics.Internal+import Data.Metrics.MovingAverage.ExponentiallyWeighted+import Test.QuickCheck++ewmaTests =+  [ property ticksDecreaseRateToZero+  , property ticksUpdateRate+  , constantRates+  , clearResetsRate+  ]++smallNumbers = choose (1, 10000)++ticksDecreaseRateToZero :: NonZero Double -> Property+ticksDecreaseRateToZero (NonZero x) = label "ticks decay rate towards 0" $ forAll smallNumbers $ \tc ->+  abs (rate (run !! tc)) < abs x+  where+    run = iterate tick $ update x $ empty 5 1++deltaEq :: Double -> Double -> Double -> Bool+deltaEq range x y = abs (x - y) <= range++ticksUpdateRate :: NonZero Double -> Property+ticksUpdateRate (NonZero x) = label "updating rate and ticking once returns current rate" $ deltaEq 0.005 (rate run) x+  where+    run = tick $ update x $ empty 5 1++constantRates :: Property+constantRates = label "constant rates" $ \(NonZero x) -> forAll smallNumbers $ \t ->+   deltaEq 0.005 x $ rate (iterate (tick . update x) (empty 5 1) !! t)++clearResetsRate :: Property+clearResetsRate = label "reset rate" $ property (clearedRate == 0)+  where+    clearedRate = rate $ clear $ updatedRate+    updatedRate = tick $ update 10 $ empty 5 1

+ tests/GaugeTest.hs view

@@ -0,0 +1,35 @@+module GaugeTest where+import Data.Metrics.Gauge+import Data.Metrics.Types+import Test.QuickCheck+import Test.QuickCheck.Monadic++gaugeTests :: [Property]+gaugeTests = [ testValue, testSet, testRatio ]++testValue :: Property+testValue = label "test retrieving gauge value" $ monadicIO $ do+  x <- pick arbitrary+  x' <- run $ do+    g <- gauge $ return x+    value g+  assert $ x == x'++testSet :: Property+testSet = label "test overwriting gauge action" $ monadicIO $ do+  x <- pick arbitrary+  y <- pick arbitrary+  z <- run $ do+    g <- gauge $ return x+    set g $ return y+    value g+  assert $ y == z++testRatio :: Property+testRatio = label "test creating a ratio gauge" $ monadicIO $ do+  x <- pick arbitrary+  (NonZero y) <- pick arbitrary+  z <- run $ do+    g <- gauge $ ratio (return x) (return y)+    value g+  assert $ z == (x / y)

+ tests/HistogramTest.hs view

@@ -0,0 +1,159 @@+module HistogramTest where+import Control.Concurrent.Async+import Data.Metrics.Histogram.Internal+import Data.Metrics.Snapshot+import Data.Metrics.Types+import System.Random.MWC+import System.Posix.Time+import Test.QuickCheck++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 <- sequence $ replicate 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 <- sequence $ replicate 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 <- sequence $ replicate 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 <- sequence $ replicate 10 (async $ task)+  mapM_ wait asyncs+  s <- snapshot h+  assertEqual "median" 49.5 $ median s++--testExponentialSampleLongIdle :: Test+--testExponentialSampleLongIdle ="" ~: test $ do+--	x <- with

+ tests/MeterTest.hs view

@@ -0,0 +1,49 @@+{-# LANGUAGE Rank2Types #-}+module MeterTest where+import Control.Monad+import Control.Monad.Primitive+import Control.Monad.ST+import Data.Metrics.Internal+import Data.Metrics.Meter.Internal+import Data.Metrics.Types+import Data.Primitive.MutVar+import Data.STRef+import Test.QuickCheck+import Test.QuickCheck.Monadic+import System.Posix.Types++smallCount :: Gen Int+smallCount = choose (0, 10000)++increment1s :: forall s. STRef s EpochTime -> ST s EpochTime+increment1s r = do+  modifySTRef r succ+  t <- readSTRef r+  return t++run1sMeter :: (forall s. Meter (ST s) -> ST s a) -> a+run1sMeter f = runST $ do+  r <- newSTRef 0+  m <- mkMeter $ increment1s r+  f m++meterCountTest :: Property+meterCountTest = label "mark increments count" $ monadicST $ do+  x <- pick smallCount+  let c = run1sMeter $ \m -> (replicateM_ x $ mark m) >> count m+  assert $ x == c+-- testMeter+-- testMeterThreaded+-- testOneMinuteRate++testTicks = runST $ do+  r <- newSTRef 0+  m <- mkMeter $ increment1s r+  mark m+  mark m+  mark m+  mark m+  mark m+  md <- readMutVar (fromMeter m)+  x <- readSTRef r+  return $ (meterLastTick md, x)

+ tests/RegistryTest.hs view

@@ -0,0 +1,2 @@+module RegistryTest where+import Test.QuickCheck

+ tests/TimerTest.hs view

@@ -0,0 +1,4 @@+module TimerTest where+import Test.QuickCheck++