Add new V3 API following Prometheus spec

ExampleV3.hs

@@ -0,0 +1,72 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoFieldSelectors #-}
+
+import Control.Concurrent (threadDelay)
+import Control.Monad (forever)
+import Data.Hashable (Hashable)
+import GHC.Generics (Generic)
+import qualified Prometheus.V3 as Prom
+import qualified Prometheus.V3.Metric.Counter as Counter
+
+
+type Status = Int
+
+
+data Method = GET | POST
+    deriving (Eq, Generic, Hashable)
+instance Prom.IsLabelValue Method where
+    toLabelValue = \case
+        GET -> "GET"
+        POST -> "POST"
+
+
+fooCounter :: Prom.Counter
+fooCounter = Counter.register "foo_total" "Number of foos"
+{-# OPAQUE fooCounter #-}
+
+
+requestsCounter :: Prom.Labelled (Method, Status) Prom.Counter
+requestsCounter =
+    Prom.register
+        . Prom.withLabels ("method", "status") labels
+        $ Counter.new "requests_total" "Number of requests"
+  where
+    labels =
+        [ (method, status)
+        | method <- [GET, POST]
+        , status <- [200, 404, 500]
+        ]
+{-# OPAQUE requestsCounter #-}
+
+
+data Request = Request
+    { method :: Method
+    }
+
+
+myHandler :: Request -> IO ()
+myHandler req = do
+    status <- pure 200
+
+    Counter.inc fooCounter
+    Counter.inc (Counter.labels (req.method, status) requestsCounter)
+
+    -- Cache it, for a hot loop
+    c <- Counter.labels (req.method, status) requestsCounter
+    Counter.inc c
+
+
+main :: IO ()
+main = do
+    Prom.serveMetrics 9090 -- Serves metrics on separate thread
+    myHandler Request{method = GET}
+    myHandler Request{method = GET}
+
+    putStrLn ">>> Server running."
+    putStrLn ">>> Run `curl localhost:9090` to see metrics"
+    putStrLn ">>> Press Ctrl-C to exit"
+    forever $ threadDelay 10000000

prometheus-ghc-stats/src/lib/System/Metrics/Prometheus/GHCStats.hs

@@ -149,5 +149,5 @@ setCounterFrom :: Integral a => s -> (s -> a) -> Counter -> IO ()
 setCounterFrom s f = Counter.set (fromIntegral (f s))
 
 
-setGaugeFrom :: Integral a => s -> (s -> a) -> Gauge -> IO ()
+setGaugeFrom :: Integral a => s -> (s -> a) -> Gauge Double -> IO ()
 setGaugeFrom s f = Gauge.set (fromIntegral (f s))

prometheus.cabal

@@ -88,19 +88,40 @@ library
                  , System.Metrics.Prometheus.MetricId
                  , System.Metrics.Prometheus.Registry
                  , System.Metrics.Prometheus.RegistryT
+                 , Prometheus.V3
+                 , Prometheus.V3.Collector
+                 , Prometheus.V3.Encode
+                 , Prometheus.V3.Encode.Value
+                 , Prometheus.V3.Http.Serve
+                 , Prometheus.V3.Label
+                 , Prometheus.V3.LabelName
+                 , Prometheus.V3.Metric.Base
+                 , Prometheus.V3.Metric.Counter
+                 , Prometheus.V3.Metric.Gauge
+                 , Prometheus.V3.Metric.Histogram
+                 , Prometheus.V3.Metric.Labelled
+                 , Prometheus.V3.MetricName
+                 , Prometheus.V3.Name
+                 , Prometheus.V3.Registry
+                 , Prometheus.V3.Sample
+                 , Prometheus.V3.Utils.FromRealFrac
 
   build-depends: base            >= 4.18 && < 5
                , atomic-primops  >= 0.8  && < 0.9
                , bytestring      >= 0.10 && < 0.13
                , containers      >= 0.5  && < 0.8
+               , hashable        >= 1.0  && < 1.6
                , http-client     >= 0.4  && < 0.8
                , http-client-tls >= 0.3  && < 0.5
                , http-types      >= 0.8  && < 0.13
                , network-uri     >= 2.5  && < 2.7
                , text            >= 1.2  && < 2.2
+               , time            >= 1.0  && < 1.17
                , transformers    >= 0.4  && < 0.7
                , wai             >= 3.2  && < 3.3
                , warp            >= 3.2  && < 3.5
+               , unliftio        >= 0.2.17 && < 0.3
+               , unordered-containers >= 0.2.10.0 && < 0.3
 
 executable prometheus-example
   main-is: Example.hs
@@ -116,6 +137,21 @@ executable prometheus-example
   else
     buildable:         False
 
+executable prometheus-example-v3
+  main-is: ExampleV3.hs
+  default-language: Haskell2010
+
+  ghc-options: -Wall -fwarn-tabs -fno-warn-unused-do-bind
+
+  build-depends: base
+               , hashable
+               , prometheus
+
+  if flag(buildexamples)
+    buildable:         True
+  else
+    buildable:         False
+
 source-repository head
   type:     git
   location: https://github.com/bitnomial/prometheus

src/Prometheus/V3.hs

@@ -0,0 +1,96 @@
+-- | A new implementation of the API, following Prometheus's standard for writing
+-- client libraries: https://prometheus.io/docs/instrumenting/writing_clientlibs/
+--
+-- When releasing prometheus-3.0:
+--   * Rename this as Prometheus
+--   * Remove old 'System.Metrics.Prometheus' modules
+--   * Update README/Cabal description for new API
+--   * Delete this preamble
+--
+-- == Usage
+--
+-- The recommended usage is to initialize the metrics as top-level global
+-- variables in the same file as the functions they're instrumenting.
+--
+-- Note: globally registered metrics are only registered when it's used for the
+-- first time, due to laziness.
+--
+-- @
+-- {-# LANGUAGE OverloadedStrings #-}
+--
+-- import Prometheus.V3 qualified as Prom
+-- import Prometheus.V3.Metric.Counter qualified as Counter
+--
+-- fooCounter :: Prom.Counter
+-- fooCounter = Counter.register "foo_total" "Number of foos"
+-- {-# OPAQUE fooCounter #-}
+--
+-- requestsCounter :: Prom.Labelled Prom.Counter
+-- requestsCounter =
+--   Prom.register
+--     . Prom.withLabels ("method", "status") labels
+--     $ Counter.new "requests_total" "Number of requests"
+--   where
+--     labels =
+--       [ (method, status)
+--       | method <- [GET, POST]
+--       , status <- [200, 404, 500]
+--       ]
+-- {-# OPAQUE requestsCounter #-}
+--
+-- myHandler req = do
+--   status <- run req
+--
+--   Counter.inc fooCounter
+--   Counter.inc (Counter.labels (requestMethod req, status) requestsCounter)
+--
+--   -- Cache it, for a hot loop
+--   c <- Counter.labels (requestMethod req, status) requestsCounter
+--   Counter.inc c
+--
+-- main :: IO ()
+-- main = do
+--   Prom.serveMetrics 9090 -- Serves metrics on separate thread
+-- @
+--
+-- Alternatively, you could initialize metrics in IO and pass it to your
+-- functions as normal (e.g. Reader monad, as a function arg, etc.):
+--
+-- @
+-- registry <- Prom.newRegistry
+-- fooCounter <- Prom.registerTo registry $ Counter.new "foo_counter" ""
+-- @
+--
+-- For advanced use-cases, you can also construct your own
+-- 'Prometheus.V3.Collector.Collector' manually and register it to the registry.
+module Prometheus.V3 (
+    -- * Metric types
+    Metric,
+    Counter,
+    Gauge,
+    Histogram,
+
+    -- * Labels
+    Labelled,
+    withLabels,
+    IsLabelValue (..),
+
+    -- * Registry
+    globalRegistry,
+    registerTo,
+    unregisterFrom,
+    register,
+
+    -- * Serving metrics
+    serveMetrics,
+) where
+
+import Prometheus.V3.Http.Serve
+import Prometheus.V3.Label
+import Prometheus.V3.Metric.Base
+import Prometheus.V3.Metric.Counter (Counter)
+import Prometheus.V3.Metric.Gauge (Gauge)
+import Prometheus.V3.Metric.Histogram (Histogram)
+import Prometheus.V3.Metric.Labelled
+import Prometheus.V3.Registry
+

src/Prometheus/V3/Collector.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE NoFieldSelectors #-}
+
+module Prometheus.V3.Collector (
+    Collector (..),
+
+    -- * Re-exports
+    MetricName,
+    Description,
+    MetricType (..),
+    Sample (..),
+    SampleValue,
+    defaultSample,
+    ToSampleValue (..),
+) where
+
+import Prometheus.V3.Metric.Base (
+    Description,
+    MetricName,
+    MetricType (..),
+ )
+import Prometheus.V3.Sample (
+    Sample (..),
+    SampleValue,
+    ToSampleValue (..),
+    defaultSample,
+ )
+
+
+data Collector = Collector
+    { name :: MetricName
+    , description :: Description
+    , type_ :: MetricType
+    , getSamples :: IO [Sample]
+    }