diff --git a/.gitignore b/.gitignore index 10c1a6e..5e8bf99 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,9 @@ dist/ +dist-newstyle/ .cabal-sandbox/ cabal.sandbox.config cabal.config .stack-work */*.yaml.lock -.devcontainer \ No newline at end of file +.devcontainer +stack.yaml.lock diff --git a/prometheus-client/docs/memory-use.md b/prometheus-client/docs/memory-use.md new file mode 100644 index 0000000..c049232 --- /dev/null +++ b/prometheus-client/docs/memory-use.md @@ -0,0 +1,91 @@ +# Investigating Memory Use in `prometheus-client` + +We're running into problems with unexpectedly high memory use in `prometheus-client`, so I've been investigating improving the behavior. + +Specifically, we're notificing a significant increase in the amount of time and memory allocated while calling `exportMetricsToText`. +Every time we call the endpoint, more and more memory is used to render the response. +There are two reasonable possibilities for this: + +1. The `exportMetricsToText` is producing a significantly larger `Text` value, which naturally requires significantly more memory. +2. The metrics themselves are somehow holding on to excessive memory or thunks. + +Diagnosing this in our application is difficult - our profiling build is currently broken. +So I'm currently just looking at the code and correcting known smells. + +## `LabelPairs` + +The `LabelPairs` type was a `[(Text, Text)]`. +Lists and tuples are both known sources of potential laziness issues. +As a first pass, I replaced the type with a `newtype` so I could control the API for accessing and adding entries. +Then I replaced the tuple with a `data LabelPair = LabelPair { labelKey :: !Text, labelValue :: !Text }`. +This should prevent thunk accumulation for labels, and the concrete type may enable further memory improvement from GHC. + +The fields on `Sample` are made strict, as well. +This should prevent thunk accumulation on the `Text` and `ByteString`, but a lazy `LabelPairs` is still possible. + +Additionally, the `labelPairs` function now uses bang patterns on each `Text` in the tuple. +Since this is the whole of the interface for constructing a `LabelPair`, this should prevent any thunk accumulation on labels. + +## `MetricImpl` + +A `Metric` had a field `construct :: IO (s, IO [SampleGroup])`. +To avoid tuple, we introduce `MetricImpl s` which uses bang patterns on the fields. + +In practice, the `MetricImpl s` is almost always instantiated to a reference type, and evaluating a reference doesn't do much to help. +I did find the clarity in names helpful. + +## `VectorState` + +A `Prometheus.Metric.Vector` previously was defined as: + +```haskell +type VectorState l m = (Metric m, Map.Map l (m, IO [SampleGroup])) +``` + +This `VectorState` was being stored in an `IORef`. +While the operation was evaluating the `VectorState` to WHNF, this only evaluated the tuple constructor, leaving the `Metric` and `Map.Map` unevaluated. +The `Map` is from `Data.Map.Strict`, which means that the values are evaluated to WHNF. +Methods from that module evaluate the structure of the `Map`, but polymorphic methods (ie `Functor`, `Traversable`) *do not*. + +We can reduce the possibility of memory leaks here by replacing this with a record, bang patterns, and omitting the tuple for the `MetricImpl` type. + +## `Counter` to `Builder` + +`Counter` is a very simple metric. +Since the operations used for modifying the `IORef` all evaluate the value to WHNF, and the value is a `Double`, we are not retaining memory here. + +However, there is a performance inefficiency: the use + +```haskell + let sample = Sample (metricName info) mempty (BS.fromString $ show value) +``` + +`show :: Double -> String` is going to inefficiently allocate a `[Char]`, which will then be packed using `BS.fromString`. +Later, in consumption of this, we will convert that `ByteString` into a `Builder`. +A more efficient approach would use [`doubleDec`](https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/Data-ByteString-Builder.html#v:doubleDec) to directly convert to a `Builder`, avoiding allocating the intermediate `String`. + +Since the only actual use of the `Sample`'s payload value is in building the report, we can change `Sample` to contain a `Builder` and encode things directly. +This will improve efficiency by avoiding allocating intermediate `String`s. + +## `Histogram` + +While investigating `Histogram`, I found a few potential issues: + +1. `cumulativeSum` has numerous problems: + * The function holds onto the entire `Map` converted-into-a-`[(Double, Int)]` in order to `zip` it with itself. + * `scanl1` is lazy, similar to `foldl`. On lists, this will result in thunk accumulation. +2. `showFFloat` is used, requiring a `Double -> String -> Text -> Builder` conversion path. +3. The entire computation is done inside of a `STM.atomically`. + This means that, should anything write to the `TVar`, all of the computation will be retried. + This is *probably* bad - we want to capture the state of the metrics *now*, and then return the `SampleGroup`, rather than allowing the computation to be aborted and retried multiple times. + +The first two problems are based on the sizeof the histogram, so the number of buckets. +Every additional bucket causes another float to be rendered into a string, and another list cons cell to be held on to. +Since number of buckets is likely small, this is probably not a big deal. + +However, might as well fix it up where I can! +`scanl1'` does not exist in `base`, but we can avoid retaining the input list in memory by preserving the tuple structure. +A bang pattern on the accumulator can help. + +`formatFloat` is used to produce a `Text` label value for the `LabelPair`. +This suggests we can use `Data.Text.Lazy.Builder` to avoid the intermediate `String`. diff --git a/prometheus-client/prometheus-client.cabal b/prometheus-client/prometheus-client.cabal index c016b0a..6afb447 100644 --- a/prometheus-client/prometheus-client.cabal +++ b/prometheus-client/prometheus-client.cabal @@ -37,7 +37,7 @@ library build-depends: atomic-primops >=0.4 , base >=4.7 && <5 - , bytestring >=0.9 + , bytestring >=0.11.2 , clock , containers , deepseq @@ -68,6 +68,7 @@ test-suite spec default-language: Haskell2010 hs-source-dirs: src, tests main-is: Spec.hs + build-tool-depends: hspec-discover:hspec-discover build-depends: QuickCheck , atomic-primops diff --git a/prometheus-client/src/Prometheus.hs b/prometheus-client/src/Prometheus.hs index 654d4ed..108dd6e 100644 --- a/prometheus-client/src/Prometheus.hs +++ b/prometheus-client/src/Prometheus.hs @@ -57,7 +57,7 @@ module Prometheus ( -- set the value of a gauge as well as add and subtract arbitrary values. -- -- >>> myGauge <- register $ gauge (Info "my_gauge" "An example gauge") --- >>> setGauge myGauge 100 +-- >>> setGauge myGauge 100 -- >>> addGauge myGauge 50 -- >>> subGauge myGauge 25 -- >>> getGauge myGauge @@ -100,7 +100,7 @@ module Prometheus ( -- [(1 % 2,0.0),(9 % 10,0.0),(99 % 100,0.0)] , Summary -, Quantile +, Quantile(..) , summary , defaultQuantiles , getSummary @@ -113,7 +113,7 @@ module Prometheus ( -- summaries in that they can be meaningfully aggregated across processes. -- -- >>> myHistogram <- register $ histogram (Info "my_histogram" "") defaultBuckets --- >>> observe myHistogram 0 +-- >>> observe myHistogram 0 -- >>> 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 @@ -130,11 +130,11 @@ module Prometheus ( -- partitioned across a set of dimensions. -- -- >>> myVector <- register $ vector ("method", "code") $ counter (Info "http_requests" "") --- >>> withLabel myVector ("GET", "200") incCounter --- >>> withLabel myVector ("GET", "200") incCounter --- >>> withLabel myVector ("GET", "404") incCounter --- >>> withLabel myVector ("POST", "200") incCounter --- >>> getVectorWith myVector getCounter +-- >>> withLabel myVector ("GET", "200") incCounter +-- >>> withLabel myVector ("GET", "200") incCounter +-- >>> withLabel myVector ("GET", "404") incCounter +-- >>> withLabel myVector ("POST", "200") incCounter +-- >>> getVectorWith myVector getCounter -- [(("GET","200"),2.0),(("GET","404"),1.0),(("POST","200"),1.0)] -- >>> exportMetricsAsText >>= Data.ByteString.Lazy.putStr -- # HELP http_requests @@ -199,11 +199,11 @@ module Prometheus ( -- >>> :m +Data.ByteString.UTF8 -- >>> newtype CPUTime = MkCPUTime () -- >>> let info = Info "cpu_time" "The current CPU time" --- >>> let toValue = Data.ByteString.UTF8.fromString . show --- >>> let toSample = Sample "cpu_time" [] . toValue +-- >>> let toValue = Data.ByteString.Builder.stringUtf8 . show +-- >>> let toSample = Sample "cpu_time" mempty . toValue -- >>> let toSampleGroup = (:[]) . SampleGroup info GaugeType . (:[]) . toSample -- >>> let collectCPUTime = fmap toSampleGroup getCPUTime --- >>> let cpuTimeMetric = Metric (return (MkCPUTime (), collectCPUTime)) +-- >>> let cpuTimeMetric = Metric (return $ MetricImpl (MkCPUTime ()) collectCPUTime) -- >>> register cpuTimeMetric -- >>> exportMetricsAsText >>= Data.ByteString.Lazy.putStr -- # HELP cpu_time The current CPU time @@ -244,6 +244,7 @@ module Prometheus ( , Info (..) , Metric (..) +, MetricImpl (..) , Sample (..) , SampleGroup (..) , SampleType (..) @@ -266,5 +267,6 @@ import Prometheus.Registry -- $setup -- >>> :module +Prometheus -- >>> :module +Control.Monad +-- >>> :module +Data.ByteString.Builder -- >>> :set -XOverloadedStrings -- >>> unregisterAll diff --git a/prometheus-client/src/Prometheus/Export/Text.hs b/prometheus-client/src/Prometheus/Export/Text.hs index 4cb1019..19d76ae 100644 --- a/prometheus-client/src/Prometheus/Export/Text.hs +++ b/prometheus-client/src/Prometheus/Export/Text.hs @@ -4,6 +4,7 @@ module Prometheus.Export.Text ( exportMetricsAsText ) where +import Prometheus.Label (unLabelPairs, LabelPair(..)) import Prometheus.Info import Prometheus.Metric import Prometheus.Registry @@ -65,7 +66,7 @@ exportSamples samples = exportSample :: Sample -> Build.Builder exportSample (Sample name labels value) = Build.byteString (T.encodeUtf8 name) - <> (case labels of + <> (case unLabelPairs labels of [] -> mempty l:ls -> Build.charUtf8 '{' @@ -73,10 +74,10 @@ exportSample (Sample name labels value) = <> mconcat [ Build.charUtf8 ',' <> exportLabel l' | l' <- ls ] <> Build.charUtf8 '}') <> Build.charUtf8 ' ' - <> Build.byteString value + <> value -exportLabel :: (Text, Text) -> Build.Builder -exportLabel (key, value) = +exportLabel :: LabelPair -> Build.Builder +exportLabel LabelPair { labelKey = key, labelValue = value } = Build.byteString (T.encodeUtf8 key) <> Build.charUtf8 '=' <> Build.stringUtf8 (show value) diff --git a/prometheus-client/src/Prometheus/Label.hs b/prometheus-client/src/Prometheus/Label.hs index 4067e21..47f54ae 100644 --- a/prometheus-client/src/Prometheus/Label.hs +++ b/prometheus-client/src/Prometheus/Label.hs @@ -1,9 +1,14 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GADTs #-} module Prometheus.Label ( Label (..) -, LabelPairs +, LabelPairs(..) +, LabelPair(..) , Label0 , Label1 , Label2 @@ -20,7 +25,12 @@ import Data.Text -- | A list of tuples where the first value is the label and the second is the -- value of that label. -type LabelPairs = [(Text, Text)] +newtype LabelPairs = LabelPairs { unLabelPairs :: [LabelPair] } + deriving stock Show + deriving newtype (Semigroup, Monoid) + +data LabelPair = LabelPair { labelKey :: !Text, labelValue :: !Text } + deriving stock Show -- | Label describes a class of types that can be used to as the label of -- a vector. @@ -30,61 +40,61 @@ class Ord l => Label l where type Label0 = () instance Label () where - labelPairs () () = [] + labelPairs () () = LabelPairs mempty type Label1 = Text instance Label Text where - labelPairs key value = [(key, value)] + labelPairs !key !value = LabelPairs [LabelPair key value] type Label2 = (Text, Text) instance (a ~ Text, b ~ a) => Label (a, b) where - labelPairs (k1, k2) (v1, v2) = [(k1, v1), (k2, v2)] + labelPairs (!k1, !k2) (!v1, !v2) = LabelPairs [LabelPair k1 v1, LabelPair k2 v2] type Label3 = (Text, Text, Text) instance (a ~ Text, b ~ a, c ~ a) => Label (a, b, c) where - labelPairs (k1, k2, k3) (v1, v2, v3) = [(k1, v1), (k2, v2), (k3, v3)] + labelPairs (!k1, !k2, !k3) (!v1, !v2, !v3) = LabelPairs [LabelPair k1 v1, LabelPair k2 v2, LabelPair k3 v3] type Label4 = (Text, Text, Text, Text) instance (a ~ Text, b ~ a, c ~ a, d ~ a) => Label (a, b, c, d) where - labelPairs (k1, k2, k3, k4) (v1, v2, v3, v4) = - [(k1, v1), (k2, v2), (k3, v3), (k4, v4)] + labelPairs (!k1, !k2, !k3, !k4) (!v1, !v2, !v3, !v4) = + LabelPairs [LabelPair k1 v1, LabelPair k2 v2, LabelPair k3 v3, LabelPair k4 v4] type Label5 = (Text, Text, Text, Text, Text) instance (a ~ Text, b ~ a, c ~ a, d ~ a, e ~ a) => Label (a, b, c, d, e) where - labelPairs (k1, k2, k3, k4, k5) (v1, v2, v3, v4, v5) = - [(k1, v1), (k2, v2), (k3, v3), (k4, v4), (k5, v5)] + labelPairs (!k1, !k2, !k3, !k4, !k5) (!v1, !v2, !v3, !v4, !v5) = + LabelPairs [LabelPair k1 v1, LabelPair k2 v2, LabelPair k3 v3, LabelPair k4 v4, LabelPair k5 v5] type Label6 = (Text, Text, Text, Text, Text, Text) instance (a ~ Text, b ~ a, c ~ a, d ~ a, e ~ a, f ~ a) => Label (a, b, c, d, e, f) where - labelPairs (k1, k2, k3, k4, k5, k6) (v1, v2, v3, v4, v5, v6) = - [(k1, v1), (k2, v2), (k3, v3), (k4, v4), (k5, v5), (k6, v6)] + labelPairs (!k1, !k2, !k3, !k4, !k5, !k6) (!v1, !v2, !v3, !v4, !v5, !v6) = + LabelPairs [LabelPair k1 v1, LabelPair k2 v2, LabelPair k3 v3, LabelPair k4 v4, LabelPair k5 v5, LabelPair k6 v6] type Label7 = (Text, Text, Text, Text, Text, Text, Text) instance (a ~ Text, b ~ a, c ~ a, d ~ a, e ~ a, f ~ a, g ~ a) => Label (a, b, c, d, e, f, g) where - labelPairs (k1, k2, k3, k4, k5, k6, k7) (v1, v2, v3, v4, v5, v6, v7) = - [(k1, v1), (k2, v2), (k3, v3), (k4, v4), (k5, v5), (k6, v6), - (k7, v7)] + labelPairs (!k1, !k2, !k3, !k4, !k5, !k6, !k7) (!v1, !v2, !v3, !v4, !v5, !v6, !v7) = + LabelPairs [LabelPair k1 v1, LabelPair k2 v2, LabelPair k3 v3, LabelPair k4 v4, LabelPair k5 v5, LabelPair k6 v6, + LabelPair k7 v7] type Label8 = (Text, Text, Text, Text, Text, Text, Text, Text) instance (a ~ Text, b ~ a, c ~ a, d ~ a, e ~ a, f ~ a, g ~ a, h ~ a) => Label (a, b, c, d, e, f, g, h) where - labelPairs (k1, k2, k3, k4, k5, k6, k7, k8) - (v1, v2, v3, v4, v5, v6, v7, v8) = - [(k1, v1), (k2, v2), (k3, v3), (k4, v4), (k5, v5), (k6, v6), - (k7, v7), (k8, v8)] + labelPairs (!k1, !k2, !k3, !k4, !k5, !k6, !k7, !k8) + (!v1, !v2, !v3, !v4, !v5, !v6, !v7, !v8) = + LabelPairs [LabelPair k1 v1, LabelPair k2 v2, LabelPair k3 v3, LabelPair k4 v4, LabelPair k5 v5, LabelPair k6 v6, + LabelPair k7 v7, LabelPair k8 v8] type Label9 = (Text, Text, Text, Text, Text, Text, Text, Text, Text) instance (a ~ Text, b ~ a, c ~ a, d ~ a, e ~ a, f ~ a, g ~ a, h ~ a, i ~ a) => Label (a, b, c, d, e, f, g, h, i) where - labelPairs (k1, k2, k3, k4, k5, k6, k7, k8, k9) - (v1, v2, v3, v4, v5, v6, v7, v8, v9) = - [(k1, v1), (k2, v2), (k3, v3), (k4, v4), (k5, v5), (k6, v6), - (k7, v7), (k8, v8), (k9, v9)] + labelPairs (!k1, !k2, !k3, !k4, !k5, !k6, !k7, !k8, !k9) + (!v1, !v2, !v3, !v4, !v5, !v6, !v7, !v8, !v9) = + LabelPairs [LabelPair k1 v1, LabelPair k2 v2, LabelPair k3 v3, LabelPair k4 v4, LabelPair k5 v5, LabelPair k6 v6, + LabelPair k7 v7, LabelPair k8 v8, LabelPair k9 v9] diff --git a/prometheus-client/src/Prometheus/Metric.hs b/prometheus-client/src/Prometheus/Metric.hs index f3cbfbc..b162c44 100644 --- a/prometheus-client/src/Prometheus/Metric.hs +++ b/prometheus-client/src/Prometheus/Metric.hs @@ -2,6 +2,7 @@ module Prometheus.Metric ( Metric (..) +, MetricImpl (..) , Sample (..) , SampleGroup (..) , SampleType (..) @@ -12,6 +13,7 @@ import Prometheus.Label import Control.DeepSeq import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as Builder import Data.Text (Text) @@ -34,13 +36,13 @@ instance Show SampleType where -- | A single value recorded at a moment in time. The sample type contains the -- name of the sample, a list of labels and their values, and the value encoded -- as a ByteString. -data Sample = Sample Text LabelPairs BS.ByteString - deriving (Show) +data Sample = Sample !Text !LabelPairs !Builder.Builder + -- deriving (Show) -- | A Sample group is a list of samples that is tagged with meta data -- including the name, help string, and type of the sample. -data SampleGroup = SampleGroup Info SampleType [Sample] - deriving (Show) +data SampleGroup = SampleGroup !Info !SampleType [Sample] + -- deriving (Show) -- | A metric represents a single value that is being monitored. It is comprised -- of a handle value and a collect method. The handle value is typically a new @@ -58,8 +60,13 @@ newtype Metric s = -- metric. A counter would return state pointing to the mutable -- reference. -- 2. An 'IO' action that samples the metric and returns 'SampleGroup's. - -- This is the data that will be stored by Prometheus. - construct :: IO (s, IO [SampleGroup]) + -- This is the data that will be stored by Prometheus. + construct :: IO (MetricImpl s) + } + +data MetricImpl s = MetricImpl + { metricImplState :: !s + , metricImplCollect :: IO [SampleGroup] } instance NFData a => NFData (Metric a) where diff --git a/prometheus-client/src/Prometheus/Metric/Counter.hs b/prometheus-client/src/Prometheus/Metric/Counter.hs index 239a2e9..565ef77 100644 --- a/prometheus-client/src/Prometheus/Metric/Counter.hs +++ b/prometheus-client/src/Prometheus/Metric/Counter.hs @@ -20,6 +20,7 @@ import Control.Monad.IO.Class import Control.Monad (unless) import qualified Data.Atomics as Atomics import qualified Data.ByteString.UTF8 as BS +import qualified Data.ByteString.Builder as Builder import qualified Data.IORef as IORef @@ -32,7 +33,7 @@ instance NFData Counter where counter :: Info -> Metric Counter counter info = Metric $ do ioref <- IORef.newIORef 0 - return (MkCounter ioref, collectCounter info ioref) + return $ MetricImpl (MkCounter ioref) (collectCounter info ioref) withCounter :: MonadMonitor m => Counter @@ -67,7 +68,7 @@ unsafeAddCounter c x = do addDurationToCounter :: (MonadIO m, MonadMonitor m) => Counter -> m a -> m a addDurationToCounter metric io = do (result, duration) <- timeAction io - _ <- addCounter metric duration + _ <- addCounter metric duration return result -- | Retrieves the current value of a counter metric. @@ -77,7 +78,7 @@ getCounter (MkCounter ioref) = liftIO $ IORef.readIORef ioref collectCounter :: Info -> IORef.IORef Double -> IO [SampleGroup] collectCounter info c = do value <- IORef.readIORef c - let sample = Sample (metricName info) [] (BS.fromString $ show value) + let sample = Sample (metricName info) mempty (Builder.doubleDec value) return [SampleGroup info CounterType [sample]] -- | Count the amount of times an action throws any synchronous exception. diff --git a/prometheus-client/src/Prometheus/Metric/Gauge.hs b/prometheus-client/src/Prometheus/Metric/Gauge.hs index c0fd80f..21def1f 100644 --- a/prometheus-client/src/Prometheus/Metric/Gauge.hs +++ b/prometheus-client/src/Prometheus/Metric/Gauge.hs @@ -15,6 +15,7 @@ import Prometheus.Metric import Prometheus.Metric.Observer (timeAction) import Prometheus.MonadMonitor +import qualified Data.ByteString.Builder as Builder import Control.DeepSeq import Control.Monad.IO.Class import qualified Data.Atomics as Atomics @@ -31,7 +32,7 @@ instance NFData Gauge where gauge :: Info -> Metric Gauge gauge info = Metric $ do ioref <- IORef.newIORef 0 - return (MkGauge ioref, collectGauge info ioref) + return $ MetricImpl (MkGauge ioref) (collectGauge info ioref) withGauge :: MonadMonitor m => Gauge @@ -71,11 +72,11 @@ getGauge (MkGauge ioref) = liftIO $ IORef.readIORef ioref setGaugeToDuration :: (MonadIO m, MonadMonitor m) => Gauge -> m a -> m a setGaugeToDuration metric io = do (result, duration) <- timeAction io - setGauge metric duration + setGauge metric duration return result collectGauge :: Info -> IORef.IORef Double -> IO [SampleGroup] collectGauge info c = do value <- IORef.readIORef c - let sample = Sample (metricName info) [] (BS.fromString $ show value) + let sample = Sample (metricName info) mempty (Builder.doubleDec value) return [SampleGroup info GaugeType [sample]] diff --git a/prometheus-client/src/Prometheus/Metric/Histogram.hs b/prometheus-client/src/Prometheus/Metric/Histogram.hs index e99da74..ba076fa 100644 --- a/prometheus-client/src/Prometheus/Metric/Histogram.hs +++ b/prometheus-client/src/Prometheus/Metric/Histogram.hs @@ -16,12 +16,15 @@ module Prometheus.Metric.Histogram ( , getHistogram ) where +import Prometheus.Label (labelPairs) import Prometheus.Info import Prometheus.Metric import Prometheus.Metric.Observer import Prometheus.MonadMonitor import Control.Applicative ((<$>)) +import qualified Data.ByteString.Builder as Builder +import qualified Data.ByteString.Builder.RealFloat as Builder import qualified Control.Concurrent.STM as STM import Control.DeepSeq import Control.Monad.IO.Class @@ -30,7 +33,9 @@ import qualified Data.Map.Strict as Map import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T -import Numeric (showFFloat) +import qualified Data.Text.Lazy as T.Lazy +import qualified Data.Text.Lazy.Builder as T.Builder +import qualified Data.Text.Lazy.Builder.RealFloat as T.Builder -- | A histogram. Counts the number of observations that fall within the -- specified buckets. @@ -46,7 +51,7 @@ instance NFData Histogram where histogram :: Info -> [Bucket] -> Metric Histogram histogram info buckets = Metric $ do countsTVar <- STM.newTVarIO (emptyCounts buckets) - return (MkHistogram countsTVar, collectHistogram info countsTVar) + return $ MetricImpl (MkHistogram countsTVar) (collectHistogram info countsTVar) -- | Upper-bound for a histogram bucket. type Bucket = Double @@ -99,26 +104,25 @@ insert value BucketCounts { histTotal = total, histCount = count, histCountsPerB -- | 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 <> "_bucket") [(bucketLabel, "+Inf")] (bsShow count) +collectHistogram info bucketCounts = do + BucketCounts total count counts <- STM.atomically $ STM.readTVar bucketCounts + let sumSample = Sample (name <> "_sum") mempty (Builder.doubleDec total) + let countSample = Sample (name <> "_count") mempty (Builder.intDec count) + let infSample = Sample (name <> "_bucket") (labelPairs bucketLabel "+Inf") (Builder.intDec count) let samples = map toSample (cumulativeSum (Map.toAscList counts)) return [SampleGroup info HistogramType $ samples ++ [infSample, sumSample, countSample]] where + toSample :: (Double, Int) -> Sample toSample (upperBound, count') = - Sample (name <> "_bucket") [(bucketLabel, formatFloat upperBound)] $ bsShow count' + Sample (name <> "_bucket") (labelPairs bucketLabel (formatFloat upperBound)) $ Builder.intDec count' name = metricName info -- We don't particularly want scientific notation, so force regular -- numeric representation instead. - formatFloat x = T.pack (showFFloat Nothing x "") + formatFloat x = + T.Lazy.toStrict $ T.Builder.toLazyText $ T.Builder.formatRealFloat T.Builder.Fixed Nothing x - cumulativeSum xs = zip (map fst xs) (scanl1 (+) (map snd xs)) - - bsShow :: Show s => s -> BS.ByteString - bsShow = BS.fromString . show + cumulativeSum = scanl1 (\(!l, !x) (!l', !x') -> (l', x + x')) -- | The label that defines the upper bound of a bucket of a histogram. @"le"@ -- is short for "less than or equal to". diff --git a/prometheus-client/src/Prometheus/Metric/Summary.hs b/prometheus-client/src/Prometheus/Metric/Summary.hs index dcc5b5d..89b4b89 100644 --- a/prometheus-client/src/Prometheus/Metric/Summary.hs +++ b/prometheus-client/src/Prometheus/Metric/Summary.hs @@ -2,7 +2,7 @@ {-# language OverloadedStrings #-} module Prometheus.Metric.Summary ( Summary -, Quantile +, Quantile(..) , summary , defaultQuantiles , observe @@ -10,6 +10,7 @@ module Prometheus.Metric.Summary ( , getSummary ) where +import Prometheus.Label (labelPairs) import Prometheus.Info import Prometheus.Metric import Prometheus.Metric.Observer @@ -20,8 +21,10 @@ import Control.DeepSeq import Control.Monad import Control.Monad.IO.Class import Control.Monad.Primitive -import qualified Data.ByteString.UTF8 as BS -import qualified Data.Text as T +import qualified Data.ByteString.Builder as Builder +import qualified Data.Text.Lazy as T.Lazy +import qualified Data.Text.Lazy.Builder as T.Builder +import qualified Data.Text.Lazy.Builder.RealFloat as T.Builder import DataSketches.Quantiles.RelativeErrorQuantile import qualified DataSketches.Quantiles.RelativeErrorQuantile as ReqSketch import Data.Maybe (mapMaybe) @@ -38,21 +41,27 @@ instance NFData Summary where rnf (MkSummary a b) = a `seq` b `deepseq` () -type Quantile = (Rational, Rational) +data Quantile = Quantile + { quantileRank :: !Rational + , quantileAcceptableError :: !Rational + } + +instance NFData Quantile where + rnf (Quantile a b) = rnf a `seq` rnf b `seq` () --- | K is a parameter divisible by two, in the range 4-1024 used in the RelativeErrorQuantile algorithm to +-- | K is a parameter divisible by two, in the range 4-1024 used in the RelativeErrorQuantile algorithm to -- determine how many items must be retained per compaction section. As the value increases, the accuracy --- of the sketch increases as well. This function iterates on the k value starting from 6 --- (conservative on space, but reasonably accurate) until it finds a K value that satisfies the specified --- error bounds for the given quantile. Note: this algorithm maintains highest accuracy for the upper tail --- of the quantile when passed the 'HighRanksAreAccurate', sampling out more items at lower ranks during --- the compaction process. Thus, extremely tight error bounds on low quantile values may cause this +-- of the sketch increases as well. This function iterates on the k value starting from 6 +-- (conservative on space, but reasonably accurate) until it finds a K value that satisfies the specified +-- error bounds for the given quantile. Note: this algorithm maintains highest accuracy for the upper tail +-- of the quantile when passed the 'HighRanksAreAccurate', sampling out more items at lower ranks during +-- the compaction process. Thus, extremely tight error bounds on low quantile values may cause this -- function to return 'Nothing'. -- -- If another smart constructor was exposed for summary creation, specific k values & LowRanksAreAccurate -- could be used to refine accuracy settings to bias towards lower quantiles when retaining accurate samples. determineK :: Quantile -> Maybe Word32 -determineK (rank_, acceptableError) = go 6 +determineK Quantile { quantileRank = rank_, quantileAcceptableError = acceptableError } = go 6 where go k = let rse = relativeStandardError (fromIntegral k) (fromRational rank_) HighRanksAreAccurate 50000 @@ -71,7 +80,7 @@ summary info quantiles_ = Metric $ do rs <- mkReqSketch kInt HighRanksAreAccurate mv <- newMVar $ rs {criterion = (:<=)} let summary_ = MkSummary mv quantiles_ - return (summary_, collectSummary info summary_) + return $ MetricImpl summary_ (collectSummary info summary_) where kInt = fromIntegral $ case mapMaybe determineK quantiles_ of [] -> error "Unable to create a Summary meeting the provided quantile precision requirements" @@ -85,28 +94,30 @@ instance Observer Summary where getSummary :: MonadIO m => Summary -> m [(Rational, Double)] getSummary (MkSummary sketchVar quantiles_) = liftIO $ withMVar sketchVar $ \sketch -> do forM quantiles_ $ \qv -> - (,) <$> pure (fst qv) <*> ReqSketch.quantile sketch (fromRational $ fst qv) + (,) <$> pure (quantileRank qv) <*> ReqSketch.quantile sketch (fromRational $ quantileRank qv) collectSummary :: Info -> Summary -> IO [SampleGroup] collectSummary info (MkSummary sketchVar quantiles_) = withMVar sketchVar $ \sketch -> do itemSum <- ReqSketch.sum sketch count_ <- ReqSketch.count sketch estimatedQuantileValues <- forM quantiles_ $ \qv -> - (,) <$> pure (fst qv) <*> ReqSketch.quantile sketch (toDouble $ fst qv) - let sumSample = Sample (metricName info <> "_sum") [] (bsShow itemSum) - let countSample = Sample (metricName info <> "_count") [] (bsShow count_) + (,) <$> pure (quantileRank qv) <*> ReqSketch.quantile sketch (toDouble $ quantileRank qv) + let sumSample = Sample (metricName info <> "_sum") mempty (Builder.doubleDec itemSum) + let countSample = Sample (metricName info <> "_count") mempty (Builder.word64Dec count_) return [SampleGroup info SummaryType $ map toSample estimatedQuantileValues ++ [sumSample, countSample]] where - bsShow :: Show s => s -> BS.ByteString - bsShow = BS.fromString . show - toSample :: (Rational, Double) -> Sample toSample (q, estimatedValue) = - Sample (metricName info) [("quantile", T.pack . show $ toDouble q)] $ - bsShow estimatedValue + Sample (metricName info) (labelPairs "quantile" (formatFloat $ toDouble q)) $ + Builder.doubleDec estimatedValue + + -- We don't particularly want scientific notation, so force regular + -- numeric representation instead. + formatFloat x = + T.Lazy.toStrict $ T.Builder.toLazyText $ T.Builder.realFloat x toDouble :: Rational -> Double toDouble = fromRational defaultQuantiles :: [Quantile] -defaultQuantiles = [(0.5, 0.05), (0.9, 0.01), (0.99, 0.001)] \ No newline at end of file +defaultQuantiles = [Quantile 0.5 0.05, Quantile 0.9 0.01, Quantile 0.99 0.001] diff --git a/prometheus-client/src/Prometheus/Metric/Vector.hs b/prometheus-client/src/Prometheus/Metric/Vector.hs index 117cc84..0fa4a70 100644 --- a/prometheus-client/src/Prometheus/Metric/Vector.hs +++ b/prometheus-client/src/Prometheus/Metric/Vector.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE BangPatterns #-} + module Prometheus.Metric.Vector ( Vector (..) , vector @@ -20,7 +22,10 @@ import qualified Data.Text as T import Data.Traversable (forM) -type VectorState l m = (Metric m, Map.Map l (m, IO [SampleGroup])) +data VectorState l m = VectorState + { vectorStateMetric :: !(Metric m) + , vectorStateMetricMap :: !(Map.Map l (MetricImpl m)) + } data Vector l m = MkVector (IORef.IORef (VectorState l m)) @@ -30,11 +35,11 @@ instance NFData (Vector l m) where -- | Creates a new vector of metrics given a label. vector :: Label l => l -> Metric m -> Metric (Vector l m) vector labels gen = Metric $ do - ioref <- checkLabelKeys labels $ IORef.newIORef (gen, Map.empty) - return (MkVector ioref, collectVector labels ioref) + ioref <- checkLabelKeys labels $ IORef.newIORef $ VectorState gen Map.empty + return $ MetricImpl (MkVector ioref) (collectVector labels ioref) checkLabelKeys :: Label l => l -> a -> a -checkLabelKeys keys r = foldl check r $ map (T.unpack . fst) $ labelPairs keys keys +checkLabelKeys keys r = foldl check r $ map (T.unpack . labelKey) $ unLabelPairs $ labelPairs keys keys where check _ "instance" = error "The label 'instance' is reserved." check _ "job" = error "The label 'job' is reserved." @@ -58,17 +63,17 @@ checkLabelKeys keys r = foldl check r $ map (T.unpack . fst) $ labelPairs keys k -- It is not clear that this will always be a valid assumption. collectVector :: Label l => l -> IORef.IORef (VectorState l m) -> IO [SampleGroup] collectVector keys ioref = do - (_, metricMap) <- IORef.readIORef ioref + VectorState _ metricMap <- IORef.readIORef ioref joinSamples <$> concat <$> mapM collectInner (Map.assocs metricMap) where - collectInner (labels, (_metric, sampleGroups)) = + collectInner (labels, (MetricImpl _metric sampleGroups)) = map (adjustSamples labels) <$> sampleGroups adjustSamples labels (SampleGroup info ty samples) = SampleGroup info ty (map (prependLabels labels) samples) prependLabels l (Sample name labels value) = - Sample name (labelPairs keys l ++ labels) value + Sample name (labelPairs keys l <> labels) value joinSamples [] = [] joinSamples s@(SampleGroup i t _:_) = [SampleGroup i t (extract s)] @@ -80,8 +85,8 @@ getVectorWith :: Vector label metric -> (metric -> IO a) -> IO [(label, a)] getVectorWith (MkVector valueTVar) f = do - (_, metricMap) <- IORef.readIORef valueTVar - Map.assocs <$> forM metricMap (f . fst) + VectorState _ metricMap <- IORef.readIORef valueTVar + Map.assocs <$> forM metricMap (f . metricImplState) -- | Given a label, applies an operation to the corresponding metric in the -- vector. @@ -91,26 +96,26 @@ withLabel :: (Label label, MonadMonitor m) -> (metric -> IO ()) -> m () withLabel (MkVector ioref) label f = doIO $ do - (Metric gen, _) <- IORef.readIORef ioref + VectorState (Metric gen) _ <- IORef.readIORef ioref newMetric <- gen - metric <- Atomics.atomicModifyIORefCAS ioref $ \(_, metricMap) -> + MetricImpl metric newVectorState <- Atomics.atomicModifyIORefCAS ioref $ \(VectorState _ metricMap) -> let maybeMetric = Map.lookup label metricMap updatedMap = Map.insert label newMetric metricMap in case maybeMetric of - Nothing -> ((Metric gen, updatedMap), newMetric) - Just metric -> ((Metric gen, metricMap), metric) - f (fst metric) + Nothing -> (VectorState (Metric gen) updatedMap, newMetric) + Just metric -> (VectorState (Metric gen) metricMap, metric) + f metric -- | Removes a label from a vector. removeLabel :: (Label label, MonadMonitor m) => Vector label metric -> label -> m () removeLabel (MkVector valueTVar) label = doIO $ Atomics.atomicModifyIORefCAS_ valueTVar f - where f (desc, metricMap) = (desc, Map.delete label metricMap) + where f (VectorState desc metricMap) = VectorState desc (Map.delete label metricMap) -- | Removes all labels from a vector. clearLabels :: (Label label, MonadMonitor m) => Vector label metric -> m () clearLabels (MkVector valueTVar) = doIO $ Atomics.atomicModifyIORefCAS_ valueTVar f - where f (desc, _) = (desc, Map.empty) + where f (VectorState desc _) = VectorState desc Map.empty diff --git a/prometheus-client/src/Prometheus/Registry.hs b/prometheus-client/src/Prometheus/Registry.hs index 7de5381..e61b44e 100644 --- a/prometheus-client/src/Prometheus/Registry.hs +++ b/prometheus-client/src/Prometheus/Registry.hs @@ -31,7 +31,7 @@ globalRegistry = unsafePerformIO $ STM.newTVarIO [] -- | Registers a metric with the global metric registry. register :: MonadIO m => Metric s -> m s register (Metric mk) = liftIO $ do - (metric, sampleGroups) <- mk + MetricImpl metric sampleGroups <- mk let addToRegistry = (sampleGroups :) liftIO $ STM.atomically $ STM.modifyTVar' globalRegistry addToRegistry return metric diff --git a/prometheus-client/tests/Prometheus/Metric/SummarySpec.hs b/prometheus-client/tests/Prometheus/Metric/SummarySpec.hs index a736129..daf5eab 100644 --- a/prometheus-client/tests/Prometheus/Metric/SummarySpec.hs +++ b/prometheus-client/tests/Prometheus/Metric/SummarySpec.hs @@ -11,7 +11,7 @@ import Prometheus.Metric.Summary import Control.Applicative ((<$>)) import Control.Monad import Data.Int (Int64) -import Data.List (sort, sortBy) +import Data.List (sort, sortBy, sortOn) import Numeric (fromRat) import System.Random.Shuffle import Test.Hspec @@ -19,7 +19,7 @@ import Test.QuickCheck spec :: Spec spec = describe "Prometheus.Metric.Summary" $ do - observeToUnsafe + observeToUnsafe let windowSize = 10000 it "computes quantiles correctly for [0,10000) in order" $ do m <- register $ summary (Info "name" "help") quantiles @@ -53,7 +53,7 @@ spec = describe "Prometheus.Metric.Summary" $ do testMetric :: Summary testMetric = do unsafeRegister $ summary (Info "test_histogram" "") quantiles - + observeToUnsafe :: Spec observeToUnsafe = it "Is able to observe to a top-level 'unsafeRegister' metric" $ do @@ -125,15 +125,16 @@ checkQuantiles m windowSize values = do ] quantiles :: [Quantile] -quantiles = [(0.5, 0.05), (0.9, 0.01), (0.99, 0.001)] +quantiles = [Quantile 0.5 0.05, Quantile 0.9 0.01, Quantile 0.99 0.001] getQuantiles :: [Quantile] -> Summary -> IO [(Rational, Rational, Double)] getQuantiles qs s = do - values <- sortQuantiles <$> getSummary s + values <- sortQuantiles' <$> getSummary s let sortedQuantiles = sortQuantiles qs - return $ zipWith (\(q, e) (_, v) -> (q, e, v)) sortedQuantiles values + return $ zipWith (\(Quantile q e) (_, v) -> (q, e, v)) sortedQuantiles values where - sortQuantiles = sortBy (\(a, _) (b, _) -> compare a b) + sortQuantiles = sortBy (\(Quantile a _) (Quantile b _) -> compare a b) + sortQuantiles' = sortOn fst -- | Return a tuple that describes the range of that an element's true rank can -- be in. For example, in the list [0, 0, 0, 1] the result for querying 0 will diff --git a/prometheus-metrics-ghc/prometheus-metrics-ghc.cabal b/prometheus-metrics-ghc/prometheus-metrics-ghc.cabal index 91f2192..7ffc7b1 100644 --- a/prometheus-metrics-ghc/prometheus-metrics-ghc.cabal +++ b/prometheus-metrics-ghc/prometheus-metrics-ghc.cabal @@ -28,6 +28,7 @@ library , prometheus-client >=1.0.0 && <1.2 , utf8-string >=0.3 , text + , bytestring ghc-options: -Wall test-suite doctest diff --git a/prometheus-metrics-ghc/src/Prometheus/Metric/GHC.hs b/prometheus-metrics-ghc/src/Prometheus/Metric/GHC.hs index 1148b12..8166e1b 100644 --- a/prometheus-metrics-ghc/src/Prometheus/Metric/GHC.hs +++ b/prometheus-metrics-ghc/src/Prometheus/Metric/GHC.hs @@ -19,8 +19,9 @@ module Prometheus.Metric.GHC ( #if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>)) #endif -import qualified Data.ByteString.UTF8 as BS import Data.Text (Text) +import Data.ByteString.Builder (Builder) +import qualified Data.ByteString.Builder as Builder import Data.Fixed (Fixed, E9) #if __GLASGOW_HASKELL__ < 804 import GHC.Conc (numSparks, getNumCapabilities) @@ -35,7 +36,7 @@ import Prometheus data GHCMetrics = GHCMetrics ghcMetrics :: Metric GHCMetrics -ghcMetrics = ghcMetricsWithLabels [] +ghcMetrics = ghcMetricsWithLabels mempty ghcMetricsWithLabels :: LabelPairs -> Metric GHCMetrics ghcMetricsWithLabels labels = Metric (do @@ -46,7 +47,7 @@ ghcMetricsWithLabels labels = Metric (do getRTSStatsEnabled #endif if statsEnabled - then return (GHCMetrics, do + then return $ MetricImpl GHCMetrics $ do stats <- #if __GLASGOW_HASKELL__ < 804 getGCStats @@ -54,8 +55,7 @@ ghcMetricsWithLabels labels = Metric (do getRTSStats #endif concat <$> mapM (\f -> f labels stats) ghcCollectors - ) - else return (GHCMetrics, return []) + else return $ MetricImpl GHCMetrics (return []) ) #if __GLASGOW_HASKELL__ < 804 @@ -172,92 +172,92 @@ ghcCollectors = [ "ghc_gcs_total" "Total number of GCs" CounterType - gcs + (Builder.word32Dec . gcs) , statsCollector "ghc_major_gcs_total" "Total number of major (oldest generation) GCs" CounterType - major_gcs + (Builder.word32Dec . major_gcs) , statsCollector "ghc_allocated_bytes_total" "Total bytes allocated" CounterType - allocated_bytes + (Builder.word64Dec . allocated_bytes) , statsCollector "ghc_max_live_bytes" "Maximum live data (including large objects + compact regions)" GaugeType - max_live_bytes + (Builder.word64Dec . max_live_bytes) , statsCollector "ghc_max_large_objects_bytes" "Maximum live data in large objects" GaugeType - max_large_objects_bytes + (Builder.word64Dec . max_large_objects_bytes) , statsCollector "ghc_max_compact_bytes" "Maximum live data in compact regions" GaugeType - max_compact_bytes + (Builder.word64Dec . max_compact_bytes) , statsCollector "ghc_max_slop_bytes" "Maximum slop" GaugeType - max_slop_bytes + (Builder.word64Dec . max_slop_bytes) , statsCollector "ghc_max_mem_in_use_bytes" "Maximum memory in use by the RTS" GaugeType - max_mem_in_use_bytes + (Builder.word64Dec . max_mem_in_use_bytes) , statsCollector "ghc_cumulative_live_bytes_total" "Sum of live bytes across all major GCs. Divided by major_gcs gives the average live data over the lifetime of the program." CounterType - cumulative_live_bytes + (Builder.word64Dec . cumulative_live_bytes) , statsCollector "ghc_copied_bytes_total" "Sum of copied_bytes across all GCs" CounterType - copied_bytes + (Builder.word64Dec . copied_bytes) , statsCollector "ghc_par_copied_bytes_total" "Sum of copied_bytes across all parallel GCs" CounterType - par_copied_bytes + (Builder.word64Dec . par_copied_bytes) , statsCollector "ghc_cumulative_par_max_copied_bytes_total" "Sum of par_max_copied_bytes across all parallel GCs" CounterType - cumulative_par_max_copied_bytes + (Builder.word64Dec . cumulative_par_max_copied_bytes) , statsCollector "ghc_mutator_cpu_seconds_total" "Total CPU time used by the mutator" CounterType - (rtsTimeToSeconds . mutator_cpu_ns) + (Builder.doubleDec . fromRational . toRational . rtsTimeToSeconds . mutator_cpu_ns) , statsCollector "ghc_mutator_elapsed_seconds_total" "Total elapsed time used by the mutator" CounterType - (rtsTimeToSeconds . mutator_elapsed_ns) + (Builder.doubleDec . fromRational . toRational . rtsTimeToSeconds . mutator_elapsed_ns) , statsCollector "ghc_gc_cpu_seconds_total" "Total CPU time used by the GC" CounterType - (rtsTimeToSeconds . gc_cpu_ns) + (Builder.doubleDec . fromRational . toRational . rtsTimeToSeconds . gc_cpu_ns) , statsCollector "ghc_gc_elapsed_seconds_total" "Total elapsed time used by the GC" CounterType - (rtsTimeToSeconds . gc_elapsed_ns) + (Builder.doubleDec . fromRational . toRational . rtsTimeToSeconds . gc_elapsed_ns) , statsCollector "ghc_cpu_seconds_total" "Total CPU time (at the previous GC)" CounterType - (rtsTimeToSeconds . cpu_ns) + (Builder.doubleDec . fromRational . toRational . rtsTimeToSeconds . cpu_ns) , statsCollector "ghc_elapsed_seconds_total" "Total elapsed time (at the previous GC)" CounterType - (rtsTimeToSeconds . elapsed_ns) + (Builder.doubleDec . fromRational . toRational . rtsTimeToSeconds . elapsed_ns) , statsCollector "ghc_gcdetails_gen" @@ -266,67 +266,67 @@ ghcCollectors = [ -- Gauge makes little sense here. -- With Histogram we'll be able to see which -- generations are collected most often. - (gcdetails_gen . gc) + (Builder.word32Dec . gcdetails_gen . gc) , statsCollector "ghc_gcdetails_threads" "Number of threads used in this GC" GaugeType - (gcdetails_threads . gc) + (Builder.word32Dec . gcdetails_threads . gc) , statsCollector "ghc_gcdetails_allocated_bytes" "Number of bytes allocated since the previous GC" GaugeType -- TODO: this doesn't seem very meaningful. - (gcdetails_allocated_bytes . gc) + (Builder.word64Dec . gcdetails_allocated_bytes . gc) , statsCollector "ghc_gcdetails_live_bytes" "Total amount of live data in the heap (including large + compact data)" GaugeType - (gcdetails_live_bytes . gc) + (Builder.word64Dec . gcdetails_live_bytes . gc) , statsCollector "ghc_gcdetails_large_objects_bytes" "Total amount of live data in large objects" GaugeType - (gcdetails_large_objects_bytes . gc) + (Builder.word64Dec . gcdetails_large_objects_bytes . gc) , statsCollector "ghc_gcdetails_compact_bytes" "Total amount of live data in compact regions" GaugeType - (gcdetails_compact_bytes . gc) + (Builder.word64Dec . gcdetails_compact_bytes . gc) , statsCollector "ghc_gcdetails_slop_bytes" "Total amount of slop (wasted memory)" GaugeType - (gcdetails_slop_bytes . gc) + (Builder.word64Dec . gcdetails_slop_bytes . gc) , statsCollector "ghc_gcdetails_mem_in_use_bytes" "Total amount of memory in use by the RTS" GaugeType - (gcdetails_mem_in_use_bytes . gc) + (Builder.word64Dec . gcdetails_mem_in_use_bytes . gc) , statsCollector "ghc_gcdetails_copied_bytes" "Total amount of data copied during this GC" GaugeType -- TODO: this will also vary wildly between GCs of different generations. - (gcdetails_copied_bytes . gc) + (Builder.word64Dec . gcdetails_copied_bytes . gc) , statsCollector "ghc_gcdetails_par_max_copied_bytes" "In parallel GC, the max amount of data copied by any one thread" GaugeType - (gcdetails_par_max_copied_bytes . gc) + (Builder.word64Dec . gcdetails_par_max_copied_bytes . gc) , statsCollector "ghc_gcdetails_sync_elapsed_seconds" "The time elapsed during synchronisation before GC" GaugeType - (rtsTimeToSeconds . gcdetails_sync_elapsed_ns . gc) + (Builder.doubleDec . fromRational . toRational . rtsTimeToSeconds . gcdetails_sync_elapsed_ns . gc) , statsCollector "ghc_gcdetails_cpu_seconds" "The CPU time used during GC itself" GaugeType - (rtsTimeToSeconds . gcdetails_cpu_ns . gc) + (Builder.doubleDec . fromRational . toRational . rtsTimeToSeconds . gcdetails_cpu_ns . gc) , statsCollector "ghc_gcdetails_elapsed_seconds" "The time elapsed during GC itself" GaugeType - (rtsTimeToSeconds . gcdetails_elapsed_ns . gc) + (Builder.doubleDec . fromRational . toRational . rtsTimeToSeconds . gcdetails_elapsed_ns . gc) ] -- | Convert from 'RtsTime' (nanoseconds) to seconds with nanosecond precision. @@ -335,19 +335,16 @@ rtsTimeToSeconds = (/ 1e9) . fromIntegral #endif #if __GLASGOW_HASKELL__ < 804 -statsCollector :: Show a - => Text -> Text -> SampleType -> (GCStats -> a) -> LabelPairs -> GCStats -> IO [SampleGroup] +statsCollector :: Text -> Text -> SampleType -> (GCStats -> Builder) -> LabelPairs -> GCStats -> IO [SampleGroup] statsCollector name help sampleType stat labels gcstats = showCollector name help sampleType (stat gcstats) labels #else -statsCollector :: Show a - => Text -> Text -> SampleType -> (RTSStats -> a) -> LabelPairs -> RTSStats -> IO [SampleGroup] +statsCollector :: Text -> Text -> SampleType -> (RTSStats -> Builder) -> LabelPairs -> RTSStats -> IO [SampleGroup] statsCollector name help sampleType stat labels rtsStats = showCollector name help sampleType (stat rtsStats) labels #endif -showCollector :: Show a => Text -> Text -> SampleType -> a -> LabelPairs -> IO [SampleGroup] +showCollector :: Text -> Text -> SampleType -> Builder -> LabelPairs -> IO [SampleGroup] showCollector name help sampleType value labels = do let info = Info name help - let valueBS = BS.fromString $ show value - return [SampleGroup info sampleType [Sample name labels valueBS]] + return [SampleGroup info sampleType [Sample name labels value]] diff --git a/stack.yaml b/stack.yaml index ec9efad..0c29c07 100644 --- a/stack.yaml +++ b/stack.yaml @@ -5,7 +5,4 @@ packages: - prometheus-metrics-ghc - prometheus-proc - wai-middleware-prometheus -extra-deps: -- unix-memory-0.1.2 -- data-sketches-0.3.0.0 -resolver: lts-18.5 +resolver: lts-22.43