Hello community, here is the log from the commit of package ghc-prometheus-client for openSUSE:Factory checked in at 2017-08-31 20:57:58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-prometheus-client (Old) and /work/SRC/openSUSE:Factory/.ghc-prometheus-client.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-prometheus-client" Thu Aug 31 20:57:58 2017 rev:3 rq:513455 version:0.2.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-prometheus-client/ghc-prometheus-client.changes 2017-06-04 01:55:06.444223618 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-prometheus-client.new/ghc-prometheus-client.changes 2017-08-31 20:57:59.454540149 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:06:35 UTC 2017 - psimons@suse.com + +- Update to version 0.2.0. + +------------------------------------------------------------------- Old: ---- prometheus-client-0.1.1.tar.gz New: ---- prometheus-client-0.2.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-prometheus-client.spec ++++++ --- /var/tmp/diff_new_pack.2NBGvc/_old 2017-08-31 20:58:00.366412027 +0200 +++ /var/tmp/diff_new_pack.2NBGvc/_new 2017-08-31 20:58:00.378410342 +0200 @@ -19,7 +19,7 @@ %global pkg_name prometheus-client %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.1.1 +Version: 0.2.0 Release: 0 Summary: Haskell client library for http://prometheus.io License: Apache-2.0 @@ -29,11 +29,11 @@ BuildRequires: ghc-Cabal-devel BuildRequires: ghc-atomic-primops-devel BuildRequires: ghc-bytestring-devel +BuildRequires: ghc-clock-devel BuildRequires: ghc-containers-devel BuildRequires: ghc-mtl-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-stm-devel -BuildRequires: ghc-time-devel BuildRequires: ghc-transformers-devel BuildRequires: ghc-utf8-string-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build ++++++ prometheus-client-0.1.1.tar.gz -> prometheus-client-0.2.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/prometheus-client-0.1.1/prometheus-client.cabal new/prometheus-client-0.2.0/prometheus-client.cabal --- old/prometheus-client-0.1.1/prometheus-client.cabal 2017-04-30 23:30:12.000000000 +0200 +++ new/prometheus-client-0.2.0/prometheus-client.cabal 2017-07-03 00:06:02.000000000 +0200 @@ -1,5 +1,5 @@ name: prometheus-client -version: 0.1.1 +version: 0.2.0 synopsis: Haskell client library for http://prometheus.io. description: Haskell client library for http://prometheus.io. homepage: https://github.com/fimad/prometheus-haskell @@ -28,6 +28,8 @@ , Prometheus.Metric , Prometheus.Metric.Counter , Prometheus.Metric.Gauge + , Prometheus.Metric.Histogram + , Prometheus.Metric.Observer , Prometheus.Metric.Summary , Prometheus.Metric.Vector , Prometheus.MonadMonitor @@ -36,11 +38,11 @@ atomic-primops >=0.4 , base >=4.7 && <5 , bytestring >=0.9 + , clock , containers , mtl >=2 , stm >=2.3 , transformers - , time , utf8-string ghc-options: -Wall @@ -66,11 +68,11 @@ , base >=4.7 && <5 , bytestring , containers + , clock , hspec , mtl , random-shuffle , stm - , time , transformers , utf8-string ghc-options: -Wall diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/prometheus-client-0.1.1/src/Prometheus/Metric/Counter.hs new/prometheus-client-0.2.0/src/Prometheus/Metric/Counter.hs --- old/prometheus-client-0.1.1/src/Prometheus/Metric/Counter.hs 2017-04-30 00:58:18.000000000 +0200 +++ new/prometheus-client-0.2.0/src/Prometheus/Metric/Counter.hs 2017-07-02 23:55:13.000000000 +0200 @@ -10,10 +10,10 @@ import Prometheus.Info import Prometheus.Metric +import Prometheus.Metric.Observer (timeAction) import Prometheus.MonadMonitor import Control.Monad (unless) -import Data.Time.Clock (diffUTCTime, getCurrentTime) import qualified Data.Atomics as Atomics import qualified Data.ByteString.UTF8 as BS import qualified Data.IORef as IORef @@ -60,10 +60,8 @@ -- | Add the duration of an IO action (in seconds) to a counter. addDurationToCounter :: IO a -> Metric Counter -> IO a addDurationToCounter io metric = do - start <- getCurrentTime - result <- io - end <- getCurrentTime - addCounter (fromRational $ toRational $ end `diffUTCTime` start) metric + (result, duration) <- timeAction io + _ <- addCounter duration metric return result -- | Retrieves the current value of a counter metric. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/prometheus-client-0.1.1/src/Prometheus/Metric/Gauge.hs new/prometheus-client-0.2.0/src/Prometheus/Metric/Gauge.hs --- old/prometheus-client-0.1.1/src/Prometheus/Metric/Gauge.hs 2015-06-10 08:20:46.000000000 +0200 +++ new/prometheus-client-0.2.0/src/Prometheus/Metric/Gauge.hs 2017-07-02 23:55:13.000000000 +0200 @@ -12,9 +12,9 @@ import Prometheus.Info import Prometheus.Metric +import Prometheus.Metric.Observer (timeAction) import Prometheus.MonadMonitor -import Data.Time.Clock (diffUTCTime, getCurrentTime) import qualified Data.Atomics as Atomics import qualified Data.ByteString.UTF8 as BS import qualified Data.IORef as IORef @@ -68,10 +68,8 @@ -- | Sets a gauge metric to the duration in seconds of an IO action. setGaugeToDuration :: IO a -> Metric Gauge -> IO a setGaugeToDuration io metric = do - start <- getCurrentTime - result <- io - end <- getCurrentTime - setGauge (fromRational $ toRational $ end `diffUTCTime` start) metric + (result, duration) <- timeAction io + setGauge duration metric return result collectGauge :: Info -> IORef.IORef Double -> IO [SampleGroup] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/prometheus-client-0.1.1/src/Prometheus/Metric/Histogram.hs new/prometheus-client-0.2.0/src/Prometheus/Metric/Histogram.hs --- old/prometheus-client-0.1.1/src/Prometheus/Metric/Histogram.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/prometheus-client-0.2.0/src/Prometheus/Metric/Histogram.hs 2017-07-02 23:55:13.000000000 +0200 @@ -0,0 +1,140 @@ +module Prometheus.Metric.Histogram ( + Histogram +, histogram +, defaultBuckets +, exponentialBuckets +, linearBuckets + +-- * Exported for testing +, BucketCounts(..) +, insert +, emptyCounts +, getHistogram +) where + +import Prometheus.Info +import Prometheus.Metric +import Prometheus.Metric.Observer +import Prometheus.MonadMonitor + +import Control.Applicative ((<$>)) +import qualified Control.Concurrent.STM as STM +import qualified Data.ByteString.UTF8 as BS +import qualified Data.Map.Strict as Map +import Numeric (showFFloat) + +-- | A histogram. Counts the number of observations that fall within the +-- specified buckets. +newtype Histogram = MkHistogram (STM.TVar BucketCounts) + +-- | Create a new 'Histogram' metric with a given name, help string, and +-- list of buckets. Panics if the list of buckets is not strictly increasing. +-- A good default list of buckets is 'defaultBuckets'. You can also create +-- buckets with 'linearBuckets' or 'exponentialBuckets'. +histogram :: Info -> [Bucket] -> IO (Metric Histogram) +histogram info buckets = do + countsTVar <- STM.newTVarIO (emptyCounts buckets) + return Metric { + handle = MkHistogram countsTVar + , collect = collectHistogram info countsTVar + } + +-- | Upper-bound for a histogram bucket. +type Bucket = Double + +-- | Current state of a histogram. +data BucketCounts = BucketCounts { + -- | The sum of all the observations. + histTotal :: !Double + -- | The number of observations that have been made. +, histCount :: !Int + -- | Counts for each bucket. The key is the upper-bound, + -- value is the number of observations less-than-or-equal-to + -- that upper bound, but greater than the next lowest upper bound. +, histCountsPerBucket :: Map.Map Bucket Int +} deriving (Show, Eq, Ord) + +emptyCounts :: [Bucket] -> BucketCounts +emptyCounts buckets + | isStrictlyIncreasing buckets = BucketCounts 0 0 $ Map.fromList (zip buckets (repeat 0)) + | otherwise = error ("Histogram buckets must be in increasing order, got: " ++ show buckets) + where + isStrictlyIncreasing xs = and (zipWith (<) xs (tail xs)) + +instance Observer Histogram where + -- | Add a new observation to a histogram metric. + observe v h = withHistogram h (insert v) + +-- | Transform the contents of a histogram. +withHistogram :: MonadMonitor m + => Metric Histogram -> (BucketCounts -> BucketCounts) -> m () +withHistogram Metric {handle = MkHistogram bucketCounts} f = + doIO $ STM.atomically $ STM.modifyTVar' bucketCounts f + +-- | Retries a map of upper bounds to counts of values observed that are +-- less-than-or-equal-to that upper bound, but greater than any other upper +-- bound in the map. +getHistogram :: Metric Histogram -> IO (Map.Map Bucket Int) +getHistogram Metric {handle = MkHistogram bucketsTVar} = + histCountsPerBucket <$> STM.atomically (STM.readTVar bucketsTVar) + +-- | Record an observation. +insert :: Double -> BucketCounts -> BucketCounts +insert value BucketCounts { histTotal = total, histCount = count, histCountsPerBucket = counts } = + BucketCounts (total + value) (count + 1) incCounts + where + incCounts = + case Map.lookupGE value counts of + Nothing -> counts + Just (upperBound, _) -> Map.adjust (+1) upperBound counts + +-- | Collect the current state of a histogram. +collectHistogram :: Info -> STM.TVar BucketCounts -> IO [SampleGroup] +collectHistogram info bucketCounts = STM.atomically $ do + BucketCounts total count counts <- STM.readTVar bucketCounts + let sumSample = Sample (name ++ "_sum") [] (bsShow total) + let countSample = Sample (name ++ "_count") [] (bsShow count) + let infSample = Sample name [(bucketLabel, "+Inf")] (bsShow count) + let samples = map toSample (cumulativeSum (Map.toAscList counts)) + return [SampleGroup info HistogramType $ samples ++ [infSample, sumSample, countSample]] + where + toSample (upperBound, count') = + Sample name [(bucketLabel, formatFloat upperBound)] $ bsShow count' + name = metricName info + + -- We don't particularly want scientific notation, so force regular + -- numeric representation instead. + formatFloat x = showFFloat Nothing x "" + + cumulativeSum xs = zip (map fst xs) (scanl1 (+) (map snd xs)) + + bsShow :: Show s => s -> BS.ByteString + bsShow = BS.fromString . show + +-- | The label that defines the upper bound of a bucket of a histogram. @"le"@ +-- is short for "less than or equal to". +bucketLabel :: String +bucketLabel = "le" + +-- | The default Histogram buckets. These are tailored to measure the response +-- time (in seconds) of a network service. You will almost certainly need to +-- customize them for your particular use case. +defaultBuckets :: [Double] +defaultBuckets = [0.005, 0.01, 0.025, 0.05, 0.1, 0.25, 0.5, 1, 2.5, 5, 10] + +-- | Create @count@ buckets, each @width@ wide, where the lowest bucket has an +-- upper bound of @start@. Use this to create buckets for 'histogram'. +linearBuckets :: Bucket -> Double -> Int -> [Bucket] +linearBuckets start width count + | count <= 0 = error ("Must provide a positive number of linear buckets, got: " ++ show count) + | otherwise = take count (iterate (width+) start) + +-- | Create @count@ buckets, where the lowest bucket has an upper bound of @start@ +-- and each bucket's upper bound is @factor@ times the previous bucket's upper bound. +-- Use this to create buckets for 'histogram'. +exponentialBuckets :: Bucket -> Double -> Int -> [Bucket] +exponentialBuckets start factor count + | count <= 0 = error ("Must provide a positive number of exponential buckets, got: " ++ show count) + | factor <= 1 = error ("Exponential buckets must have factor greater than 1 to ensure upper bounds are monotonically increasing, got: " ++ show factor) + | start <= 0 = error ("Exponential buckets must have positive number for start bucket to ensure upper bounds are monotonically increasing, got: " ++ show start) + | otherwise = take count (iterate (factor*) start) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/prometheus-client-0.1.1/src/Prometheus/Metric/Observer.hs new/prometheus-client-0.2.0/src/Prometheus/Metric/Observer.hs --- old/prometheus-client-0.1.1/src/Prometheus/Metric/Observer.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/prometheus-client-0.2.0/src/Prometheus/Metric/Observer.hs 2017-07-02 23:55:13.000000000 +0200 @@ -0,0 +1,36 @@ +module Prometheus.Metric.Observer ( + Observer(..) +, observeDuration +, timeAction +) where + +import Data.Ratio ((%)) +import Prometheus.Metric +import Prometheus.MonadMonitor + +import System.Clock (Clock(..), diffTimeSpec, getTime, toNanoSecs) + +-- | Interface shared by 'Summary' and 'Histogram'. +class Observer metric where + -- | Observe that a particular floating point value has occurred. + -- For example, observe that this request took 0.23s. + observe :: MonadMonitor m => Double -> Metric metric -> m () + +-- | Adds the duration in seconds of an IO action as an observation to an +-- observer metric. +observeDuration :: Observer metric => IO a -> Metric metric -> IO a +observeDuration io metric = do + (result, duration) <- timeAction io + observe duration metric + return result + + +-- | Evaluate @io@ and return its result as well as how long it took to evaluate, +-- in seconds. +timeAction :: IO a -> IO (a, Double) +timeAction io = do + start <- getTime Monotonic + result <- io + end <- getTime Monotonic + let duration = toNanoSecs (end `diffTimeSpec` start) % 1000000000 + return (result, fromRational duration) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/prometheus-client-0.1.1/src/Prometheus/Metric/Summary.hs new/prometheus-client-0.2.0/src/Prometheus/Metric/Summary.hs --- old/prometheus-client-0.1.1/src/Prometheus/Metric/Summary.hs 2015-06-10 08:23:32.000000000 +0200 +++ new/prometheus-client-0.2.0/src/Prometheus/Metric/Summary.hs 2017-07-02 23:55:13.000000000 +0200 @@ -19,10 +19,10 @@ import Prometheus.Info import Prometheus.Metric +import Prometheus.Metric.Observer import Prometheus.MonadMonitor import Data.Int (Int64) -import Data.Time.Clock (diffUTCTime, getCurrentTime) import Data.Foldable (foldr') import qualified Control.Concurrent.STM as STM import qualified Data.ByteString.UTF8 as BS @@ -48,19 +48,9 @@ STM.modifyTVar' valueTVar compress STM.modifyTVar' valueTVar f --- | Adds a new observation to a summary metric. -observe :: MonadMonitor m => Double -> Metric Summary -> m () -observe v s = withSummary s (insert v) - --- | Adds the duration in seconds of an IO action as an observation to a summary --- metric. -observeDuration :: IO a -> Metric Summary -> IO a -observeDuration io metric = do - start <- getCurrentTime - result <- io - end <- getCurrentTime - observe (fromRational $ toRational $ end `diffUTCTime` start) metric - return result +instance Observer Summary where + -- | Adds a new observation to a summary metric. + observe v s = withSummary s (insert v) -- | Retrieves a list of tuples containing a quantile and its associated value. getSummary :: Metric Summary -> IO [(Rational, Double)] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/prometheus-client-0.1.1/src/Prometheus.hs new/prometheus-client-0.2.0/src/Prometheus.hs --- old/prometheus-client-0.1.1/src/Prometheus.hs 2017-04-30 00:58:18.000000000 +0200 +++ new/prometheus-client-0.2.0/src/Prometheus.hs 2017-07-02 23:55:13.000000000 +0200 @@ -72,11 +72,26 @@ , setGaugeToDuration , getGauge --- ** Summary +-- ** Summaries and histograms -- --- | A summary captures observations of a floating point value over time and --- summarizes the observations as a count, sum, and rank estimations. A typical --- use case for summaries is measuring HTTP request latency. +-- | An 'Observer' is a generic metric that captures observations of a +-- floating point value over time. Different implementations can store +-- and summarise these value in different ways. +-- +-- The two main observers are summaries and histograms. A 'Summary' allows you +-- to get a precise estimate of a particular quantile, but cannot be meaningfully +-- aggregated across processes. A 'Histogram' packs requests into user-supplied +-- buckets, which /can/ be aggregated meaningfully, but provide much less precise +-- information on particular quantiles. + +, Observer(..) +, observeDuration + +-- *** Summary +-- +-- | A summary is an 'Observer' that summarizes the observations as a count, +-- sum, and rank estimations. A typical use case for summaries is measuring +-- HTTP request latency. -- -- >>> mySummary <- summary (Info "my_summary" "") defaultQuantiles -- >>> observe 0 mySummary @@ -87,10 +102,26 @@ , Quantile , summary , defaultQuantiles -, observe -, observeDuration , getSummary +-- *** Histogram +-- +-- | A histogram captures observations of a floating point value over time +-- and stores those observations in a user-supplied histogram. A typical use case +-- for histograms is measuring HTTP request latency. Histograms are unlike +-- summaries in that they can be meaningfully aggregated across processes. +-- +-- >>> myHistogram <- histogram (Info "my_histogram" "") defaultBuckets +-- >>> observe 0 myHistogram +-- >>> getHistogram myHistogram +-- fromList [(5.0e-3,1),(1.0e-2,0),(2.5e-2,0),(5.0e-2,0),(0.1,0),(0.25,0),(0.5,0),(1.0,0),(2.5,0),(5.0,0),(10.0,0)] +, Histogram +, histogram +, defaultBuckets +, exponentialBuckets +, linearBuckets +, getHistogram + -- ** Vector -- -- | A vector models a collection of metrics that share the same name but are @@ -223,6 +254,8 @@ import Prometheus.Metric import Prometheus.Metric.Counter import Prometheus.Metric.Gauge +import Prometheus.Metric.Histogram +import Prometheus.Metric.Observer import Prometheus.Metric.Summary import Prometheus.Metric.Vector import Prometheus.MonadMonitor