packages feed

prometheus-client 0.1.1 → 0.2.0

raw patch · 7 files changed

+230/−33 lines, 7 filesdep +clockdep −time

Dependencies added: clock

Dependencies removed: time

Files

prometheus-client.cabal view
@@ -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
src/Prometheus.hs view
@@ -72,12 +72,27 @@ ,   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 -- >>> getSummary 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
src/Prometheus/Metric/Counter.hs view
@@ -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.
src/Prometheus/Metric/Gauge.hs view
@@ -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]
+ src/Prometheus/Metric/Histogram.hs view
@@ -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)
+ src/Prometheus/Metric/Observer.hs view
@@ -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)
src/Prometheus/Metric/Summary.hs view
@@ -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)]