prometheus (empty) → 0.1.0.0
raw patch · 12 files changed
+356/−0 lines, 12 filesdep +atomic-primopsdep +basedep +bytestringsetup-changed
Dependencies added: atomic-primops, base, bytestring, containers, text
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- prometheus.cabal +38/−0
- src/System/Metrics/Prometheus/Counter.hs +24/−0
- src/System/Metrics/Prometheus/Encode.hs +113/−0
- src/System/Metrics/Prometheus/Gauge.hs +35/−0
- src/System/Metrics/Prometheus/Histogram.hs +1/−0
- src/System/Metrics/Prometheus/Metric.hs +12/−0
- src/System/Metrics/Prometheus/MetricId.hs +11/−0
- src/System/Metrics/Prometheus/Registry.hs +29/−0
- src/System/Metrics/Prometheus/Sample.hs +60/−0
- src/System/Metrics/Prometheus/Summary.hs +1/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Luke Hoersten (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Luke Hoersten nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ prometheus.cabal view
@@ -0,0 +1,38 @@+name: prometheus+version: 0.1.0.0+synopsis: Prometheus Haskell Client+description: Idiomatic Haskell client for Prometheus.io monitoring.+homepage: http://github.com/LukeHoersten/prometheus#readme+license: BSD3+license-file: LICENSE+author: Luke Hoersten+maintainer: luke@hoersten.org+copyright: All Rights Reserved+category: Web+build-type: Simple+cabal-version: >=1.10++library+ hs-source-dirs: src+ default-language: Haskell2010++ exposed-modules: System.Metrics.Prometheus.Counter+ , System.Metrics.Prometheus.Encode+ , System.Metrics.Prometheus.Gauge+ , System.Metrics.Prometheus.Histogram+ , System.Metrics.Prometheus.Metric+ , System.Metrics.Prometheus.MetricId+ , System.Metrics.Prometheus.Registry+ , System.Metrics.Prometheus.Sample+ , System.Metrics.Prometheus.Summary++ build-depends: atomic-primops >= 0.8 && < 0.9+ , base >= 4.7 && < 5.0+ , bytestring >= 0.10 && < 0.11+ , containers >= 0.5 && < 0.6+ , text >= 1.2 && < 1.3+++source-repository head+ type: git+ location: https://github.com/LukeHoersten/prometheus
+ src/System/Metrics/Prometheus/Counter.hs view
@@ -0,0 +1,24 @@+module System.Metrics.Prometheus.Counter where+++import Data.Atomics.Counter (AtomicCounter, incrCounter_, newCounter,+ readCounter)+++newtype Counter = Counter { unCounter :: AtomicCounter }+++new :: IO Counter+new = Counter <$> newCounter 0+++add :: Int -> Counter -> IO ()+add by = incrCounter_ by . unCounter+++inc :: Counter -> IO ()+inc = add 1+++view :: Counter -> IO Int+view = readCounter . unCounter
+ src/System/Metrics/Prometheus/Encode.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings #-}++module System.Metrics.Prometheus.Encode+ ( encodeMetrics+ , serializeMetrics+ ) where++import Data.ByteString.Builder (Builder, byteString, char8,+ doubleDec, intDec,+ toLazyByteString)+import Data.ByteString.Lazy (ByteString)+import Data.List (intersperse)+import qualified Data.Map as Map+import Data.Monoid ((<>))+import Data.Text (Text, replace)+import Data.Text.Encoding (encodeUtf8)++import System.Metrics.Prometheus.MetricId (MetricId (..))+import System.Metrics.Prometheus.Sample (CounterSample (..),+ GaugeSample (..),+ MetricSample (..),+ RegistrySample (..),+ metricSample)+++serializeMetrics :: RegistrySample -> ByteString+serializeMetrics = toLazyByteString . encodeMetrics+++encodeMetrics :: RegistrySample -> Builder+encodeMetrics = mconcat . intersperse "\n\n" .+ map (uncurry encodeMetric) . Map.toList . unRegistrySample+++encodeMetric :: MetricId -> MetricSample -> Builder+encodeMetric mid sample+ = encodeHeader mid sample <> newline+ <> metricSample (encodeCounter mid) (encodeGauge mid) encodeHistogram encodeSummary sample+++encodeHeader :: MetricId -> MetricSample -> Builder+encodeHeader mid sample+ = "# HELP " <> encodeName mid <> space <> "help" <> newline+ <> "# TYPE " <> encodeName mid <> space <> encodeSampleType sample+++-- escape :: Text -> Text+-- escape = replace "\\" "\\\" . replace "\"" ("\\" <> "\"")+++encodeHistogram = undefined+encodeSummary = undefined+++encodeCounter :: MetricId -> CounterSample -> Builder+encodeCounter mid counter = encodeMetricId mid <> space <> intDec (unCounterSample counter)+++encodeGauge :: MetricId -> GaugeSample -> Builder+encodeGauge mid gauge = encodeMetricId mid <> space <> doubleDec (unGaugeSample gauge)+++encodeSampleType :: MetricSample -> Builder+encodeSampleType = byteString . metricSample (const "counter")+ (const "gauge") (const "histogram") (const "summary")+++encodeMetricId :: MetricId -> Builder+encodeMetricId mid = encodeName mid <> encodeLabels mid+++encodeName :: MetricId -> Builder+encodeName = text . name+++encodeLabels :: MetricId -> Builder+encodeLabels mid | Map.null (labels mid) = space+ | otherwise =+ openBracket+ <> (mconcat . intersperse comma . map encodeLabel . Map.toList $ labels mid)+ <> closeBracket+++encodeLabel :: (Text, Text) -> Builder+encodeLabel (key, value) = text key <> equals <> text value+++text :: Text -> Builder+text = byteString . encodeUtf8+++space :: Builder+space = char8 ' '+++newline :: Builder+newline = char8 '\n'+++openBracket :: Builder+openBracket = char8 '{'+++closeBracket :: Builder+closeBracket = char8 '}'+++comma :: Builder+comma = char8 ','+++equals :: Builder+equals = char8 '='
+ src/System/Metrics/Prometheus/Gauge.hs view
@@ -0,0 +1,35 @@+module System.Metrics.Prometheus.Gauge where++import Data.IORef (IORef, atomicModifyIORef', atomicWriteIORef,+ newIORef, readIORef)+++newtype Gauge = Gauge { unGauge :: IORef Double }+++new :: IO Gauge+new = Gauge <$> newIORef 0++add :: Double -> Gauge -> IO ()+add x = flip atomicModifyIORef' f . unGauge+ where f v = (v + x, ())+++sub :: Double -> Gauge -> IO ()+sub x = flip atomicModifyIORef' f . unGauge+ where f v = (v - x, ())++inc :: Gauge -> IO ()+inc = add 1+++dec :: Gauge -> IO ()+dec = sub 1+++set :: Double -> Gauge -> IO ()+set x = flip atomicWriteIORef x . unGauge+++get :: Gauge -> IO Double+get = readIORef . unGauge
+ src/System/Metrics/Prometheus/Histogram.hs view
@@ -0,0 +1,1 @@+module System.Metrics.Prometheus.Histogram where
+ src/System/Metrics/Prometheus/Metric.hs view
@@ -0,0 +1,12 @@+module System.Metrics.Prometheus.Metric where++import qualified System.Metrics.Prometheus.Counter as C+import qualified System.Metrics.Prometheus.Gauge as G+-- import qualified System.Metrics.Prometheus.Histogram as H+-- import qualified System.Metrics.Prometheus.Summary as S++data Metric+ = Counter C.Counter+ | Gauge G.Gauge+ -- | Summary S.Summary+ -- | Histogram H.Histogram
+ src/System/Metrics/Prometheus/MetricId.hs view
@@ -0,0 +1,11 @@+module System.Metrics.Prometheus.MetricId where++import Data.Map (Map)+import Data.Text (Text)+++data MetricId =+ MetricId+ { name :: Text+ , labels :: Map Text Text+ } deriving (Eq, Ord)
+ src/System/Metrics/Prometheus/Registry.hs view
@@ -0,0 +1,29 @@+module System.Metrics.Prometheus.Registry where++import Data.Map (Map)+import qualified Data.Map as Map++import System.Metrics.Prometheus.Counter (Counter)+import qualified System.Metrics.Prometheus.Counter as Counter+import System.Metrics.Prometheus.Gauge (Gauge)+import qualified System.Metrics.Prometheus.Gauge as Gauge+import System.Metrics.Prometheus.Metric (Metric)+import qualified System.Metrics.Prometheus.Metric as Metric+import System.Metrics.Prometheus.MetricId (MetricId)+++newtype Registry = Registry { unRegistry :: Map MetricId Metric }+++registerCounter :: MetricId -> Registry -> IO (Counter, Registry)+registerCounter mid registry = do+ counter <- Counter.new+ return (counter, Registry $ Map.insertWithKey collision mid (Metric.Counter counter) (unRegistry registry))+ where collision k n o = error "oh shit"+++registerGauge :: MetricId -> Registry -> IO (Gauge, Registry)+registerGauge mid registry = do+ gauge <- Gauge.new+ return (gauge, Registry $ Map.insertWithKey collision mid (Metric.Gauge gauge) (unRegistry registry))+ where collision k n o = error "oh shit"
+ src/System/Metrics/Prometheus/Sample.hs view
@@ -0,0 +1,60 @@+module System.Metrics.Prometheus.Sample where+++import Data.Map (Map)++import qualified System.Metrics.Prometheus.Counter as Counter+import qualified System.Metrics.Prometheus.Gauge as Gauge+import System.Metrics.Prometheus.Metric (Metric)+import qualified System.Metrics.Prometheus.Metric as Metric+import System.Metrics.Prometheus.MetricId (MetricId)+import System.Metrics.Prometheus.Registry (Registry, unRegistry)+++newtype CounterSample = CounterSample { unCounterSample :: Int }++newtype GaugeSample = GaugeSample { unGaugeSample :: Double }+++data HistogramSample =+ HistogramSample+ { histBuckets :: Map Double Int+ , histSum :: Int+ , histCount :: Int+ }+++data SummarySample =+ SummarySample+ { sumQuantiles :: Map Double Int+ , sumSum :: Int+ , sumCount :: Int+ }+++data MetricSample+ = Counter CounterSample+ | Gauge GaugeSample+ | Histogram HistogramSample+ | Summary SummarySample+++metricSample :: (CounterSample -> a) -> (GaugeSample -> a)+ -> (HistogramSample -> a) -> (SummarySample -> a)+ -> MetricSample -> a+metricSample f _ _ _ (Counter s) = f s+metricSample _ f _ _ (Gauge s) = f s+metricSample _ _ f _ (Histogram s) = f s+metricSample _ _ _ f (Summary s) = f s+++newtype RegistrySample = RegistrySample { unRegistrySample :: Map MetricId MetricSample }+++sample :: Registry -> IO RegistrySample+sample = fmap RegistrySample . mapM sampleMetric . unRegistry+++sampleMetric :: Metric -> IO MetricSample+sampleMetric (Metric.Counter count) = Counter . CounterSample <$> Counter.view count+sampleMetric (Metric.Gauge gauge) = Gauge . GaugeSample <$> Gauge.get gauge
+ src/System/Metrics/Prometheus/Summary.hs view
@@ -0,0 +1,1 @@+module System.Metrics.Prometheus.Summary where