packages feed

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 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