Hello community, here is the log from the commit of package ghc-metrics for openSUSE:Factory checked in at 2017-03-03 17:51:01 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-metrics (Old) and /work/SRC/openSUSE:Factory/.ghc-metrics.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-metrics" Fri Mar 3 17:51:01 2017 rev:2 rq:461659 version:0.4.0.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-metrics/ghc-metrics.changes 2016-11-02 12:36:05.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-metrics.new/ghc-metrics.changes 2017-03-03 17:51:02.369997010 +0100 @@ -1,0 +2,5 @@ +Sun Feb 12 14:20:22 UTC 2017 - [email protected] + +- Update to version 0.4.0.1 with cabal2obs. + +------------------------------------------------------------------- Old: ---- metrics-0.3.0.2.tar.gz New: ---- metrics-0.4.0.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-metrics.spec ++++++ --- /var/tmp/diff_new_pack.v7AAhF/_old 2017-03-03 17:51:02.929917929 +0100 +++ /var/tmp/diff_new_pack.v7AAhF/_new 2017-03-03 17:51:02.933917365 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-metrics # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,35 +19,35 @@ %global pkg_name metrics %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.3.0.2 +Version: 0.4.0.1 Release: 0 Summary: High-performance application metric tracking License: MIT -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-ansi-terminal-devel BuildRequires: ghc-bytestring-devel BuildRequires: ghc-containers-devel BuildRequires: ghc-lens-devel -BuildRequires: ghc-mtl-devel BuildRequires: ghc-mwc-random-devel BuildRequires: ghc-primitive-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-text-devel BuildRequires: ghc-time-devel -BuildRequires: ghc-unix-devel +BuildRequires: ghc-transformers-base-devel +BuildRequires: ghc-transformers-devel +BuildRequires: ghc-unix-compat-devel BuildRequires: ghc-unordered-containers-devel BuildRequires: ghc-vector-algorithms-devel BuildRequires: ghc-vector-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} +BuildRequires: ghc-HUnit-devel BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-async-devel %endif -# End cabal-rpm deps %description A port of Coda Hale's excellent metrics library for the JVM @@ -78,20 +78,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache ++++++ metrics-0.3.0.2.tar.gz -> metrics-0.4.0.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/metrics.cabal new/metrics-0.4.0.1/metrics.cabal --- old/metrics-0.3.0.2/metrics.cabal 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/metrics.cabal 2017-01-04 15:18:06.000000000 +0100 @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: metrics -version: 0.3.0.2 +version: 0.4.0.1 synopsis: High-performance application metric tracking description: A port of Coda Hale's excellent metrics library for the JVM @@ -53,17 +53,18 @@ -- other-modules: -- other-extensions: - build-depends: base < 5, + build-depends: base >=4.8 && < 5, unordered-containers, text, - mtl, + transformers, vector, primitive, mwc-random, - unix, + transformers-base, vector-algorithms, containers, time, + unix-compat, lens, ansi-terminal, bytestring @@ -79,9 +80,10 @@ metrics, async, mwc-random, - unix, + HUnit, QuickCheck, primitive, lens default-language: Haskell2010 ghc-options: -rtsopts -threaded -with-rtsopts=-N + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Counter.hs new/metrics-0.4.0.1/src/Data/Metrics/Counter.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Counter.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Counter.hs 2017-01-04 15:14:52.000000000 +0100 @@ -1,4 +1,6 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Metrics.Counter -- Copyright : (c) Ian Duncan 2013 @@ -25,6 +27,7 @@ decrement', module Data.Metrics.Types ) where +import Control.Monad.Base import Control.Monad.Primitive import qualified Data.HashMap.Strict as H import Data.Metrics.Internal @@ -34,34 +37,44 @@ -- | A basic atomic counter. newtype Counter m = Counter { fromCounter :: MV m Int } -instance PrimMonad m => Count m (Counter m) where - count (Counter ref) = readMutVar ref +instance (MonadBase b m, PrimMonad b) => Count b m (Counter b) where + count (Counter ref) = liftBase $ readMutVar ref + {-# INLINEABLE count #-} + +instance (MonadBase b m, PrimMonad b) => Value b m (Counter b) Int where + value (Counter ref) = liftBase $ readMutVar ref + {-# INLINEABLE value #-} + +instance (MonadBase b m, PrimMonad b) => Set b m (Counter b) Int where + set (Counter ref) x = liftBase $ updateRef ref (const x) + {-# INLINEABLE set #-} -instance PrimMonad m => Value m (Counter m) Int where - value (Counter ref) = readMutVar ref - -instance PrimMonad m => Set m (Counter m) Int where - set (Counter ref) x = updateRef ref (const x) - -instance PrimMonad m => Clear m (Counter m) where +instance (MonadBase b m, PrimMonad b) => Clear b m (Counter b) where clear c = set c 0 + {-# INLINEABLE clear #-} -- | Create a new counter. -counter :: (Functor m, PrimMonad m) => m (Counter m) -counter = fmap Counter $ newMutVar 0 +counter :: (MonadBase b m, PrimMonad b) => m (Counter b) +counter = liftBase $ fmap Counter $ newMutVar 0 +{-# INLINEABLE counter #-} -- | Bump up a counter by 1. increment :: PrimMonad m => Counter m -> m () increment = flip increment' 1 +{-# INLINEABLE increment #-} -- | Add an arbitrary amount to a counter. increment' :: PrimMonad m => Counter m -> Int -> m () increment' (Counter ref) x = updateRef ref (+ x) +{-# INLINEABLE increment' #-} -- | Decrease the value of a counter by 1. decrement :: PrimMonad m => Counter m -> m () decrement = flip decrement' 1 +{-# INLINEABLE decrement #-} -- | Subtract an arbitrary amount from a counter. decrement' :: PrimMonad m => Counter m -> Int -> m () decrement' (Counter ref) x = updateRef ref (subtract x) +{-# INLINEABLE decrement' #-} + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Gauge.hs new/metrics-0.4.0.1/src/Data/Metrics/Gauge.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Gauge.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Gauge.hs 2017-01-04 15:14:52.000000000 +0100 @@ -1,5 +1,6 @@ -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} -- | A module representing a "Gauge", which is simply an action that returns the instantaneous measure of a value for charting. -- -- The action that provides the gauge's value may be replaced using "set", or read using "value". @@ -20,8 +21,8 @@ ) where import Control.Applicative import Control.Monad +import Control.Monad.Base import Control.Monad.Primitive -import qualified Data.HashMap.Strict as H import Data.Metrics.Internal import Data.Metrics.Types import Data.Primitive.MutVar @@ -30,16 +31,18 @@ newtype Gauge m = Gauge { fromGauge :: MV m (m Double) } -- | Create a new gauge from the given action. -gauge :: PrimMonad m => m Double -> m (Gauge m) +gauge :: (MonadBase b m, PrimMonad b) => b Double -> m (Gauge b) gauge m = do - r <- newMutVar m + r <- liftBase $ newMutVar m return $ Gauge r -instance (PrimMonad m) => Value m (Gauge m) Double where - value (Gauge r) = join $ readMutVar r +instance (MonadBase b m, PrimMonad b) => Value b m (Gauge b) Double where + value (Gauge r) = liftBase $ join $ readMutVar r + {-# INLINEABLE value #-} -instance (PrimMonad m) => Set m (Gauge m) (m Double) where - set (Gauge r) = updateRef r . const +instance (MonadBase b m, PrimMonad b) => Set b m (Gauge b) (b Double) where + set (Gauge r) = liftBase . updateRef r . const + {-# INLINEABLE set #-} -- | Compose multiple actions to create a ratio. Useful for graphing percentage information, e. g. -- @@ -49,3 +52,4 @@ -- @ ratio :: Applicative f => f Double -> f Double -> f Double ratio x y = (/) <$> x <*> y + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Histogram/Internal.hs new/metrics-0.4.0.1/src/Data/Metrics/Histogram/Internal.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Histogram/Internal.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Histogram/Internal.hs 2017-01-04 15:14:52.000000000 +0100 @@ -22,11 +22,11 @@ -- | A pure histogram that maintains a bounded reservoir of samples and basic statistical data about the samples. data Histogram = Histogram { histogramReservoir :: !R.Reservoir - , histogramCount :: !Int - , histogramMinVal :: !Double - , histogramMaxVal :: !Double - , histogramSum :: !Double - , histogramVariance :: !(Double, Double) + , histogramCount :: {-# UNPACK #-} !Int + , histogramMinVal :: {-# UNPACK #-} !Double + , histogramMaxVal :: {-# UNPACK #-} !Double + , histogramSum :: {-# UNPACK #-} !Double + , histogramVariance :: {-# UNPACK #-} !(Double, Double) } -- | Create a histogram using a custom reservoir. @@ -48,6 +48,7 @@ , histogramSum = 0 , histogramVariance = (-1, 0) } +{-# INLINEABLE clear #-} -- | Update statistics and the reservoir with a new sample. update :: Double -> NominalDiffTime -> Histogram -> Histogram @@ -64,12 +65,15 @@ where updatedCount = succ $ histogramCount s updatedReservoir = R.update v t $ histogramReservoir s +{-# INLINEABLE update #-} updateMin :: Double -> Double -> Double updateMin ox x = if isNaN ox || ox > x then x else ox +{-# INLINE updateMin #-} updateMax :: Double -> Double -> Double updateMax ox x = if isNaN ox || ox < x then x else ox +{-# INLINE updateMax #-} -- | Get the average of all samples since the histogram was created. mean :: Histogram -> Double @@ -78,15 +82,17 @@ go s = if histogramCount s > 0 then histogramSum s / fromIntegral (histogramCount s) else 0 +{-# INLINEABLE mean #-} -- | Get the standard deviation of all samples. stddev :: Histogram -> Double stddev = go where go s = if c > 0 - then (calculateVariance c $ snd $ histogramVariance s) ** 0.5 + then sqrt $ calculateVariance c $ snd $ histogramVariance s else 0 where c = histogramCount s +{-# INLINEABLE stddev #-} -- | Get the variance of all samples. variance :: Histogram -> Double @@ -96,6 +102,7 @@ then 0 else calculateVariance c $ snd $ histogramVariance s where c = histogramCount s +{-# INLINEABLE variance #-} -- | Get the minimum value of all samples. minVal :: Histogram -> Double @@ -112,9 +119,11 @@ -- | Get a snapshot of the current reservoir's samples. snapshot :: Histogram -> Snapshot snapshot = R.snapshot . histogramReservoir +{-# INLINEABLE snapshot #-} calculateVariance :: Int -> Double -> Double calculateVariance c v = if c <= 1 then 0 else v / (fromIntegral c - 1) +{-# INLINEABLE calculateVariance #-} updateVariance :: Int -> Double -> (Double, Double) -> (Double, Double) updateVariance _ !c (-1, y) = (c, 0) @@ -124,3 +133,5 @@ diff = c - x !l = x + diff / c' !r = y + diff * (c - l) +{-# INLINEABLE updateVariance #-} + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Histogram.hs new/metrics-0.4.0.1/src/Data/Metrics/Histogram.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Histogram.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Histogram.hs 2017-01-04 15:14:52.000000000 +0100 @@ -1,5 +1,7 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} -- | Histogram metrics allow you to measure not just easy things like the min, mean, max, and standard deviation of values, but also quantiles like the median or 95th percentile. -- -- Traditionally, the way the median (or any other quantile) is calculated is to take the entire data set, sort it, and take the value in the middle (or 1% from the end, for the 99th percentile). This works for small data sets, or batch processing systems, but not for high-throughput, low-latency services. @@ -10,66 +12,81 @@ histogram, exponentiallyDecayingHistogram, uniformHistogram, + uniformSampler, module Data.Metrics.Types ) where -import Control.Monad.Primitive +import Control.Monad.Base +import Control.Monad.Primitive import qualified Data.Metrics.Histogram.Internal as P -import Data.Metrics.Internal -import Data.Metrics.Types -import Data.Metrics.Reservoir (Reservoir) -import Data.Metrics.Reservoir.Uniform (unsafeReservoir) -import Data.Metrics.Reservoir.ExponentiallyDecaying (reservoir) -import Data.Primitive.MutVar -import Data.Time.Clock -import Data.Time.Clock.POSIX -import System.Random.MWC +import Data.Metrics.Internal +import Data.Metrics.Types +import Data.Metrics.Reservoir (Reservoir) +import Data.Metrics.Reservoir.Uniform (unsafeReservoir) +import Data.Metrics.Reservoir.ExponentiallyDecaying (reservoir) +import Data.Primitive.MutVar +import Data.Time.Clock +import Data.Time.Clock.POSIX +import System.Random.MWC -- | A measure of the distribution of values in a stream of data. data Histogram m = Histogram - { fromHistogram :: MV m P.Histogram - , histogramGetSeconds :: m NominalDiffTime + { fromHistogram :: !(MV m P.Histogram) + , histogramGetSeconds :: !(m NominalDiffTime) } -instance PrimMonad m => Clear m (Histogram m) where - clear h = do +instance (MonadBase b m, PrimMonad b) => Clear b m (Histogram b) where + clear h = liftBase $ do t <- histogramGetSeconds h updateRef (fromHistogram h) $ P.clear t + {-# INLINEABLE clear #-} -instance PrimMonad m => Update m (Histogram m) Double where - update h x = do +instance (MonadBase b m, PrimMonad b) => Update b m (Histogram b) Double where + update h x = liftBase $ do t <- histogramGetSeconds h updateRef (fromHistogram h) $ P.update x t + {-# INLINEABLE update #-} -instance PrimMonad m => Count m (Histogram m) where - count h = readMutVar (fromHistogram h) >>= return . P.count +instance (MonadBase b m, PrimMonad b) => Count b m (Histogram b) where + count h = liftBase $ fmap P.count $ readMutVar (fromHistogram h) + {-# INLINEABLE count #-} -instance PrimMonad m => Statistics m (Histogram m) where - mean h = applyWithRef (fromHistogram h) P.mean - stddev h = applyWithRef (fromHistogram h) P.stddev - variance h = applyWithRef (fromHistogram h) P.variance - maxVal h = readMutVar (fromHistogram h) >>= return . P.maxVal - minVal h = readMutVar (fromHistogram h) >>= return . P.minVal +instance (MonadBase b m, PrimMonad b) => Statistics b m (Histogram b) where + mean h = liftBase $ applyWithRef (fromHistogram h) P.mean + {-# INLINEABLE mean #-} -instance PrimMonad m => TakeSnapshot m (Histogram m) where - snapshot h = applyWithRef (fromHistogram h) P.snapshot + stddev h = liftBase $ applyWithRef (fromHistogram h) P.stddev + {-# INLINEABLE stddev #-} + + variance h = liftBase $ applyWithRef (fromHistogram h) P.variance + {-# INLINEABLE variance #-} + + maxVal h = liftBase $ fmap P.maxVal $ readMutVar (fromHistogram h) + {-# INLINEABLE maxVal #-} + + minVal h = liftBase $ fmap P.minVal $ readMutVar (fromHistogram h) + {-# INLINEABLE minVal #-} + +instance (MonadBase b m, PrimMonad b) => TakeSnapshot b m (Histogram b) where + snapshot h = liftBase $ applyWithRef (fromHistogram h) P.snapshot + {-# INLINEABLE snapshot #-} -- | Create a histogram using a custom time data supplier function and a custom reservoir. -histogram :: PrimMonad m => m NominalDiffTime -> Reservoir -> m (Histogram m) +histogram :: (MonadBase b m, PrimMonad b) => b NominalDiffTime -> Reservoir -> m (Histogram b) histogram t r = do - v <- newMutVar $ P.histogram r + v <- liftBase $ newMutVar $ P.histogram r return $ Histogram v t -- | A histogram that gives all entries an equal likelihood of being evicted. -- -- Probably not what you want for most time-series data. -uniformHistogram :: Seed -> IO (Histogram IO) -uniformHistogram s = histogram getPOSIXTime $ unsafeReservoir s 1028 +uniformHistogram :: MonadBase IO m => Seed -> m (Histogram IO) +uniformHistogram s = liftBase $ histogram getPOSIXTime $ unsafeReservoir s 1028 -- | The recommended histogram type. It provides a fast histogram that -- probabilistically evicts older entries using a weighting system. This -- ensures that snapshots remain relatively fresh. -exponentiallyDecayingHistogram :: IO (Histogram IO) -exponentiallyDecayingHistogram = do +exponentiallyDecayingHistogram :: MonadBase IO m => m (Histogram IO) +exponentiallyDecayingHistogram = liftBase $ do t <- getPOSIXTime s <- createSystemRandom >>= save histogram getPOSIXTime $ reservoir 0.015 1028 t s @@ -77,5 +94,3 @@ uniformSampler :: Seed -> P.Histogram uniformSampler s = P.histogram (unsafeReservoir s 1028) -nan :: Double -nan = 0 / 0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Internal.hs new/metrics-0.4.0.1/src/Data/Metrics/Internal.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Internal.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Internal.hs 2017-01-04 15:14:52.000000000 +0100 @@ -18,6 +18,7 @@ updateRef r f = do b <- atomicModifyMutVar r (\x -> let (a, b) = (f x, ()) in (a, a `seq` b)) b `seq` return b +{-# INLINE updateRef #-} -- | Strictly apply a function on a MutVar while blocking other access to it. -- @@ -26,6 +27,7 @@ applyWithRef r f = do b <- atomicModifyMutVar r (\x -> let app = f x in let (a, b) = (x, app) in (a, a `seq` b)) b `seq` return b +{-# INLINE applyWithRef #-} -- | A function which combines the previous two, updating a value atomically -- and then returning some value calculated with the update in a single step. @@ -37,6 +39,7 @@ let (a, b) = (appA, appB) in (a, a `seq` b) b `seq` return b +{-# INLINE updateAndApplyToRef #-} -- | MutVar (PrimState m) is a little verbose. type MV m = MutVar (PrimState m) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Meter/Internal.hs new/metrics-0.4.0.1/src/Data/Metrics/Meter/Internal.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Meter/Internal.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Meter/Internal.hs 2017-01-04 15:14:52.000000000 +0100 @@ -13,7 +13,8 @@ fiveMinuteAverage, fifteenMinuteAverage, tickIfNecessary, - count + count, + lastTick ) where import Control.Lens import Control.Lens.TH @@ -21,7 +22,7 @@ import qualified Data.Metrics.MovingAverage as M data Meter = Meter - { meterCount :: !Int + { meterCount :: {-# UNPACK #-} !Int , meterOneMinuteRate :: !M.MovingAverage , meterFiveMinuteRate :: !M.MovingAverage , meterFifteenMinuteRate :: !M.MovingAverage @@ -52,6 +53,7 @@ where updateMeter = M.update $ fromIntegral c ticked = tickIfNecessary t m +{-# INLINEABLE mark #-} clear :: NominalDiffTime -> Meter -> Meter clear t = @@ -61,9 +63,11 @@ (oneMinuteRate %~ M.clear) . (fiveMinuteRate %~ M.clear) . (fifteenMinuteRate %~ M.clear) +{-# INLINEABLE clear #-} tick :: Meter -> Meter tick = (oneMinuteRate %~ M.tick) . (fiveMinuteRate %~ M.tick) . (fifteenMinuteRate %~ M.tick) +{-# INLINEABLE tick #-} tickIfNecessary :: NominalDiffTime -> Meter -> Meter tickIfNecessary new d = if age >= 5 @@ -73,6 +77,7 @@ age = new - meterLastTick d swapped = meterLastTick d < new latest = Prelude.max (meterLastTick d) new +{-# INLINEABLE tickIfNecessary #-} meanRate :: NominalDiffTime -> Meter -> Double meanRate t d = if c == 0 @@ -82,6 +87,7 @@ c = meterCount d start = meterStartTime d elapsed = fromEnum t - fromEnum start +{-# INLINEABLE meanRate #-} oneMinuteAverage :: Meter -> M.MovingAverage oneMinuteAverage = meterOneMinuteRate diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Meter.hs new/metrics-0.4.0.1/src/Data/Metrics/Meter.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Meter.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Meter.hs 2017-01-04 15:14:52.000000000 +0100 @@ -1,5 +1,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} -- | A meter measures the rate at which a set of events occur: -- -- Meters measure the rate of the events in a few different ways. The mean rate is the average rate of events. It’s generally useful for trivia, but as it represents the total rate for your application’s entire lifetime (e.g., the total number of requests handled, divided by the number of seconds the process has been running), it doesn’t offer a sense of recency. Luckily, meters also record three different exponentially-weighted moving average rates: the 1-, 5-, and 15-minute moving averages. @@ -10,9 +11,12 @@ meter, mark, mark', + mkMeter, + fromMeter, module Data.Metrics.Types ) where import Control.Lens +import Control.Monad.Base import Control.Monad.Primitive import Data.Primitive.MutVar import Data.Time.Clock @@ -26,36 +30,46 @@ -- | A measure of the /rate/ at which a set of events occurs. data Meter m = Meter - { fromMeter :: !(MV m P.Meter) + { fromMeter :: !(MV m P.Meter) , meterGetSeconds :: !(m NominalDiffTime) } -instance PrimMonad m => Rate m (Meter m) where - oneMinuteRate m = do +instance (MonadBase b m, PrimMonad b) => Rate b m (Meter b) where + oneMinuteRate m = liftBase $ do t <- meterGetSeconds m updateAndApplyToRef (fromMeter m) (P.tickIfNecessary t) (A.rate . P.oneMinuteAverage) - fiveMinuteRate m = do + {-# INLINEABLE oneMinuteRate #-} + + fiveMinuteRate m = liftBase $ do t <- meterGetSeconds m updateAndApplyToRef (fromMeter m) (P.tickIfNecessary t) (A.rate . P.fiveMinuteAverage) - fifteenMinuteRate m = do + {-# INLINEABLE fiveMinuteRate #-} + + fifteenMinuteRate m = liftBase $ do t <- meterGetSeconds m updateAndApplyToRef (fromMeter m) (P.tickIfNecessary t) (A.rate . P.fifteenMinuteAverage) - meanRate m = do + {-# INLINEABLE fifteenMinuteRate #-} + + meanRate m = liftBase $ do t <- meterGetSeconds m applyWithRef (fromMeter m) $ P.meanRate t + {-# INLINEABLE meanRate #-} -instance PrimMonad m => Count m (Meter m) where - count m = readMutVar (fromMeter m) >>= return . view P.count +instance (MonadBase b m, PrimMonad m) => Count b m (Meter m) where + count = fmap (view P.count) . readMutVar . fromMeter + {-# INLINEABLE count #-} -- | Register multiple occurrences of an event. mark' :: PrimMonad m => Meter m -> Int -> m () mark' m x = do t <- meterGetSeconds m updateRef (fromMeter m) (P.mark t x) +{-# INLINEABLE mark' #-} -- | Register a single occurrence of an event. mark :: PrimMonad m => Meter m -> m () mark = flip mark' 1 +{-# INLINEABLE mark #-} -- | Create a new meter using an exponentially weighted moving average meter :: IO (Meter IO) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/MovingAverage/ExponentiallyWeighted.hs new/metrics-0.4.0.1/src/Data/Metrics/MovingAverage/ExponentiallyWeighted.hs --- old/metrics-0.3.0.2/src/Data/Metrics/MovingAverage/ExponentiallyWeighted.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/MovingAverage/ExponentiallyWeighted.hs 2017-01-04 15:14:52.000000000 +0100 @@ -39,17 +39,18 @@ -- -- This type encapsulates the state needed for the exponentially weighted "MovingAverage" implementation. data ExponentiallyWeightedMovingAverage = ExponentiallyWeightedMovingAverage - { exponentiallyWeightedMovingAverageUncounted :: !Double - , exponentiallyWeightedMovingAverageCurrentRate :: !Double + { exponentiallyWeightedMovingAverageUncounted :: {-# UNPACK #-} !Double + , exponentiallyWeightedMovingAverageCurrentRate :: {-# UNPACK #-} !Double , exponentiallyWeightedMovingAverageInitialized :: !Bool - , exponentiallyWeightedMovingAverageInterval :: !Double - , exponentiallyWeightedMovingAverageAlpha :: !Double + , exponentiallyWeightedMovingAverageInterval :: {-# UNPACK #-} !Double + , exponentiallyWeightedMovingAverageAlpha :: {-# UNPACK #-} !Double } deriving (Show) makeFields ''ExponentiallyWeightedMovingAverage makeAlpha :: Double -> Minutes -> Double makeAlpha i m = 1 - exp (negate i / 60 / fromIntegral m) +{-# INLINE makeAlpha #-} -- | Create a new "MovingAverage" with 5 second tick intervals for a one-minute window. new1MinuteMovingAverage :: MA.MovingAverage @@ -76,20 +77,24 @@ -- | Reset the moving average rate to zero. clear :: ExponentiallyWeightedMovingAverage -> ExponentiallyWeightedMovingAverage clear = (initialized .~ False) . (currentRate .~ 0) . (uncounted .~ 0) +{-# INLINEABLE clear #-} -- | Get the current rate of the "ExponentiallyWeightedMovingAverage" for the given window. rate :: ExponentiallyWeightedMovingAverage -> Double rate e = (e ^. currentRate) * (e ^. interval) +{-# INLINEABLE rate #-} -- | Create a new "ExpontiallyWeightedMovingAverage" with the given tick interval and averaging window. empty :: Double -- ^ The interval in seconds between ticks -> Minutes -- ^ The duration in minutes which the moving average covers -> ExponentiallyWeightedMovingAverage empty i m = ExponentiallyWeightedMovingAverage 0 0 False i $ makeAlpha i m +{-# INLINEABLE empty #-} -- | Update the moving average based upon the given value update :: Double -> ExponentiallyWeightedMovingAverage -> ExponentiallyWeightedMovingAverage update = (uncounted +~) +{-# INLINEABLE update #-} -- | Update the moving average as if the given interval between ticks has passed. tick :: ExponentiallyWeightedMovingAverage -> ExponentiallyWeightedMovingAverage @@ -99,3 +104,4 @@ updateRate a = if a ^. initialized then currentRate +~ ((a ^. alpha) * (instantRate - a ^. currentRate)) $ a else currentRate .~ instantRate $ a +{-# INLINEABLE tick #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/MovingAverage.hs new/metrics-0.4.0.1/src/Data/Metrics/MovingAverage.hs --- old/metrics-0.3.0.2/src/Data/Metrics/MovingAverage.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/MovingAverage.hs 2017-01-04 15:14:52.000000000 +0100 @@ -26,16 +26,20 @@ -- | Reset a moving average back to a starting state. clear :: MovingAverage -> MovingAverage clear (MovingAverage c u t r s) = MovingAverage c u t r (c s) +{-# INLINEABLE clear #-} -- | Get the current rate of the moving average. rate :: MovingAverage -> Double rate (MovingAverage _ _ _ r s) = r s +{-# INLINEABLE rate #-} -- | Update the average based upon an interval specified by the -- moving average implementation. tick :: MovingAverage -> MovingAverage tick (MovingAverage c u t r s) = MovingAverage c u t r (t s) +{-# INLINEABLE tick #-} -- | Update the average with the specified value. update :: Double -> MovingAverage -> MovingAverage update x (MovingAverage c u t r s) = MovingAverage c u t r (u x s) +{-# INLINEABLE update #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Registry.hs new/metrics-0.4.0.1/src/Data/Metrics/Registry.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Registry.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Registry.hs 2017-01-04 15:14:52.000000000 +0100 @@ -49,7 +49,7 @@ Nothing -> do c <- m putMVar (metrics r) $! H.insert t (MetricCounter c) hm - return $! Just c + return $ Just c Just im -> do putMVar (metrics r) hm return $! case im of @@ -63,7 +63,7 @@ Nothing -> do g <- m putMVar (metrics r) $! H.insert t (MetricGauge g) hm - return $! Just g + return $ Just g Just im -> do putMVar (metrics r) hm return $! case im of @@ -77,7 +77,7 @@ Nothing -> do h <- m putMVar (metrics r) $! H.insert t (MetricHistogram h) hm - return $! Just h + return $ Just h Just im -> do putMVar (metrics r) hm return $! case im of @@ -91,7 +91,7 @@ Nothing -> do mv <- m putMVar (metrics r) $! H.insert t (MetricMeter mv) hm - return $! Just mv + return $ Just mv Just im -> do putMVar (metrics r) hm return $! case im of @@ -105,7 +105,7 @@ Nothing -> do mv <- m putMVar (metrics r) $! H.insert t (MetricTimer mv) hm - return $! Just mv + return $ Just mv Just im -> do putMVar (metrics r) hm return $! case im of diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Reservoir/ExponentiallyDecaying.hs new/metrics-0.4.0.1/src/Data/Metrics/Reservoir/ExponentiallyDecaying.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Reservoir/ExponentiallyDecaying.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Reservoir/ExponentiallyDecaying.hs 2017-01-04 15:14:52.000000000 +0100 @@ -32,7 +32,7 @@ import Data.Primitive.MutVar import qualified Data.Vector.Unboxed as V import Data.Word -import System.Posix.Time +import System.PosixCompat.Time import System.Posix.Types import System.Random.MWC @@ -47,7 +47,7 @@ { exponentiallyDecayingReservoirInnerSize :: {-# UNPACK #-} !Int , exponentiallyDecayingReservoirAlpha :: {-# UNPACK #-} !Double , exponentiallyDecayingReservoirRescaleThreshold :: {-# UNPACK #-} !Word64 - , exponentiallyDecayingReservoirInnerReservoir :: {-# UNPACK #-} !(M.Map Double Double) + , exponentiallyDecayingReservoirInnerReservoir :: !(M.Map Double Double) , exponentiallyDecayingReservoirCount :: {-# UNPACK #-} !Int , exponentiallyDecayingReservoirStartTime :: {-# UNPACK #-} !Word64 , exponentiallyDecayingReservoirNextScaleTime :: {-# UNPACK #-} !Word64 @@ -87,6 +87,7 @@ where t' = truncate t t'' = t' + c ^. rescaleThreshold +{-# INLINEABLE clear #-} -- | Get the current size of the reservoir. size :: ExponentiallyDecayingReservoir -> Int @@ -96,6 +97,7 @@ where c = r ^. count s = r ^. innerSize +{-# INLINEABLE size #-} -- | Get a snapshot of the current reservoir snapshot :: ExponentiallyDecayingReservoir -> Snapshot @@ -103,9 +105,11 @@ let svals = V.fromList $ M.elems $ r ^. innerReservoir mvals <- V.unsafeThaw svals takeSnapshot mvals +{-# INLINEABLE snapshot #-} weight :: Double -> Word64 -> Double weight alpha t = exp (alpha * fromIntegral t) +{-# INLINE weight #-} -- | \"A common feature of the above techniques—indeed, the key technique that -- allows us to track the decayed weights efficiently – is that they maintain @@ -134,6 +138,7 @@ adjustKey x = x * exp (-_alpha * fromIntegral diff) adjustedReservoir = M.mapKeys adjustKey $ c ^. innerReservoir _alpha = c ^. alpha +{-# INLINEABLE rescale #-} -- | Insert a new sample into the reservoir. This may cause old sample values to be evicted -- based upon the probabilistic weighting given to the key at insertion time. @@ -163,4 +168,5 @@ p <- uniform g s' <- save g return (p :: Double, s') +{-# INLINEABLE update #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Reservoir/Uniform.hs new/metrics-0.4.0.1/src/Data/Metrics/Reservoir/Uniform.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Reservoir/Uniform.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Reservoir/Uniform.hs 2017-01-04 15:14:52.000000000 +0100 @@ -79,6 +79,7 @@ v' <- I.thaw v V.set v' 0 I.unsafeFreeze v' +{-# INLINEABLE clear #-} -- | Reset the reservoir to empty by performing an in-place modification of the reservoir. unsafeClear :: NominalDiffTime -> UniformReservoir -> UniformReservoir @@ -89,12 +90,14 @@ v' <- I.unsafeThaw v V.set v' 0 I.unsafeFreeze v' +{-# INLINEABLE unsafeClear #-} -- | Get the current size of the reservoir size :: UniformReservoir -> Int size = go where go c = min (c ^. count) (I.length $ c ^. innerReservoir) +{-# INLINEABLE size #-} -- | Take a snapshot of the reservoir by doing an in-place unfreeze. -- @@ -105,6 +108,7 @@ go c = runST $ do v' <- I.unsafeThaw $ c ^. innerReservoir S.takeSnapshot $ V.slice 0 (size c) v' +{-# INLINEABLE snapshot #-} -- | Perform an update of the reservoir by copying the internal vector. O(n) update :: Double -> NominalDiffTime -> UniformReservoir -> UniformReservoir @@ -126,6 +130,7 @@ v'' <- I.unsafeFreeze v' s <- save g return (s, v'') +{-# INLINEABLE update #-} -- | Perform an in-place update of the reservoir. O(1) unsafeUpdate :: Double -> NominalDiffTime -> UniformReservoir -> UniformReservoir @@ -147,4 +152,5 @@ v'' <- I.unsafeFreeze v' s <- save g return (s, v'') +{-# INLINEABLE unsafeUpdate #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Reservoir.hs new/metrics-0.4.0.1/src/Data/Metrics/Reservoir.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Reservoir.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Reservoir.hs 2017-01-04 15:14:52.000000000 +0100 @@ -29,17 +29,21 @@ -- | Reset a reservoir to its initial state. clear :: NominalDiffTime -> Reservoir -> Reservoir clear t (Reservoir c size ss u st) = Reservoir c size ss u (c t st) +{-# INLINEABLE clear #-} -- | Get the current number of elements in the reservoir size :: Reservoir -> Int size (Reservoir _ size _ _ st) = size st +{-# INLINEABLE size #-} -- | Get a copy of all elements in the reservoir. snapshot :: Reservoir -> Snapshot snapshot (Reservoir _ _ ss _ st) = ss st +{-# INLINEABLE snapshot #-} -- | Update a reservoir with a new value. -- -- N.B. for some reservoir types, the latest value is not guaranteed to be retained in the reservoir. update :: Double -> NominalDiffTime -> Reservoir -> Reservoir update x t (Reservoir c size ss u st) = Reservoir c size ss u (u x t st) +{-# INLINEABLE update #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Snapshot.hs new/metrics-0.4.0.1/src/Data/Metrics/Snapshot.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Snapshot.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Snapshot.hs 2017-01-04 15:14:52.000000000 +0100 @@ -12,7 +12,6 @@ takeSnapshot ) where import Control.Monad.Primitive -import Data.Primitive.MutVar import Data.Vector.Algorithms.Intro import qualified Data.Vector.Unboxed as I import qualified Data.Vector.Unboxed.Mutable as V @@ -42,30 +41,31 @@ p999Q = 0.999 clamp :: Double -> Double -clamp x = if x > 1 - then 1 - else if x < 0 - then 0 - else x +clamp x | x > 1 = 1 + | x < 0 = 0 + | otherwise = x +{-# INLINE clamp #-} -- | A utility function for snapshotting data from an unsorted "MVector" of samples. -- -- NB: this function uses "unsafeFreeze" under the hood, so be sure that the vector being -- snapshotted is not used after calling this function. takeSnapshot :: PrimMonad m => V.MVector (PrimState m) Double -> m Snapshot -takeSnapshot v = V.clone v >>= \v' -> sort v' >> I.unsafeFreeze v' >>= return . Snapshot +takeSnapshot v = fmap Snapshot (V.clone v >>= \v' -> sort v' >> I.unsafeFreeze v') -- | Calculate an arbitrary quantile value for a "Snapshot". --- Values below zero or greater than one will be clamped to the range [0, 1] +-- Values below zero or greater than one will be clamped to the range [0, 1]. +-- Returns 0 if no values are in the snapshot quantile :: Double -> Snapshot -> Double -quantile quantile (Snapshot s) = if pos > fromIntegral (I.length s) - then I.last s - else if pos' < 1 - then I.head s - else lower + (pos - fromIntegral (floor pos :: Int)) * (upper - lower) +quantile quant (Snapshot s) + | I.length s == 0 = 0 + | pos > fromIntegral (I.length s) = I.last s + | pos' < 1 = I.head s + | otherwise = + lower + (pos - fromIntegral (floor pos :: Int)) * (upper - lower) where - q = clamp quantile - pos = q * (1 + (fromIntegral $ I.length s)) + q = clamp quant + pos = q * (1 + fromIntegral (I.length s)) pos' = truncate pos lower = I.unsafeIndex s (pos' - 1) upper = I.unsafeIndex s pos' @@ -98,3 +98,4 @@ get999thPercentile :: Snapshot -> Double get999thPercentile = quantile p999Q + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Timer/Internal.hs new/metrics-0.4.0.1/src/Data/Metrics/Timer/Internal.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Timer/Internal.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Timer/Internal.hs 2017-01-04 15:14:52.000000000 +0100 @@ -16,7 +16,7 @@ import qualified Data.Metrics.Snapshot as S data Timer = Timer - { timerMeter :: !M.Meter + { timerMeter :: !M.Meter , timerHistogram :: !H.Histogram } @@ -24,43 +24,57 @@ tickIfNecessary :: NominalDiffTime -> Timer -> Timer tickIfNecessary t = meter %~ M.tickIfNecessary t +{-# INLINE tickIfNecessary #-} snapshot :: Timer -> S.Snapshot snapshot = H.snapshot . timerHistogram +{-# INLINEABLE snapshot #-} oneMinuteRate :: Timer -> Double oneMinuteRate = A.rate . M.oneMinuteAverage . timerMeter +{-# INLINEABLE oneMinuteRate #-} fiveMinuteRate :: Timer -> Double fiveMinuteRate = A.rate . M.fiveMinuteAverage . timerMeter +{-# INLINEABLE fiveMinuteRate #-} fifteenMinuteRate :: Timer -> Double fifteenMinuteRate = A.rate . M.fifteenMinuteAverage . timerMeter +{-# INLINEABLE fifteenMinuteRate #-} meanRate :: NominalDiffTime -> Timer -> Double meanRate t = M.meanRate t . timerMeter +{-# INLINEABLE meanRate #-} count :: Timer -> Int count = H.count . view histogram +{-# INLINEABLE count #-} clear :: NominalDiffTime -> Timer -> Timer clear t = (histogram %~ H.clear t) . (meter %~ M.clear t) +{-# INLINEABLE clear #-} update :: NominalDiffTime -> Double -> Timer -> Timer update t x = (histogram %~ H.update x t) . (meter %~ M.mark t 1) +{-# INLINEABLE update #-} mean :: Timer -> Double mean = H.mean . timerHistogram +{-# INLINEABLE mean #-} stddev :: Timer -> Double stddev = H.stddev . timerHistogram +{-# INLINEABLE stddev #-} variance :: Timer -> Double variance = H.variance . timerHistogram +{-# INLINEABLE variance #-} maxVal :: Timer -> Double maxVal = H.maxVal . timerHistogram +{-# INLINEABLE maxVal #-} minVal :: Timer -> Double minVal = H.minVal . timerHistogram +{-# INLINEABLE minVal #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Timer.hs new/metrics-0.4.0.1/src/Data/Metrics/Timer.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Timer.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Timer.hs 2017-01-04 15:14:52.000000000 +0100 @@ -1,7 +1,9 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE UndecidableInstances #-} -- | A timer is basically a histogram of the duration of a type of event and a meter of the rate of its occurrence. module Data.Metrics.Timer ( Timer, @@ -13,6 +15,7 @@ import Control.Applicative import Control.Lens import Control.Lens.TH +import Control.Monad.Base import Control.Monad.Primitive import qualified Data.Metrics.MovingAverage.ExponentiallyWeighted as E import qualified Data.Metrics.Histogram.Internal as H @@ -28,54 +31,56 @@ -- | A measure of time statistics for the duration of an event data Timer m = Timer - { fromTimer :: !(MutVar (PrimState m) P.Timer) -- ^ A reference to the pure timer internals - , timerGetTime :: !(m NominalDiffTime) -- ^ The function that provides time differences for the timer. In practice, this is usually just "getPOSIXTime" + { fromTimer :: !(MutVar (PrimState m) P.Timer) + -- ^ A reference to the pure timer internals + , timerGetTime :: !(m NominalDiffTime) + -- ^ The function that provides time differences for the timer. In practice, this is usually just "getPOSIXTime" } makeFields ''Timer -instance PrimMonad m => Clear m (Timer m) where - clear t = do +instance (MonadBase b m, PrimMonad b) => Clear b m (Timer b) where + clear t = liftBase $ do ts <- timerGetTime t updateRef (fromTimer t) $ P.clear ts -instance PrimMonad m => Update m (Timer m) Double where - update t x = do +instance (MonadBase b m, PrimMonad b) => Update b m (Timer b) Double where + update t x = liftBase $ do ts <- timerGetTime t updateRef (fromTimer t) $ P.update ts x -instance PrimMonad m => Count m (Timer m) where - count t = readMutVar (fromTimer t) >>= return . P.count +instance (MonadBase b m, PrimMonad b) => Count b m (Timer b) where + count t = liftBase $ fmap P.count $ readMutVar (fromTimer t) -instance (Functor m, PrimMonad m) => Statistics m (Timer m) where - mean t = applyWithRef (fromTimer t) P.mean - stddev t = applyWithRef (fromTimer t) P.stddev - variance t = applyWithRef (fromTimer t) P.variance - maxVal t = P.maxVal <$> readMutVar (fromTimer t) - minVal t = P.minVal <$> readMutVar (fromTimer t) +instance (MonadBase b m, PrimMonad b) => Statistics b m (Timer b) where + mean t = liftBase $ applyWithRef (fromTimer t) P.mean + stddev t = liftBase $ applyWithRef (fromTimer t) P.stddev + variance t = liftBase $ applyWithRef (fromTimer t) P.variance + maxVal t = liftBase $ P.maxVal <$> readMutVar (fromTimer t) + minVal t = liftBase $ P.minVal <$> readMutVar (fromTimer t) -instance PrimMonad m => Rate m (Timer m) where - oneMinuteRate t = do +instance (MonadBase b m, PrimMonad b) => Rate b m (Timer b) where + oneMinuteRate t = liftBase $ do ts <- timerGetTime t updateAndApplyToRef (fromTimer t) (P.tickIfNecessary ts) P.oneMinuteRate - fiveMinuteRate t = do + fiveMinuteRate t = liftBase $ do ts <- timerGetTime t updateAndApplyToRef (fromTimer t) (P.tickIfNecessary ts) P.fiveMinuteRate - fifteenMinuteRate t = do + fifteenMinuteRate t = liftBase $ do ts <- timerGetTime t updateAndApplyToRef (fromTimer t) (P.tickIfNecessary ts) P.fifteenMinuteRate - meanRate t = do + meanRate t = liftBase $ do ts <- timerGetTime t applyWithRef (fromTimer t) (P.meanRate ts) -instance PrimMonad m => TakeSnapshot m (Timer m) where - snapshot t = applyWithRef (fromTimer t) P.snapshot +instance (MonadBase b m, PrimMonad b) => TakeSnapshot b m (Timer b) where + snapshot t = liftBase $ applyWithRef (fromTimer t) P.snapshot -- | Create a timer using a custom function for retrieving the current time. -- -- This is mostly exposed for testing purposes: prefer using "timer" if possible. -mkTimer :: PrimMonad m => m NominalDiffTime -> Seed -> m (Timer m) -mkTimer mt s = do +mkTimer :: (MonadBase b m, PrimMonad b) => b NominalDiffTime -> Seed -> m (Timer b) +mkTimer mt s = liftBase $ do t <- mt let ewmaMeter = M.meterData (E.movingAverage 5) t let histogram = H.histogram $ R.reservoir 0.015 1028 t s @@ -85,19 +90,19 @@ -- | Create a standard "Timer" with an -- exponentially weighted moving average -- and an exponentially decaying histogram -timer :: IO (Timer IO) -timer = do +timer :: MonadBase IO m => m (Timer IO) +timer = liftBase $ do s <- withSystemRandom (asGenIO $ save) mkTimer getPOSIXTime s -- | Execute an action and record statistics about the -- duration of the event and the rate of event occurrence. -time :: Timer IO -> IO a -> IO a +time :: MonadBase IO m => Timer IO -> m a -> m a time t m = do let gt = t ^. getTime - ts <- gt + ts <- liftBase gt r <- m - tf <- gt + tf <- liftBase gt update t $ realToFrac $ tf - ts return r diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/src/Data/Metrics/Types.hs new/metrics-0.4.0.1/src/Data/Metrics/Types.hs --- old/metrics-0.3.0.2/src/Data/Metrics/Types.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/src/Data/Metrics/Types.hs 2017-01-04 15:14:52.000000000 +0100 @@ -1,9 +1,11 @@ {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE KindSignatures #-} -- | The main accessors for common stateful metric implementation data. module Data.Metrics.Types where import Control.Concurrent.MVar import Control.Monad.Primitive +import Data.Functor.Identity import Data.HashMap.Strict (HashMap) import Data.Metrics.Internal import Data.Metrics.Snapshot @@ -15,12 +17,12 @@ type Minutes = Int -- | Get the current count for the given metric. -class Count m a | a -> m where +class Count (b :: * -> *) m a | m -> b, a -> b where -- | retrieve a count count :: a -> m Int -- | Provides statistics from a histogram that tracks the standard moving average rates. -class Rate m a | a -> m where +class Rate (b :: * -> *) m a | m -> b, a -> b where -- | Get the average rate of occurrence for some sort of event for the past minute. oneMinuteRate :: a -> m Double -- | Get the average rate of occurrence for some sort of event for the past five minutes. @@ -31,23 +33,23 @@ meanRate :: a -> m Double -- | Gets the current value from a simple metric (i.e. a "Counter" or a "Gauge") -class Value m a v | a -> m v where +class Value (b :: * -> *) m a v | m -> b, a -> b v where value :: a -> m v -- | Update a metric by performing wholesale replacement of a value. -class Set m a v | a -> m v where +class Set (b :: * -> *) m a v | m -> b, a -> b v where -- | Replace the current value of a simple metric (i.e. a "Counter" or a "Gauge") set :: a -> v -> m () -- | Provides a way to reset metrics. This might be useful in a development environment -- or to periodically get a clean state for long-running processes. -class Clear m a | a -> m where +class Clear (b :: * -> *) m a | m -> b, a -> b where -- | Reset the metric to an 'empty' state. In practice, this should be -- equivalent to creating a new metric of the same type in-place. clear :: a -> m () -- | Provides the main interface for retrieving statistics tabulated by a histogram. -class Statistics m a | a -> m where +class Statistics (b :: * -> *) m a | m -> b, a -> b where -- | Gets the highest value encountered thus far. maxVal :: a -> m Double -- | Gets the lowest value encountered thus far. @@ -61,11 +63,12 @@ variance :: a -> m Double -- | Update statistics tracked by a metric with a new sample. -class Update m a v | a -> m v where +class Update (b :: * -> *) m a v | m -> b, a -> b v where -- | Feed a metric another value. update :: a -> v -> m () -- | Take a snapshot (a sorted vector) of samples used for calculating quantile data. -class TakeSnapshot m a | a -> m where +class TakeSnapshot (b :: * -> *) m a | m -> b, a -> b where -- | Get a sample of the values currently in a histogram or type that contains a histogram. snapshot :: a -> m Snapshot + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/tests/HistogramTest.hs new/metrics-0.4.0.1/tests/HistogramTest.hs --- old/metrics-0.3.0.2/tests/HistogramTest.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/tests/HistogramTest.hs 2017-01-04 15:14:52.000000000 +0100 @@ -1,11 +1,10 @@ module HistogramTest where import Control.Concurrent.Async -import Data.Metrics.Histogram.Internal +import Control.Monad +import Data.Metrics.Histogram import Data.Metrics.Snapshot -import Data.Metrics.Types import System.Random.MWC -import System.Posix.Time -import Test.QuickCheck +import Test.HUnit histogramTests :: [Test] histogramTests = @@ -37,9 +36,9 @@ withExponential :: (Histogram IO -> IO a) -> IO a withExponential f = do - seed <- withSystemRandom (asGenIO save) - t <- epochTime - h <- exponentiallyDecayingHistogram t seed + -- seed <- withSystemRandom (asGenIO save) + -- t <- epochTime + h <- exponentiallyDecayingHistogram -- t seed f h uniformTest :: Assertable a => String -> (Histogram IO -> IO a) -> Test @@ -72,14 +71,14 @@ testUniformSampleMeanThreaded :: Test testUniformSampleMeanThreaded = uniformTest "async uniform mean value" $ \h -> do let task = update h 5 >> update h 10 - asyncs <- sequence $ replicate 10 (async $ task) + 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] + mapM_ (update h) [0..1999] x <- maxVal h assert $ x == 1999 @@ -89,14 +88,14 @@ testUniformSampleSnapshot :: Test testUniformSampleSnapshot = uniformTest "uniform snapshot" $ \h -> do - mapM_ (update h $) [0..99] + 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) + let task = mapM_ (update h) [0..99] + asyncs <- replicateM 10 (async task) mapM_ wait asyncs s <- snapshot h assertEqual "median" 49.5 $ median s @@ -125,14 +124,14 @@ testExponentialSampleMeanThreaded :: Test testExponentialSampleMeanThreaded = exponentialTest "mean threaded" $ \h -> do let task = update h 5 >> update h 10 - asyncs <- sequence $ replicate 10 (async $ task) + 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] + mapM_ (update h) [0..1999] x <- maxVal h assertEqual "max" 1999 x @@ -142,14 +141,14 @@ testExponentialSampleSnapshot :: Test testExponentialSampleSnapshot = exponentialTest "snapshot" $ \h -> do - mapM_ (update h $) [0..99] + 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) + let task = mapM_ (update h) [0..99] + asyncs <- replicateM 10 (async task) mapM_ wait asyncs s <- snapshot h assertEqual "median" 49.5 $ median s diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/metrics-0.3.0.2/tests/MeterTest.hs new/metrics-0.4.0.1/tests/MeterTest.hs --- old/metrics-0.3.0.2/tests/MeterTest.hs 2015-07-06 00:03:48.000000000 +0200 +++ new/metrics-0.4.0.1/tests/MeterTest.hs 2017-01-04 15:14:52.000000000 +0100 @@ -1,10 +1,12 @@ {-# LANGUAGE Rank2Types #-} module MeterTest where +import Control.Lens import Control.Monad import Control.Monad.Primitive import Control.Monad.ST import Data.Metrics.Internal -import Data.Metrics.Meter.Internal +import Data.Metrics.Meter +import Data.Metrics.Meter.Internal (lastTick) import Data.Metrics.Types import Data.Primitive.MutVar import Data.STRef @@ -12,14 +14,16 @@ 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 :: Num a => STRef s a -> ST s a increment1s r = do - modifySTRef r succ - t <- readSTRef r - return t + modifySTRef r (+ 1) + readSTRef r + run1sMeter :: (forall s. Meter (ST s) -> ST s a) -> a run1sMeter f = runST $ do @@ -27,15 +31,19 @@ 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 + let c = run1sMeter $ \m -> do + replicateM_ x (mark m) + count m assert $ x == c -- testMeter -- testMeterThreaded -- testOneMinuteRate + testTicks = runST $ do r <- newSTRef 0 m <- mkMeter $ increment1s r @@ -46,4 +54,6 @@ mark m md <- readMutVar (fromMeter m) x <- readSTRef r - return $ (meterLastTick md, x) + return $ (md ^. lastTick, x) + +
