metrics 0.2.1.0 → 0.3.0.0

raw patch · 10 files changed

+187/−185 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• metrics.cabal +1/−1
• src/Data/Metrics/Histogram/Internal.hs +31/−30
• src/Data/Metrics/Meter/Internal.hs +22/−21
• src/Data/Metrics/MovingAverage/ExponentiallyWeighted.hs +6/−5
• src/Data/Metrics/Reporter/StdOut.hs +12/−26
• src/Data/Metrics/Reservoir.hs +5/−5
• src/Data/Metrics/Reservoir/ExponentiallyDecaying.hs +46/−45
• src/Data/Metrics/Reservoir/Uniform.hs +44/−33
• src/Data/Metrics/Timer.hs +7/−7
• src/Data/Metrics/Timer/Internal.hs +13/−12

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                metrics-version:             0.2.1.0+version:             0.3.0.0 synopsis:            High-performance application metric tracking description:   A port of Coda Hale's excellent metrics library for the JVM

@@ -20,12 +20,12 @@  -- | 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)+  { histogramReservoir :: !R.Reservoir+  , histogramCount :: !Int+  , histogramMinVal :: !Double+  , histogramMaxVal :: !Double+  , histogramSum :: !Double+  , histogramVariance :: !(Double, Double)   }  -- | Create a histogram using a custom reservoir.@@ -40,12 +40,12 @@ clear = go   where     go t s = s-      { _histogramReservoir = R.clear t $ _histogramReservoir s-      , _histogramCount = 0-      , _histogramMinVal = nan-      , _histogramMaxVal = nan-      , _histogramSum = 0-      , _histogramVariance = (-1, 0)+      { histogramReservoir = R.clear t $ histogramReservoir s+      , histogramCount = 0+      , histogramMinVal = nan+      , histogramMaxVal = nan+      , histogramSum = 0+      , histogramVariance = (-1, 0)       }  -- | Update statistics and the reservoir with a new sample.@@ -53,16 +53,16 @@ update = go   where     go v t s = s-      { _histogramReservoir = updatedReservoir-      , _histogramCount = updatedCount-      , _histogramMinVal = updateMin (_histogramMinVal s) v-      , _histogramMaxVal = updateMax (_histogramMaxVal s) v-      , _histogramSum = _histogramSum s + v-      , _histogramVariance = updateVariance updatedCount v $ _histogramVariance s+      { histogramReservoir = updatedReservoir+      , histogramCount = updatedCount+      , histogramMinVal = updateMin (histogramMinVal s) v+      , histogramMaxVal = updateMax (histogramMaxVal s) v+      , histogramSum = histogramSum s + v+      , histogramVariance = updateVariance updatedCount v $ histogramVariance s       }       where -        updatedCount = succ $ _histogramCount s-        updatedReservoir = R.update v t $ _histogramReservoir s+        updatedCount = succ $ histogramCount s+        updatedReservoir = R.update v t $ histogramReservoir s  updateMin :: Double -> Double -> Double updateMin ox x = if isNaN ox || ox > x then x else ox@@ -74,8 +74,8 @@ mean :: Histogram -> Double mean = go   where-    go s = if _histogramCount s > 0-      then _histogramSum s / fromIntegral (_histogramCount s)+    go s = if histogramCount s > 0+      then histogramSum s / fromIntegral (histogramCount s)       else 0  -- | Get the standard deviation of all samples.@@ -83,9 +83,9 @@ stddev = go   where     go s = if c > 0-      then (calculateVariance c $ snd $ _histogramVariance s) ** 0.5+      then (calculateVariance c $ snd $ histogramVariance s) ** 0.5       else 0-      where c = _histogramCount s+      where c = histogramCount s  -- | Get the variance of all samples. variance :: Histogram -> Double@@ -93,24 +93,24 @@   where     go s = if c <= 1       then 0-      else calculateVariance c $ snd $ _histogramVariance s-      where c = _histogramCount s+      else calculateVariance c $ snd $ histogramVariance s+      where c = histogramCount s  -- | Get the minimum value of all samples. minVal :: Histogram -> Double-minVal = _histogramMinVal+minVal = histogramMinVal  -- | Get the maximum value of all samples maxVal :: Histogram -> Double-maxVal = _histogramMaxVal+maxVal = histogramMaxVal  -- | Get the number of samples that the histogram has been updated with. count :: Histogram -> Int-count = _histogramCount+count = histogramCount  -- | Get a snapshot of the current reservoir's samples. snapshot :: Histogram -> Snapshot-snapshot = R.snapshot . _histogramReservoir+snapshot = R.snapshot . histogramReservoir  calculateVariance :: Int -> Double -> Double calculateVariance c v = if c <= 1 then 0 else v / (fromIntegral c - 1)@@ -123,3 +123,4 @@     diff = c - x     l = x + diff / c'     r = y + diff * (c - l)+

@@ -21,24 +21,24 @@ import qualified Data.Metrics.MovingAverage as M  data Meter = Meter-  { _meterCount :: !Int-  , _meterOneMinuteRate :: !M.MovingAverage-  , _meterFiveMinuteRate :: !M.MovingAverage-  , _meterFifteenMinuteRate :: !M.MovingAverage-  , _meterStartTime :: !NominalDiffTime-  , _meterLastTick :: !NominalDiffTime+  { meterCount             :: !Int+  , meterOneMinuteRate     :: !M.MovingAverage+  , meterFiveMinuteRate    :: !M.MovingAverage+  , meterFifteenMinuteRate :: !M.MovingAverage+  , meterStartTime         :: !NominalDiffTime+  , meterLastTick          :: !NominalDiffTime   }  makeFields ''Meter  meterData :: (Int -> M.MovingAverage) -> NominalDiffTime -> Meter meterData f t = Meter-  { _meterCount = 0-  , _meterOneMinuteRate = f 1-  , _meterFiveMinuteRate = f 5-  , _meterFifteenMinuteRate = f 15-  , _meterStartTime = t-  , _meterLastTick = t+  { meterCount = 0+  , meterOneMinuteRate = f 1+  , meterFiveMinuteRate = f 5+  , meterFifteenMinuteRate = f 15+  , meterStartTime = t+  , meterLastTick = t   }  -- TODO: make moving average prism@@ -67,27 +67,28 @@  tickIfNecessary :: NominalDiffTime -> Meter -> Meter tickIfNecessary new d = if age >= 5-  then iterate tick (d { _meterLastTick = latest }) !! (truncate age `div` 5)+  then iterate tick (d { meterLastTick = latest }) !! (truncate age `div` 5)   else d   where-    age = new - _meterLastTick d-    swapped = _meterLastTick d < new-    latest = Prelude.max (_meterLastTick d) new+    age = new - meterLastTick d+    swapped = meterLastTick d < new+    latest = Prelude.max (meterLastTick d) new  meanRate :: NominalDiffTime -> Meter -> Double meanRate t d = if c == 0   then 0   else fromIntegral c / fromIntegral elapsed   where-    c = _meterCount d-    start = _meterStartTime d+    c = meterCount d+    start = meterStartTime d     elapsed = fromEnum t - fromEnum start  oneMinuteAverage :: Meter -> M.MovingAverage-oneMinuteAverage = _meterOneMinuteRate+oneMinuteAverage = meterOneMinuteRate  fiveMinuteAverage :: Meter -> M.MovingAverage-fiveMinuteAverage = _meterFiveMinuteRate+fiveMinuteAverage = meterFiveMinuteRate  fifteenMinuteAverage :: Meter -> M.MovingAverage-fifteenMinuteAverage = _meterFifteenMinuteRate+fifteenMinuteAverage = meterFifteenMinuteRate+

@@ -3,6 +3,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-} -- | An exponentially-weighted moving average. -- -- see /UNIX Load Average Part 1: How It Works/:@@ -38,11 +39,11 @@ -- -- This type encapsulates the state needed for the exponentially weighted "MovingAverage" implementation. data ExponentiallyWeightedMovingAverage = ExponentiallyWeightedMovingAverage-  { _ewmaUncounted :: !Double-  , _ewmaCurrentRate :: !Double-  , _ewmaInitialized :: !Bool-  , _ewmaInterval :: !Double-  , _ewmaAlpha :: !Double+  { exponentiallyWeightedMovingAverageUncounted   :: !Double+  , exponentiallyWeightedMovingAverageCurrentRate :: !Double+  , exponentiallyWeightedMovingAverageInitialized :: !Bool+  , exponentiallyWeightedMovingAverageInterval    :: !Double+  , exponentiallyWeightedMovingAverageAlpha       :: !Double   } deriving (Show)  makeFields ''ExponentiallyWeightedMovingAverage

@@ -4,41 +4,27 @@ -- For more meaningful access to statistics, metrics should be sent to something like Librato or Graphite. module Data.Metrics.Reporter.StdOut (   printHealthCheck,-  printHealthChecks,-  reportMetrics,-  dumpMetrics+  printHealthChecks ) where-import Control.Applicative-import Control.Concurrent.MVar import qualified Data.HashMap.Strict as H import Data.HealthCheck-import Data.Metrics+import Data.Metrics.Internal+import Data.Metrics.Types import qualified Data.Text as T import qualified Data.Text.IO as T import System.Console.ANSI -prettyPrintMetric (m, v) = T.putStr m >> T.putStr ": " >> putStrLn v--reportMetrics :: MetricRegistry IO -> IO ()-reportMetrics m = dumpMetrics m >>= mapM_ prettyPrintMetric+--prettyPrintMetric (m, v) = T.putStr m >> T.putStr ": " >> putStrLn (show v) -dumpMetrics :: MetricRegistry IO -> IO [(T.Text, String)]-dumpMetrics r = do-  ms <- readMVar $ metrics r-  let readRep (k, metricVariety) = do-        display <- case metricVariety of-          (MetricGauge g) -> show <$> value g-          (MetricCounter c) -> show <$> value c-          (MetricHistogram h) -> return ""-          (MetricMeter m) -> do-            one <- (\x -> "\t" ++ show x ++ "/minute\n") <$> oneMinuteRate m-            five <- (\x -> "\t" ++ show x ++ "/5 minutes\n") <$> fiveMinuteRate m-            fifteen <- (\x -> "\t" ++ show x ++ "/15 minutes\n") <$> fifteenMinuteRate m-            return ("\n" ++ one ++ five ++ fifteen)-          (MetricTimer t) -> (\x -> show x ++ " s") <$> mean t-        return (k, display)-  mapM readRep $ H.toList ms+--reportMetrics :: MetricRegistry -> IO ()+--reportMetrics m = dumpMetrics m >>= mapM_ prettyPrintMetric +--dumpMetrics :: MetricRegistry -> IO [(T.Text, Double)]+--dumpMetrics r = do+--  ms <- readMVar $ metrics r+--  -- let readRep (k, (repAction, _)) = repAction >>= \rep -> return (k, rep)+--  -- mapM readRep $ H.toList ms+--  return [] fg = SetColor Foreground Vivid  -- | Pretty-print a single HealthCheck to the console using ANSI colors.

@@ -11,18 +11,18 @@ -- -- The two standard implementations are the ExponentiallyDecayingReservoir and the UniformReservoir. data Reservoir = forall s. Reservoir-  { _reservoirClear :: !(NominalDiffTime -> s -> s)+  { reservoirClear :: !(NominalDiffTime -> s -> s)   -- ^ An operation that resets a reservoir to its initial state-  , _reservoirSize :: !(s -> Int)+  , reservoirSize :: !(s -> Int)   -- ^ Retrieve current size of the reservoir.   -- This may or may not be constant depending on the specific implementation.-  , _reservoirSnapshot :: !(s -> Snapshot)+  , reservoirSnapshot :: !(s -> Snapshot)   -- ^ Take snapshot of the current reservoir.   --   -- The number of items in the snapshot should always match the reservoir's size.-  , _reservoirUpdate :: !(Double -> NominalDiffTime -> s -> s)+  , reservoirUpdate :: !(Double -> NominalDiffTime -> s -> s)   -- ^ Add a new value to the reservoir, potentially evicting old values in the prcoess.-  , _reservoirState :: !s+  , reservoirState :: !s   -- ^ The internal state of the reservoir.   } 

@@ -1,3 +1,9 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Rank2Types #-} -- | A histogram with an exponentially decaying reservoir produces quantiles which are representative of (roughly) the last five minutes of data. -- It does so by using a forward-decaying priority reservoir with an exponential weighting towards newer data.@@ -13,13 +19,15 @@   rescale,   update ) where+import Control.Lens+import Control.Lens.TH import Control.Monad.Primitive import Control.Monad.ST import Data.Time.Clock import Data.Time.Clock.POSIX import Data.Metrics.Internal+import qualified Data.Map as M import qualified Data.Metrics.Reservoir as R-import qualified Data.Map.Strict as M import Data.Metrics.Snapshot (Snapshot(..), takeSnapshot) import Data.Primitive.MutVar import qualified Data.Vector.Unboxed as V@@ -29,23 +37,25 @@ import System.Random.MWC  -- hours in seconds-rescaleThreshold :: Word64-rescaleThreshold = 60 * 60+baseRescaleThreshold :: Word64+baseRescaleThreshold = 60 * 60  -- | A forward-decaying priority reservoir -- -- <http://dimacs.rutgers.edu/~graham/pubs/papers/fwddecay.pdf> data ExponentiallyDecayingReservoir = ExponentiallyDecayingReservoir-  { _edrSize :: !Int-  , _edrAlpha :: !Double-  , _edrRescaleThreshold :: !Word64-  , _edrReservoir :: !(M.Map Double Double)-  , _edrCount :: !Int-  , _edrStartTime :: !Word64-  , _edrNextScaleTime :: !Word64-  , _edrSeed :: !Seed+  { exponentiallyDecayingReservoirInnerSize        :: {-# UNPACK #-} !Int+  , exponentiallyDecayingReservoirAlpha            :: {-# UNPACK #-} !Double+  , exponentiallyDecayingReservoirRescaleThreshold :: {-# UNPACK #-} !Word64+  , exponentiallyDecayingReservoirInnerReservoir   :: {-# UNPACK #-} !(M.Map Double Double)+  , exponentiallyDecayingReservoirCount            :: {-# UNPACK #-} !Int+  , exponentiallyDecayingReservoirStartTime        :: {-# UNPACK #-} !Word64+  , exponentiallyDecayingReservoirNextScaleTime    :: {-# UNPACK #-} !Word64+  , exponentiallyDecayingReservoirSeed :: !Seed   } deriving (Show) +makeFields ''ExponentiallyDecayingReservoir+ -- | An exponentially decaying reservoir with an alpha value of 0.015 and a 1028 sample cap. -- -- This offers a 99.9% confidence level with a 5% margin of error assuming a normal distribution,@@ -59,24 +69,24 @@   -> NominalDiffTime -- ^ creation time for the reservoir   -> Seed -> R.Reservoir reservoir a r t s = R.Reservoir-  { R._reservoirClear = clear-  , R._reservoirSize = size-  , R._reservoirSnapshot = snapshot-  , R._reservoirUpdate = update-  , R._reservoirState = ExponentiallyDecayingReservoir r a rescaleThreshold M.empty 0 c c' s+  { R.reservoirClear = clear+  , R.reservoirSize = size+  , R.reservoirSnapshot = snapshot+  , R.reservoirUpdate = update+  , R.reservoirState = ExponentiallyDecayingReservoir r a baseRescaleThreshold M.empty 0 c c' s   }   where     c = truncate t-    c' = c + rescaleThreshold+    c' = c + baseRescaleThreshold  -- | Reset the reservoir clear :: NominalDiffTime -> ExponentiallyDecayingReservoir -> ExponentiallyDecayingReservoir clear = go   where-    go t c = c { _edrStartTime = t', _edrNextScaleTime = t'', _edrCount = 0, _edrReservoir = M.empty }+    go t c = c & startTime .~ t' & nextScaleTime .~ t'' & count .~ 0 & innerReservoir .~ M.empty       where         t' = truncate t-        t'' = t' + _edrRescaleThreshold c+        t'' = t' + c ^. rescaleThreshold  -- | Get the current size of the reservoir. size :: ExponentiallyDecayingReservoir -> Int@@ -84,13 +94,13 @@   where     go r = min c s       where-        c = _edrCount r-        s = _edrSize r+        c = r ^. count+        s = r ^. innerSize  -- | Get a snapshot of the current reservoir snapshot :: ExponentiallyDecayingReservoir -> Snapshot snapshot r = runST $ do-  let svals = V.fromList $ M.elems $ _edrReservoir $ r+  let svals = V.fromList $ M.elems $ r ^. innerReservoir   mvals <- V.unsafeThaw svals   takeSnapshot mvals @@ -115,20 +125,15 @@ -- landmark L′ (and then use this new L′ at query time). This can be done with -- a linear pass over whatever data structure is being used.\" rescale :: Word64 -> ExponentiallyDecayingReservoir -> ExponentiallyDecayingReservoir-rescale now c = c-  { _edrReservoir = adjustedReservoir-  , _edrStartTime = now-  , _edrCount = M.size adjustedReservoir-  , _edrNextScaleTime = st-  }+rescale now c = c & startTime .~ now & nextScaleTime .~ st & count .~ M.size adjustedReservoir & innerReservoir .~ adjustedReservoir   where-    potentialScaleTime = now + rescaleThreshold-    currentScaleTime = _edrNextScaleTime c+    potentialScaleTime = now + baseRescaleThreshold+    currentScaleTime = c ^. nextScaleTime     st = if potentialScaleTime > currentScaleTime then potentialScaleTime else currentScaleTime-    diff = now - _edrStartTime c-    adjustKey x = x * exp (-alpha * fromIntegral diff)-    adjustedReservoir = M.mapKeys adjustKey $ _edrReservoir c-    alpha = _edrAlpha c+    diff = now - c ^. startTime+    adjustKey x = x * exp (-_alpha * fromIntegral diff)+    adjustedReservoir = M.mapKeys adjustKey $ c ^. innerReservoir+    _alpha = c ^. alpha  -- | 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.@@ -136,29 +141,25 @@   -> NominalDiffTime -- ^ time of update   -> ExponentiallyDecayingReservoir   -> ExponentiallyDecayingReservoir-update v t c = rescaled-  { _edrSeed = s'-  , _edrCount = newCount-  , _edrReservoir = addValue r-  } +update v t c = rescaled & seed .~ s' & count .~ newCount & innerReservoir .~ addValue r   where-    rescaled = if seconds >= _edrNextScaleTime c+    rescaled = if seconds >= c ^. nextScaleTime       then rescale seconds c       else c     seconds = truncate t-    priority = weight (_edrAlpha c) (seconds - _edrStartTime c) / priorityDenom-    addValue r = if newCount <= _edrSize c+    priority = weight (c ^. alpha) (seconds - c ^. startTime) / priorityDenom+    addValue r = if newCount <= (c ^. innerSize)       then M.insert priority v r       else if firstKey < priority         -- it should be safe to use head here since we are over our reservoir capacity at this point         -- caveat: reservoir capped at 0 max size         then M.delete firstKey $ M.insertWith const priority v r         else r-    r = _edrReservoir c+    r = c ^. innerReservoir     firstKey = head $ M.keys r-    newCount = 1 + _edrCount c+    newCount = 1 + c ^. count     (priorityDenom, s') = runST $ do-      g <- restore $ _edrSeed c+      g <- restore $ c ^. seed       p <- uniform g       s' <- save g       return (p :: Double, s')

@@ -1,3 +1,9 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-} -- | A histogram with a uniform reservoir produces quantiles which are valid for the entirely of the histogram’s lifetime. -- It will return a median value, for example, which is the median of all the values the histogram has ever been updated with. -- It does this by using an algorithm called Vitter’s R), which randomly selects values for the reservoir with linearly-decreasing probability.@@ -15,6 +21,8 @@   update,   unsafeUpdate ) where+import Control.Lens+import Control.Lens.TH import Control.Monad.ST import Data.Metrics.Internal import Data.Time.Clock@@ -25,16 +33,27 @@ import qualified Data.Vector.Unboxed as I import qualified Data.Vector.Unboxed.Mutable as V +-- | A reservoir in which all samples are equally likely to be evicted when the reservoir is at full capacity.+--+-- This is conceptually simpler than the "ExponentiallyDecayingReservoir", but at the expense of providing a less accurate sample.+data UniformReservoir = UniformReservoir+  { uniformReservoirCount          :: {-# UNPACK #-} !Int+  , uniformReservoirInnerReservoir :: {-# UNPACK #-} !(I.Vector Double)+  , uniformReservoirSeed           :: {-# UNPACK #-} !Seed+  }++makeFields ''UniformReservoir+ -- | Make a safe uniform reservoir. This variant provides safe access at the expense of updates costing O(n) reservoir :: Seed   -> Int -- ^ maximum reservoir size   -> R.Reservoir reservoir g r = R.Reservoir-  { R._reservoirClear = clear-  , R._reservoirSize = size-  , R._reservoirSnapshot = snapshot-  , R._reservoirUpdate = update-  , R._reservoirState = UniformReservoir 0 (I.replicate r 0) g+  { R.reservoirClear = clear+  , R.reservoirSize = size+  , R.reservoirSnapshot = snapshot+  , R.reservoirUpdate = update+  , R.reservoirState = UniformReservoir 0 (I.replicate r 0) g   }  -- | Using this variant requires that you ensure that there is no sharing of the reservoir itself.@@ -44,27 +63,18 @@ -- In return, updating the reservoir becomes an O(1) operation and clearing the reservoir avoids extra allocations. unsafeReservoir :: Seed -> Int -> R.Reservoir unsafeReservoir g r = R.Reservoir-  { R._reservoirClear = unsafeClear-  , R._reservoirSize = size-  , R._reservoirSnapshot = snapshot-  , R._reservoirUpdate = unsafeUpdate-  , R._reservoirState = UniformReservoir 0 (I.replicate r 0) g-  }---- | A reservoir in which all samples are equally likely to be evicted when the reservoir is at full capacity.------ This is conceptually simpler than the "ExponentiallyDecayingReservoir", but at the expense of providing a less accurate sample.-data UniformReservoir = UniformReservoir-  { _urCount :: !Int-  , _urReservoir :: !(I.Vector Double)-  , _urSeed :: !Seed+  { R.reservoirClear = unsafeClear+  , R.reservoirSize = size+  , R.reservoirSnapshot = snapshot+  , R.reservoirUpdate = unsafeUpdate+  , R.reservoirState = UniformReservoir 0 (I.replicate r 0) g   }  -- | Reset the reservoir to empty. clear :: NominalDiffTime -> UniformReservoir -> UniformReservoir clear = go   where-    go _ c = c { _urCount = 0, _urReservoir = newRes $ _urReservoir c }+    go _ c = c & count .~ 0 & innerReservoir %~ newRes     newRes v = runST $ do       v' <- I.thaw v       V.set v' 0@@ -74,7 +84,7 @@ unsafeClear :: NominalDiffTime -> UniformReservoir -> UniformReservoir unsafeClear = go   where-    go _ c = c { _urCount = 0, _urReservoir = newRes $ _urReservoir c }+    go _ c = c & count .~ 0 & innerReservoir %~ newRes     newRes v = runST $ do       v' <- I.unsafeThaw v       V.set v' 0@@ -84,7 +94,7 @@ size :: UniformReservoir -> Int size = go   where-    go c = min (_urCount c) (I.length $ _urReservoir c)+    go c = min (c ^. count) (I.length $ c ^. innerReservoir)  -- | Take a snapshot of the reservoir by doing an in-place unfreeze. --@@ -93,21 +103,21 @@ snapshot = go   where     go c = runST $ do-      v' <- I.unsafeThaw $ _urReservoir c+      v' <- I.unsafeThaw $ c ^. innerReservoir       S.takeSnapshot $ V.slice 0 (size c) v'  -- | Perform an update of the reservoir by copying the internal vector. O(n) update :: Double -> NominalDiffTime -> UniformReservoir -> UniformReservoir update = go   where-    go x _ c = c { _urCount = newCount, _urReservoir = newRes, _urSeed = newSeed }+    go x _ c = c & count .~ newCount & innerReservoir .~ newRes & seed .~ newSeed       where-        newCount = succ $ _urCount c+        newCount = c ^. count . to succ         (newSeed, newRes) = runST $ do-          v' <- I.thaw $ _urReservoir c-          g <- restore (_urSeed c)+          v' <- I.thaw $ c ^. innerReservoir+          g <- restore $ c ^. seed           if newCount <= V.length v'-            then V.unsafeWrite v' (_urCount c) x+            then V.unsafeWrite v' (c ^. count) x             else do               i <- uniformR (0, newCount) g               if i < V.length v'@@ -121,14 +131,14 @@ unsafeUpdate :: Double -> NominalDiffTime -> UniformReservoir -> UniformReservoir unsafeUpdate = go   where-    go x _ c = c { _urCount = newCount, _urReservoir = newRes, _urSeed = newSeed }+    go x _ c = c & count .~ newCount & innerReservoir .~ newRes & seed .~ newSeed       where-        newCount = succ $ _urCount c+        newCount = c ^. count . to succ         (newSeed, newRes) = runST $ do-          v' <- I.unsafeThaw $ _urReservoir c-          g <- restore (_urSeed c)+          v' <- I.unsafeThaw $ c ^. innerReservoir+          g <- restore (uniformReservoirSeed c)           if newCount <= V.length v'-            then V.unsafeWrite v' (_urCount c) x+            then V.unsafeWrite v' (c ^. count) x             else do               i <- uniformR (0, newCount) g               if i < V.length v'@@ -137,3 +147,4 @@           v'' <- I.unsafeFreeze v'           s <- save g           return (s, v'')+

@@ -29,19 +29,19 @@ -- | 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"+  , 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-    ts <- _timerGetTime t+    ts <- timerGetTime t     updateRef (fromTimer t) $ P.clear ts  instance PrimMonad m => Update m (Timer m) Double where   update t x = do-    ts <- _timerGetTime t+    ts <- timerGetTime t     updateRef (fromTimer t) $ P.update ts x  instance PrimMonad m => Count m (Timer m) where@@ -56,16 +56,16 @@  instance PrimMonad m => Rate m (Timer m) where   oneMinuteRate t = do-    ts <- _timerGetTime t+    ts <- timerGetTime t     updateAndApplyToRef (fromTimer t) (P.tickIfNecessary ts) P.oneMinuteRate   fiveMinuteRate t = do-    ts <- _timerGetTime t+    ts <- timerGetTime t     updateAndApplyToRef (fromTimer t) (P.tickIfNecessary ts) P.fiveMinuteRate   fifteenMinuteRate t = do-    ts <- _timerGetTime t+    ts <- timerGetTime t     updateAndApplyToRef (fromTimer t) (P.tickIfNecessary ts) P.fifteenMinuteRate   meanRate t = do-    ts <- _timerGetTime t+    ts <- timerGetTime t     applyWithRef (fromTimer t) (P.meanRate ts)  instance PrimMonad m => TakeSnapshot m (Timer m) where

@@ -16,8 +16,8 @@ import qualified Data.Metrics.Snapshot as S  data Timer = Timer-  { _timerMeter :: !M.Meter-  , _timerHistogram :: !H.Histogram+  { timerMeter :: !M.Meter+  , timerHistogram :: !H.Histogram   }  makeFields ''Timer@@ -26,19 +26,19 @@ tickIfNecessary t = meter %~ M.tickIfNecessary t  snapshot :: Timer -> S.Snapshot-snapshot = H.snapshot . _timerHistogram+snapshot = H.snapshot . timerHistogram  oneMinuteRate :: Timer -> Double-oneMinuteRate = A.rate . M.oneMinuteAverage . _timerMeter+oneMinuteRate = A.rate . M.oneMinuteAverage . timerMeter  fiveMinuteRate :: Timer -> Double-fiveMinuteRate = A.rate . M.fiveMinuteAverage . _timerMeter+fiveMinuteRate = A.rate . M.fiveMinuteAverage . timerMeter  fifteenMinuteRate :: Timer -> Double-fifteenMinuteRate = A.rate . M.fifteenMinuteAverage . _timerMeter+fifteenMinuteRate = A.rate . M.fifteenMinuteAverage . timerMeter  meanRate :: NominalDiffTime -> Timer -> Double-meanRate t = M.meanRate t . _timerMeter+meanRate t = M.meanRate t . timerMeter  count :: Timer -> Int count = H.count . view histogram@@ -50,16 +50,17 @@ update t x = (histogram %~ H.update x t) . (meter %~ M.mark t 1)  mean :: Timer -> Double-mean = H.mean . _timerHistogram+mean = H.mean . timerHistogram  stddev :: Timer -> Double-stddev = H.stddev . _timerHistogram+stddev = H.stddev . timerHistogram  variance :: Timer -> Double-variance = H.variance . _timerHistogram+variance = H.variance . timerHistogram  maxVal :: Timer -> Double-maxVal = H.maxVal . _timerHistogram+maxVal = H.maxVal . timerHistogram  minVal :: Timer -> Double-minVal = H.minVal . _timerHistogram+minVal = H.minVal . timerHistogram+