prometheus 0.2.0 → 0.3.0
raw patch · 8 files changed
+187/−141 lines, 8 files
Files
- Example.hs +11/−13
- README.md +11/−13
- prometheus.cabal +16/−17
- src/System/Metrics/Prometheus/Concurrent/Http.hs +55/−0
- src/System/Metrics/Prometheus/Concurrent/Registry.hs +50/−0
- src/System/Metrics/Prometheus/Concurrent/RegistryT.hs +44/−0
- src/System/Metrics/Prometheus/GlobalRegistry.hs +0/−52
- src/System/Metrics/Prometheus/Http.hs +0/−46
Example.hs view
@@ -2,24 +2,22 @@ module Example where -import System.Metrics.Prometheus.GlobalRegistry-import System.Metrics.Prometheus.Http-import System.Metrics.Prometheus.Metric.Counter (inc)+import Control.Monad.IO.Class (liftIO)+import System.Metrics.Prometheus.Concurrent.Http (serveHttpTextMetricsT)+import System.Metrics.Prometheus.Concurrent.RegistryT+import System.Metrics.Prometheus.Metric.Counter (inc) import System.Metrics.Prometheus.MetricId - main :: IO ()-main = do- globalRegistry <- new-+main = runRegistryT $ do -- 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+ connectSuccessGauge <- registerGauge "example_connections" (fromList [("login", "success")])+ connectFailureGauge <- registerGauge "example_connections" (addLabel "login" "failure" mempty)+ connectCounter <- registerCounter "example_connection_total" mempty+ latencyHistogram <- registerHistogram "example_round_trip_latency_ms" mempty [10, 20..100] - inc connectCounter -- increment a counter+ liftIO $ inc connectCounter -- increment a counter -- [...] pass metric handles to the rest of the app - serveHttpTextMetrics 8080 globalRegistry -- http://localhost:8080/metric server+ serveHttpTextMetricsT 8080 ["metrics"] -- http://localhost:8080/metric server
README.md view
@@ -15,27 +15,25 @@ module Example where -import System.Metrics.Prometheus.GlobalRegistry-import System.Metrics.Prometheus.Http-import System.Metrics.Prometheus.Metric.Counter (inc)+import Control.Monad.IO.Class (liftIO)+import System.Metrics.Prometheus.Concurrent.Http (serveHttpTextMetricsT)+import System.Metrics.Prometheus.Concurrent.RegistryT+import System.Metrics.Prometheus.Metric.Counter (inc) import System.Metrics.Prometheus.MetricId - main :: IO ()-main = do- globalRegistry <- new-+main = runRegistryT $ do -- 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+ connectSuccessGauge <- registerGauge "example_connections" (fromList [("login", "success")])+ connectFailureGauge <- registerGauge "example_connections" (addLabel "login" "failure" mempty)+ connectCounter <- registerCounter "example_connection_total" mempty+ latencyHistogram <- registerHistogram "example_round_trip_latency_ms" mempty [10, 20..100] - inc connectCounter -- increment a counter+ liftIO $ inc connectCounter -- increment a counter -- [...] pass metric handles to the rest of the app - serveHttpTextMetrics 8080 globalRegistry -- http://localhost:8080/metric server+ serveHttpTextMetricsT 8080 ["metrics"] -- http://localhost:8080/metric server ``` ## Advanced Usage
prometheus.cabal view
@@ -1,5 +1,5 @@ name: prometheus-version: 0.2.0+version: 0.3.0 synopsis: Prometheus Haskell Client homepage: http://github.com/LukeHoersten/prometheus#readme bug-reports: http://github.com/LukeHoersten/prometheus/issues@@ -24,27 +24,25 @@ . > module Example where >- > import System.Metrics.Prometheus.GlobalRegistry- > import System.Metrics.Prometheus.Http- > import System.Metrics.Prometheus.Metric.Counter (inc)+ > import Control.Monad.IO.Class (liftIO)+ > import System.Metrics.Prometheus.Concurrent.Http (serveHttpTextMetricsT)+ > import System.Metrics.Prometheus.Concurrent.RegistryT+ > import System.Metrics.Prometheus.Metric.Counter (inc) > import System.Metrics.Prometheus.MetricId >- > > main :: IO ()- > main = do- > globalRegistry <- new- >+ > main = runRegistryT $ do > -- 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+ > connectSuccessGauge <- registerGauge "example_connections" (fromList [("login", "success")])+ > connectFailureGauge <- registerGauge "example_connections" (addLabel "login" "failure" mempty)+ > connectCounter <- registerCounter "example_connection_total" mempty+ > latencyHistogram <- registerHistogram "example_round_trip_latency_ms" mempty [10, 20..100] >- > inc connectCounter -- increment a counter+ > liftIO $ inc connectCounter -- increment a counter > > -- [...] pass metric handles to the rest of the app >- > serveHttpTextMetrics 8080 globalRegistry -- http://localhost:8080/metric server+ > serveHttpTextMetricsT 8080 ["metrics"] -- http://localhost:8080/metric server > . [Advanced Usage]@@ -60,11 +58,12 @@ hs-source-dirs: src default-language: Haskell2010 - exposed-modules: System.Metrics.Prometheus.Encode+ exposed-modules: System.Metrics.Prometheus.Concurrent.Http+ , System.Metrics.Prometheus.Concurrent.Registry+ , System.Metrics.Prometheus.Concurrent.RegistryT+ , System.Metrics.Prometheus.Encode , System.Metrics.Prometheus.Encode.Histogram , System.Metrics.Prometheus.Encode.MetricId- , System.Metrics.Prometheus.GlobalRegistry- , System.Metrics.Prometheus.Http , System.Metrics.Prometheus.Metric , System.Metrics.Prometheus.Metric.Counter , System.Metrics.Prometheus.Metric.Gauge
+ src/System/Metrics/Prometheus/Concurrent/Http.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}++module System.Metrics.Prometheus.Concurrent.Http where++import Control.Monad.IO.Class (liftIO)+import Control.Monad.Reader.Class (ask)+import Data.Text (Text)+import Network.HTTP.Types (hContentType,+ methodGet,+ status200,+ status404)+import Network.Wai (Application,+ Response,+ pathInfo,+ requestMethod,+ responseBuilder,+ responseLBS)+import Network.Wai.Handler.Warp (Port, run)++import System.Metrics.Prometheus.Concurrent.Registry (Registry,+ sample)+import System.Metrics.Prometheus.Concurrent.RegistryT (RegistryT)+import System.Metrics.Prometheus.Encode (encodeMetrics)+++type Path = [Text]+++serveHttpTextMetricsDef :: Port -> Registry -> IO ()+serveHttpTextMetricsDef = flip serveHttpTextMetrics ["metrics"]+++serveHttpTextMetrics :: Port -> Path -> Registry -> IO ()+serveHttpTextMetrics port path = run port . prometheusApp path+++serveHttpTextMetricsT :: Port -> Path -> RegistryT IO ()+serveHttpTextMetricsT port path = liftIO . serveHttpTextMetrics port path =<< ask+++prometheusApp :: Path -> Registry -> Application+prometheusApp path registry request respond+ | prometheusRequest = prometheusResponse respond registry+ | otherwise = respond $ responseLBS status404 header404 body404+ where+ prometheusRequest = requestMethod request == methodGet && pathInfo request == path+ header404 = [(hContentType, "text/plain")]+ body404 = "404"+++prometheusResponse :: (Response -> IO b) -> Registry -> IO b+prometheusResponse respond gr =+ respond . responseBuilder status200 headers . encodeMetrics =<< sample gr+ where+ headers = [(hContentType, "text/plain; version=0.0.4")]
+ src/System/Metrics/Prometheus/Concurrent/Registry.hs view
@@ -0,0 +1,50 @@+module System.Metrics.Prometheus.Concurrent.Registry+ ( Registry+ , new+ , registerCounter+ , registerGauge+ , registerHistogram+ , sample+ ) where+++import Control.Concurrent.MVar (MVar,+ modifyMVarMasked,+ newMVar, withMVar)+import Data.Tuple (swap)++import System.Metrics.Prometheus.Metric.Counter (Counter)+import System.Metrics.Prometheus.Metric.Gauge (Gauge)+import System.Metrics.Prometheus.Metric.Histogram (Histogram,+ UpperBound)+import System.Metrics.Prometheus.MetricId (Labels, Name)+import qualified System.Metrics.Prometheus.Registry as R+++newtype Registry = Registry { unRegistry :: MVar R.Registry }+++new :: IO Registry+new = Registry <$> newMVar R.new+++registerCounter :: Name -> Labels -> Registry -> IO Counter+registerCounter name labels = flip modifyMVarMasked register . unRegistry+ where+ register = fmap swap . R.registerCounter name labels+++registerGauge :: Name -> Labels -> Registry -> IO Gauge+registerGauge name labels = flip modifyMVarMasked register . unRegistry+ where+ register = fmap swap . R.registerGauge name labels+++registerHistogram :: Name -> Labels -> [UpperBound] -> Registry -> IO Histogram+registerHistogram name labels buckets = flip modifyMVarMasked register . unRegistry+ where+ register = fmap swap . R.registerHistogram name labels buckets+++sample :: Registry -> IO R.RegistrySample+sample = flip withMVar R.sample . unRegistry
+ src/System/Metrics/Prometheus/Concurrent/RegistryT.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module System.Metrics.Prometheus.Concurrent.RegistryT where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader.Class (MonadReader,+ ask)+import Control.Monad.Trans.Class (MonadTrans)+import Control.Monad.Trans.Reader (ReaderT (..))++import System.Metrics.Prometheus.Concurrent.Registry (Registry, new)+import qualified System.Metrics.Prometheus.Concurrent.Registry as R+import System.Metrics.Prometheus.Metric.Counter (Counter)+import System.Metrics.Prometheus.Metric.Gauge (Gauge)+import System.Metrics.Prometheus.Metric.Histogram (Histogram)+import qualified System.Metrics.Prometheus.Metric.Histogram as Histogram+import System.Metrics.Prometheus.MetricId (Labels, Name)+import System.Metrics.Prometheus.Registry (RegistrySample)+++newtype RegistryT m a =+ RegistryT { unRegistryT :: ReaderT Registry m a }+ deriving ( Monad, MonadTrans, Applicative, Functor+ , MonadReader Registry, MonadIO)+++runRegistryT :: MonadIO m => RegistryT m a -> m a+runRegistryT registry = liftIO new >>= runReaderT (unRegistryT registry)+++registerCounter :: MonadIO m => Name -> Labels -> RegistryT m Counter+registerCounter n l = ask >>= liftIO . R.registerCounter n l+++registerGauge :: MonadIO m => Name -> Labels -> RegistryT m Gauge+registerGauge n l = ask >>= liftIO . R.registerGauge n l+++registerHistogram :: MonadIO m => Name -> Labels -> [Histogram.UpperBound] -> RegistryT m Histogram+registerHistogram n l b = ask >>= liftIO . R.registerHistogram n l b+++sample :: MonadIO m => RegistryT m RegistrySample+sample = ask >>= liftIO . R.sample
− src/System/Metrics/Prometheus/GlobalRegistry.hs
@@ -1,52 +0,0 @@-module System.Metrics.Prometheus.GlobalRegistry- ( GlobalRegistry- , new- , registerCounter- , registerGauge- , registerHistogram- , sample- ) where---import Control.Concurrent.MVar (MVar,- modifyMVarMasked,- newMVar, withMVar)-import Data.Tuple (swap)--import System.Metrics.Prometheus.Metric.Counter (Counter)-import System.Metrics.Prometheus.Metric.Gauge (Gauge)-import System.Metrics.Prometheus.Metric.Histogram (Histogram,- UpperBound)-import System.Metrics.Prometheus.MetricId (Labels, Name)-import System.Metrics.Prometheus.Registry (Registry (..),- RegistrySample)-import qualified System.Metrics.Prometheus.Registry as R---newtype GlobalRegistry = GlobalRegistry { unGlobalRegistry :: MVar Registry }---new :: IO GlobalRegistry-new = GlobalRegistry <$> newMVar R.new---registerCounter :: Name -> Labels -> GlobalRegistry -> IO Counter-registerCounter name labels = flip modifyMVarMasked register . unGlobalRegistry- where- register = fmap swap . R.registerCounter name labels---registerGauge :: Name -> Labels -> GlobalRegistry -> IO Gauge-registerGauge name labels = flip modifyMVarMasked register . unGlobalRegistry- where- register = fmap swap . R.registerGauge name labels---registerHistogram :: Name -> Labels -> [UpperBound] -> GlobalRegistry -> IO Histogram-registerHistogram name labels buckets = flip modifyMVarMasked register . unGlobalRegistry- where- register = fmap swap . R.registerHistogram name labels buckets---sample :: GlobalRegistry -> IO RegistrySample-sample = flip withMVar R.sample . unGlobalRegistry
− src/System/Metrics/Prometheus/Http.hs
@@ -1,46 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module System.Metrics.Prometheus.Http where--import Data.Text (Text)-import Network.HTTP.Types (hContentType,- methodGet, status200,- status404)-import Network.Wai (Application,- Response, pathInfo,- requestMethod,- responseBuilder,- responseLBS)-import Network.Wai.Handler.Warp (Port, run)--import System.Metrics.Prometheus.Encode (encodeMetrics)-import System.Metrics.Prometheus.GlobalRegistry (GlobalRegistry,- sample)---type Path = [Text]---serveHttpTextMetricsDef :: Port -> GlobalRegistry -> IO ()-serveHttpTextMetricsDef = serveHttpTextMetrics ["metrics"]---serveHttpTextMetrics :: Path -> Port -> GlobalRegistry -> IO ()-serveHttpTextMetrics path port = run port . prometheusApp path---prometheusApp :: Path -> GlobalRegistry -> Application-prometheusApp path globalRegistry request respond- | prometheusRequest = prometheusResponse respond globalRegistry- | otherwise = respond $ responseLBS status404 header404 body404- where- prometheusRequest = requestMethod request == methodGet && pathInfo request == path- header404 = [(hContentType, "text/plain")]- body404 = "404"---prometheusResponse :: (Response -> IO b) -> GlobalRegistry -> IO b-prometheusResponse respond gr =- respond . responseBuilder status200 headers . encodeMetrics =<< sample gr- where- headers = [(hContentType, "text/plain; version=0.0.4")]