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 - [email protected]
+
+- 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
