diff --git a/Example.hs b/Example.hs new file mode 100644 --- /dev/null +++ b/Example.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Example where + +import System.Metrics.Prometheus.GlobalRegistry +import System.Metrics.Prometheus.Http +import System.Metrics.Prometheus.Metric.Counter (inc) +import System.Metrics.Prometheus.MetricId + + +main :: IO () +main = do + globalRegistry <- new + + -- Labels can be defined as lists or added to an empty label set + connectSuccessGauge <- registerGauge "example_connections" (fromList [("login", "success")]) globalRegistry + connectFailureGauge <- registerGauge "example_connections" (addLabel "login" "failure" mempty) globalRegistry + connectCounter <- registerCounter "example_connection_total" mempty globalRegistry + latencyHistogram <- registerHistogram "example_round_trip_latency_ms" mempty [10, 20..100] globalRegistry + + inc connectCounter -- increment a counter + + -- [...] pass metric handles to the rest of the app + + serveHttpTextMetrics 8080 globalRegistry -- http://localhost:8080/metric server diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,55 @@ +# Prometheus Haskell Client + +A simple and modern, type safe, idiomatic Haskell client for +[Prometheus](http://prometheus.io) monitoring. Specifically there is +no use of unsafe IO or manual ByteString construction from lists of +bytes. Batteries-included web server. . [Usage Example] + +- [Hackage Package](https://hackage.haskell.org/package/prometheus) +- [Github](http://github.com/LukeHoersten/prometheus) + +## Usage Example + +```haskell +{-# LANGUAGE OverloadedStrings #-} + +module Example where + +import System.Metrics.Prometheus.GlobalRegistry +import System.Metrics.Prometheus.Http +import System.Metrics.Prometheus.Metric.Counter (inc) +import System.Metrics.Prometheus.MetricId + + +main :: IO () +main = do + globalRegistry <- new + + -- Labels can be defined as lists or added to an empty label set + connectSuccessGauge <- registerGauge "example_connections" (fromList [("login", "success")]) globalRegistry + connectFailureGauge <- registerGauge "example_connections" (addLabel "login" "failure" mempty) globalRegistry + connectCounter <- registerCounter "example_connection_total" mempty globalRegistry + latencyHistogram <- registerHistogram "example_round_trip_latency_ms" mempty [10, 20..100] globalRegistry + + inc connectCounter -- increment a counter + + -- [...] pass metric handles to the rest of the app + + serveHttpTextMetrics 8080 globalRegistry -- http://localhost:8080/metric server +``` + +## Advanced Usage + +A `Registry` and `StateT`-based `RegistryT` are available for unit +testing or generating lists of `[IO a]` actions that can be +`sequenced` and returned from pure code to be applied. + +## Tasks + +- [ ] Implement help docstrings. +- [ ] Implement GHC-specific metrics. +- [ ] Implement [summary metric](https://github.com/prometheus/client_golang/blob/master/prometheus/summary.go). +- [ ] Encode name and labels on register. +- [ ] Implement ReaderT for GlobalRegistry. +- [ ] Library documentation and example. +- [ ] [Name and label validation](http://prometheus.io/docs/concepts/data_model/#metric-names-and-labels) diff --git a/prometheus.cabal b/prometheus.cabal --- a/prometheus.cabal +++ b/prometheus.cabal @@ -1,16 +1,62 @@ name: prometheus -version: 0.1.0.3 +version: 0.1.1 synopsis: Prometheus Haskell Client -description: Idiomatic Haskell client for Prometheus.io monitoring. homepage: http://github.com/LukeHoersten/prometheus#readme +bug-reports: http://github.com/LukeHoersten/prometheus/issues license: BSD3 license-file: LICENSE author: Luke Hoersten maintainer: luke@hoersten.org copyright: All Rights Reserved -category: Web +category: Metrics, Monitoring, Web, System build-type: Simple cabal-version: >=1.10 + +description: + [Prometheus Haskell Client] + . + A simple and modern, type safe, idiomatic Haskell client for + monitoring. Specifically there is no + use of unsafe IO or manual ByteString construction from lists of + bytes. Batteries-included web server. + . + [Usage Example] + . + > {-# LANGUAGE OverloadedStrings #-} + > + > module Example where + > + > import System.Metrics.Prometheus.GlobalRegistry + > import System.Metrics.Prometheus.Http + > import System.Metrics.Prometheus.Metric.Counter (inc) + > import System.Metrics.Prometheus.MetricId + > + > + > main :: IO () + > main = do + > globalRegistry <- new + > + > -- Labels can be defined as lists or added to an empty label set + > connectSuccessGauge <- registerGauge "example_connections" (fromList [("login", "success")]) globalRegistry + > connectFailureGauge <- registerGauge "example_connections" (addLabel "login" "failure" mempty) globalRegistry + > connectCounter <- registerCounter "example_connection_total" mempty globalRegistry + > latencyHistogram <- registerHistogram "example_round_trip_latency_ms" mempty [10, 20..100] globalRegistry + > + > inc connectCounter -- increment a counter + > + > -- [...] pass metric handles to the rest of the app + > + > serveHttpTextMetrics 8080 globalRegistry -- http://localhost:8080/metric server + > + . + [Advanced Usage] + . + A `Registry` and `StateT`-based `RegistryT` are available for unit testing or generating lists + of `[IO a]` actions that can be `sequenced` and returned from pure code to be applied. + + +extra-source-files: Example.hs + , README.md library hs-source-dirs: src diff --git a/src/System/Metrics/Prometheus/Encode/MetricId.hs b/src/System/Metrics/Prometheus/Encode/MetricId.hs --- a/src/System/Metrics/Prometheus/Encode/MetricId.hs +++ b/src/System/Metrics/Prometheus/Encode/MetricId.hs @@ -16,7 +16,6 @@ import Data.ByteString.Builder (Builder, byteString, char8, intDec) import Data.List (intersperse) -import qualified Data.Map as Map import Data.Monoid ((<>)) import Data.Text (Text, replace) import Data.Text.Encoding (encodeUtf8) @@ -24,11 +23,12 @@ import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Builder.RealFloat (FPFormat (Generic), formatRealFloat) +import Prelude hiding (null) import System.Metrics.Prometheus.Metric (MetricSample (..), metricSample) import System.Metrics.Prometheus.MetricId (Labels (..), MetricId (..), - Name (..)) + Name (..), null, toList) encodeHeader :: MetricId -> MetricSample -> Builder @@ -53,12 +53,11 @@ encodeLabels :: Labels -> Builder encodeLabels ls - | Map.null ls' = space + | null ls = space | otherwise = openBracket - <> (mconcat . intersperse comma . map encodeLabel $ Map.toList ls') + <> (mconcat . intersperse comma . map encodeLabel $ toList ls) <> closeBracket - where ls' = unLabels ls encodeLabel :: (Text, Text) -> Builder @@ -68,7 +67,7 @@ textValue :: RealFloat f => f -> Text textValue x | isInfinite x && x > 0 = "+Inf" | isInfinite x && x < 0 = "-Inf" - | isNaN x = "Nan" + | isNaN x = "NaN" | otherwise = toStrict . toLazyText $ formatRealFloat Generic Nothing x diff --git a/src/System/Metrics/Prometheus/Http.hs b/src/System/Metrics/Prometheus/Http.hs --- a/src/System/Metrics/Prometheus/Http.hs +++ b/src/System/Metrics/Prometheus/Http.hs @@ -33,8 +33,7 @@ prometheusResponse :: (Response -> IO b) -> GlobalRegistry -> IO b -prometheusResponse respond globalRegistry = do - s <- sample globalRegistry - respond . responseBuilder status200 headers $ encodeMetrics s +prometheusResponse respond gr = + respond . responseBuilder status200 headers . encodeMetrics =<< sample gr where headers = [(hContentType, "text/plain; version=0.0.4")] diff --git a/src/System/Metrics/Prometheus/Metric/Counter.hs b/src/System/Metrics/Prometheus/Metric/Counter.hs --- a/src/System/Metrics/Prometheus/Metric/Counter.hs +++ b/src/System/Metrics/Prometheus/Metric/Counter.hs @@ -21,7 +21,8 @@ add :: Int -> Counter -> IO () -add by = incrCounter_ by . unCounter +add by | by >= 0 = incrCounter_ by . unCounter + | otherwise = error "must be >= 0" inc :: Counter -> IO () diff --git a/src/System/Metrics/Prometheus/Metric/Histogram.hs b/src/System/Metrics/Prometheus/Metric/Histogram.hs --- a/src/System/Metrics/Prometheus/Metric/Histogram.hs +++ b/src/System/Metrics/Prometheus/Metric/Histogram.hs @@ -3,9 +3,10 @@ module System.Metrics.Prometheus.Metric.Histogram ( Histogram , HistogramSample (..) + , Buckets , UpperBound , new - , put + , observe , sample ) where @@ -38,15 +39,15 @@ zeroCount = 0 -put :: Double -> Histogram -> IO () -put x ioref = atomicModifyIORef' (unHistogram ioref) update - where - update histData = (hist' histData, ()) - hist' histData = - histData { histBuckets = updateBuckets x $ histBuckets histData - , histSum = histSum histData + x - , histCount = histCount histData + 1 - } +observe :: Double -> Histogram -> IO () +observe x = flip atomicModifyIORef' update . unHistogram + where + update histData = (hist' histData, ()) + hist' histData = + histData { histBuckets = updateBuckets x $ histBuckets histData + , histSum = histSum histData + x + , histCount = histCount histData + 1 + } updateBuckets :: Double -> Buckets -> Buckets diff --git a/src/System/Metrics/Prometheus/MetricId.hs b/src/System/Metrics/Prometheus/MetricId.hs --- a/src/System/Metrics/Prometheus/MetricId.hs +++ b/src/System/Metrics/Prometheus/MetricId.hs @@ -6,6 +6,7 @@ import qualified Data.Map as Map import Data.String (IsString) import Data.Text (Text) +import Prelude hiding (null) newtype Name = Name { unName :: Text } deriving (Show, Eq, Ord, IsString, Monoid) @@ -25,3 +26,11 @@ fromList :: [(Text, Text)] -> Labels fromList = Labels . Map.fromList + + +toList :: Labels -> [(Text, Text)] +toList = Map.toList . unLabels + + +null :: Labels -> Bool +null = Map.null . unLabels