data-prometheus (empty) → 0.1.0.0
raw patch · 14 files changed
+1077/−0 lines, 14 filesdep +attoparsecdep +basedep +bytestring
Dependencies added: attoparsec, base, bytestring, containers, data-prometheus, hspec, lens, mtl, raw-strings-qq, text, transformers, wreq
Files
- LICENSE +30/−0
- README.md +63/−0
- app/Main.hs +14/−0
- data-prometheus.cabal +72/−0
- src/Data/Prometheus.hs +95/−0
- src/Data/Prometheus/Monad.hs +209/−0
- src/Data/Prometheus/Parse.hs +117/−0
- src/Data/Prometheus/Pretty.hs +142/−0
- src/Data/Prometheus/Types.hs +28/−0
- test/MonadSpec.hs +57/−0
- test/ParseSpec.hs +205/−0
- test/PrettySpec.hs +29/−0
- test/Spec.hs +1/−0
- test/SpecHelper.hs +15/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Sorki (c) 2024++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 Author name here 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.
+ README.md view
@@ -0,0 +1,63 @@+# data-prometheus++Pure Prometheus metrics parser and builder.++## Usage++### Parsing metrics++```haskell+import qualified Data.Prometheus+import qualified Network.Wreq+import qualified Data.ByteString.Lazy++main :: IO ()+main = do+ r <- Network.Wreq.get "http://localhost:9100/metrics"+ case Data.Prometheus.parseProm+ (Data.ByteString.Lazy.toStrict $ r ^. responseBody)+ of+ Right result -> print result+ Left err -> putStrLn err+```++### Generating metrics++In monadic manner++```haskell+{-# LANGUAGE OverloadedStrings #-}+import Data.Prometheus+import qualified Data.Text.IO++main :: IO ()+main = do+ Data.Text.IO.putStrLn+ $ runMetrics (metric "readme")+ $ do+ addMetric+ "subMetric"+ (Counter 13)++ logError "something is not right"++ addMetric'+ ( sub "anotherSubMetric"+ . sub "gauge"+ . label "key" "val")+ (Gauge 13)+```++or alternatively define `ToMetrics` instances for your data types.++Above example will output:++```+# HELP readme_gauge_anotherSubMetric +# TYPE readme_gauge_anotherSubMetric gauge+readme_gauge_anotherSubMetric{key="val"} 13.0+# HELP readme_subMetric +# TYPE readme_subMetric counter+readme_subMetric 13.0+# ERROR something is not right+```
+ app/Main.hs view
@@ -0,0 +1,14 @@+module Main where++import Data.Prometheus++import Control.Lens+import Network.Wreq++import qualified Data.ByteString.Lazy as BL++main = do+ r <- get "http://localhost:9100/metrics"+ case parseProm (BL.toStrict $ r ^. responseBody) of+ Right result -> print result+ Left err -> putStrLn err
+ data-prometheus.cabal view
@@ -0,0 +1,72 @@+cabal-version: 2.2+name: data-prometheus+version: 0.1.0.0+synopsis: Prometheus metrics text format+description: Pure Prometheus metrics text data parser and builder+homepage: https://github.com/sorki/data-prometheus+license: BSD-3-Clause+license-file: LICENSE+author: Sorki+maintainer: srk@48.io+copyright: 2024 Sorki+category: Metrics+build-type: Simple+extra-source-files:+ README.md++library+ hs-source-dirs: src+ exposed-modules: Data.Prometheus+ , Data.Prometheus.Monad+ , Data.Prometheus.Parse+ , Data.Prometheus.Pretty+ , Data.Prometheus.Types+ build-depends: base >= 4.7 && < 5+ , attoparsec+ , containers+ , mtl+ , text+ , transformers+ ghc-options: -Wall+ default-language: Haskell2010++flag buildExecutable+ description: Build example executable+ default: False++executable data-prometheus-exe+ if flag(buildExecutable)+ buildable: True+ else+ buildable: False+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , attoparsec+ , bytestring+ , lens+ , wreq+ , data-prometheus+ default-language: Haskell2010+++test-suite data-prometheus-tests+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: ParseSpec+ PrettySpec+ MonadSpec+ SpecHelper+ build-depends: base >= 4.7 && < 5+ , data-prometheus+ , attoparsec+ , containers+ , raw-strings-qq+ , hspec+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/sorki/data-prometheus
+ src/Data/Prometheus.hs view
@@ -0,0 +1,95 @@+module Data.Prometheus+ ( parseProm+ , runMetrics+ , runMetricsT+ , filterMetrics+ , findMetrics+ , hasLabel+ , byLabel+ , byLabel'+ , module Data.Prometheus.Monad+ , module Data.Prometheus.Parse+ , module Data.Prometheus.Pretty+ , module Data.Prometheus.Types+ ) where++import Control.Monad.Identity (runIdentity)+import Data.Text (Text)+import Data.Map (Map)+import Data.Attoparsec.Text++import qualified Data.Text+import qualified Data.Map+import Data.Prometheus.Monad+import Data.Prometheus.Parse+import Data.Prometheus.Pretty+import Data.Prometheus.Types++-- | Parse Prometheus metrics from Text+parseProm+ :: Text+ -> Either String (Map MetricId Metric)+parseProm = parseOnly parseMetrics++-- | Evaluate metrics and return pretty-printed output+-- as expected by textfile collector+runMetricsT+ :: Monad m+ => MetricId+ -> MetricsT m+ -> m Text+runMetricsT rootMetric x = do+ ms <- execMetricsT rootMetric x+ pure+ $ mconcat+ [ prettyMetrics (metrics ms)+ , Data.Text.unlines (errors ms)+ ]++-- | Evaluate metrics and return pretty-printed output+-- as expected by textfile collector+runMetrics+ :: MetricId+ -> Metrics+ -> Text+runMetrics rootMetric =+ runIdentity+ . runMetricsT rootMetric++-- | Filter metrics where name is prefixed by `pattern`+filterMetrics :: Text -> Map MetricId a -> Map MetricId a+filterMetrics pattern =+ Data.Map.filterWithKey+ (\k _ -> pattern `Data.Text.isPrefixOf` (metricIdName k))++-- | Find metrics where name is equal to `pattern`+findMetrics :: Text -> Map MetricId a -> Map MetricId a+findMetrics pattern =+ Data.Map.filterWithKey (\k _ -> pattern == metricIdName k)++-- | Find metrics by `label`+hasLabel :: Text -> Map MetricId a -> Map MetricId a+hasLabel label' =+ Data.Map.filterWithKey (\k _ -> Data.Map.member label' (metricIdLabels k))++-- | Find metrics with `label` which matches `contents`+byLabel+ :: Text+ -> Text+ -> Map MetricId a+ -> Map MetricId a+byLabel label' contents = byLabel' label' (==contents)++-- | Find metrics with `label` which content satisfies `op` predicate+byLabel'+ :: Text+ -> (Text -> Bool)+ -> Map MetricId a+ -> Map MetricId a+byLabel' label' op =+ Data.Map.filterWithKey+ $ \k _ ->+ case Data.Map.lookup label' (metricIdLabels k) of+ Nothing -> False+ Just lc -> op lc+
+ src/Data/Prometheus/Monad.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE OverloadedStrings #-}+module Data.Prometheus.Monad+ ( MetricState(..)+ , Metrics+ , MetricsT+ , ToMetrics(..)+ , execMetricsT+ , addMetric'+ , addMetric+ , subMetrics+ , labeledMetrics+ , metric+ , sub+ , desc+ , label+ , mkGauge+ , mkCounter+ , eitherExitCode+ , eitherToGauge+ , boolToGauge+ , enumToGauge+ , floatToGauge+ , logError+ ) where++import Control.Monad.Identity (Identity)+import Control.Monad.Trans.State.Strict+import Data.Text (Text)+import Data.Map (Map)+import qualified Data.Map+import qualified Data.Text+import qualified GHC.Float++import Data.Prometheus.Types++data MetricState = MetricState+ { baseMetric :: MetricId+ , metrics :: Map MetricId Metric+ , errors :: [Text]+ }++type MetricsT m = StateT MetricState m ()++type Metrics = MetricsT Identity++class ToMetrics a where+ toMetrics+ :: Monad m+ => a+ -> MetricsT m++instance ToMetrics a => ToMetrics [a] where+ toMetrics xs =+ mapM_+ (\(k, v) ->+ labeledMetrics+ "id"+ (Data.Text.pack $ show k)+ $ toMetrics v+ )+ (zip [(0 :: Int)..] xs)++-- | Evaluate metrics into `MetricState`+execMetricsT+ :: Monad m+ => MetricId+ -> MetricsT m+ -> m MetricState+execMetricsT rootMetric =+ flip+ execStateT+ (MetricState rootMetric mempty mempty)++-- | Add metric with value+addMetric'+ :: Monad m+ => (MetricId -> MetricId) -- ^ Function to change the current @MetricId@+ -> Metric -- ^ @Metric@ to add+ -> MetricsT m+addMetric' f mData = do+ mId <- f <$> gets baseMetric+ modify $ \ms ->+ ms { metrics = Data.Map.insert mId mData (metrics ms) }++-- | Add metric with value+addMetric+ :: Monad m+ => Text -- ^ Suffix (sub metric to add)+ -> Metric -- ^ @Metric@ to add+ -> MetricsT m+addMetric subName = addMetric' (sub subName)++-- | Combinator to create sub-metrics+subMetrics+ :: Monad m+ => Text+ -> MetricsT m+ -> MetricsT m+subMetrics subName act = do+ old <- gets baseMetric+ modify $ \ms ->+ ms { baseMetric = sub subName $ baseMetric ms }+ act+ modify $ \ms ->+ ms { baseMetric = old }++-- | Combinator to create labeled metrics+labeledMetrics+ :: Monad m+ => Text -- ^ Label name+ -> Text -- ^ Label value+ -> MetricsT m+ -> MetricsT m+labeledMetrics labelName labelValue act = do+ old <- gets baseMetric+ modify $ \ms ->+ ms { baseMetric = label labelName labelValue $ baseMetric ms }+ act+ modify $ \ms ->+ ms { baseMetric = old }++-- | Create metric with just `name`+metric+ :: Text+ -> MetricId+metric mName = MetricId mName mempty mempty++-- | Append `subName` to the name of a @MetricId@+--+-- > metric "a" & sub "b"+-- results in name "a_b"+sub+ :: Text+ -> MetricId+ -> MetricId+sub subName m =+ m { metricIdName = metricIdName m <> "_" <> subName }++-- | Set help text / description of a @MetricId@+desc+ :: Text+ -> MetricId+ -> MetricId+desc h m =+ m { metricIdHelp = h }++-- | Add label to MetricId+label+ :: Text+ -> Text+ -> MetricId+ -> MetricId+label k v m =+ m { metricIdLabels = Data.Map.insert k v (metricIdLabels m) }++-- | Create @Gauge@ metric+mkGauge+ :: Double+ -> Metric+mkGauge = Gauge++-- | Create @Counter@ metric+mkCounter+ :: Double+ -> Metric+mkCounter = Counter++-- | Right is exitcode 0, Left non-zero+eitherExitCode :: Either a b -> Integer+eitherExitCode (Right _) = 0+eitherExitCode (Left _) = 1++-- | Convert Either to Gauge, 0 meaning Right+eitherToGauge :: Either a b -> Metric+eitherToGauge = mkGauge . fromIntegral . eitherExitCode++-- | Convert Bool to Gauge, 0 meaning False+boolToGauge :: Bool -> Metric+boolToGauge False = mkGauge 0+boolToGauge True = mkGauge 1++-- | Convert Enum to Gauge, 0 (typically) meaning Ok status+enumToGauge :: Enum a => a -> Metric+enumToGauge = mkGauge . fromIntegral . fromEnum++-- | Convert @Float@ to Gauge+floatToGauge+ :: Float+ -> Metric+floatToGauge = mkGauge . GHC.Float.float2Double++-- | Log error message+--+-- These are appended after all metrics were printed+--+-- Not a standard token but textfile collector ignores it as a comment+-- and we can use it to provide some insight to our scripts.+logError+ :: Monad m+ => Text+ -> StateT MetricState m ()+logError err =+ modify $ \ms -> ms { errors = (errors ms) ++ [errComment] }+ where+ errComment =+ Data.Text.unwords+ [ "# ERROR"+ , err+ ]
+ src/Data/Prometheus/Parse.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE OverloadedStrings #-}+module Data.Prometheus.Parse+ ( parseMetrics+ ) where++import Control.Applicative++import Prelude hiding (takeWhile)+import Data.Attoparsec.Text+import Data.Text (Text)+import Data.Map (Map)+import qualified Data.Map++import Data.Prometheus.Types++parseMetrics :: Parser (Map MetricId Metric)+parseMetrics = Data.Map.fromList . concat <$>+ many1 parseMetric <* many parseError <* endOfInput++parseMetric :: Parser [(MetricId, Metric)]+parseMetric = do+ (name, help, typ) <- parseMeta+ lm <- case typ of+ "counter" -> parseCounters+ "gauge" -> parseGauges+ "untyped" -> parseGauges -- untyped /o\+ "histogram" -> parseHistogram+ "summary" -> parseSummary+ x -> fail $ show x++ pure $ map (\(labels, metric) -> (MetricId name help labels, metric)) lm++-- name, help, textual type+parseMeta :: Parser (Text, Text, Text)+parseMeta = do+ _ <- "# HELP "+ name <- word+ _ <- space+ help <- eol+ endOfLine+ _ <- "# TYPE "+ _ <- word -- repeated name+ _ <- space+ typ <- word+ endOfLine+ pure (name, help, typ)+ where+ eol :: Parser Text+ eol = takeWhile (/= '\n')++ word :: Parser Text+ word = takeWhile1 (\x -> x /=' ' && x /= '\n')++parseGauges :: Parser [(Map Text Text, Metric)]+parseGauges = many1 (labelsValue (Gauge <$> double))++parseCounters :: Parser [(Map Text Text, Metric)]+parseCounters = many1 (labelsValue (Counter <$> double))++parseSummary :: Parser [(Map Text Text, Metric)]+parseSummary = do+ qs <- Data.Map.fromList <$> parseQuantiles `sepBy` endOfLine <?> "quantiles"+ (_, lsum) <- labelsValue double+ (_, lcnt) <- labelsValue double+ pure $ [(mempty, Summary qs lsum lcnt)]++parseQuantiles :: Parser (Double, Double)+parseQuantiles = do+ _ <- takeWhile1 (\x -> x /= '{' && x /= ' ')+ q <- "{quantile=\"" *> double <* "\"}"+ _ <- space+ val <- double+ pure (q, val)++parseHistogram :: Parser [(Map Text Text, Metric)]+parseHistogram = do+ qs <- Data.Map.fromList <$> parseHistBuckets `sepBy` endOfLine <?> "quantiles"+ (_, lsum) <- labelsValue double+ (_, lcnt) <- labelsValue double+ pure $ [(mempty, Histogram qs lsum lcnt)]++parseHistBuckets :: Parser (Double, Double)+parseHistBuckets = do+ _ <- takeWhile1 (\x -> x /= '{' && x /= ' ')+ q <- "{le=\"" *> double <* "\"}"+ _ <- space+ val <- double+ pure (q, val)++labelsValue :: Parser b -> Parser (Map Text Text, b)+labelsValue f = do+ _ <- takeWhile1 (\x -> x /= '{' && x /= ' ')+ ls <- option mempty (char '{' *> parseLabels <* char '}')+ _ <- space+ val <- f+ endOfLine+ pure (ls, val)++parseLabels :: Parser (Map Text Text)+parseLabels = Data.Map.fromList <$> parseLabel `sepBy1` (char ',')++parseLabel :: Parser (Text, Text)+parseLabel = do+ l <- takeWhile (/= '=')+ _ <- char '='+ v <- char '"' *> takeWhile (\x -> x /= '"') <* char '"'+ pure (l, v)++parseError :: Parser Text+parseError = do+ _ <- "# ERROR "+ err <- eol+ endOfLine+ pure err+ where+ eol :: Parser Text+ eol = takeWhile (/= '\n')
+ src/Data/Prometheus/Pretty.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module Data.Prometheus.Pretty+ ( prettyMetrics+ , prettyMetric+ , prettyMetricShort+ , prettyId+ ) where++import Data.Text (Text)+import Data.Map (Map)+import Data.String (IsString)+import qualified Data.Text+import qualified Data.Map++import Data.Prometheus.Types+import Data.Prometheus.Monad++prettyMetrics :: Map MetricId Metric -> Text+prettyMetrics =+ mconcat+ . Data.Map.elems+ . snd+ . Data.Map.mapAccumWithKey+ helpTypeOnce+ mempty+ where+ -- render help and metric type just once+ -- for consecutive metridId names+ -- (with only difference in labels)+ helpTypeOnce prevName mid@MetricId{..} x | prevName /= metricIdName =+ (metricIdName, prettyMetric mid x)+ helpTypeOnce _prevName mid@MetricId{..} x | otherwise =+ (metricIdName, prettyMetricShort mid x <> "\n")++prettyMetric :: MetricId -> Metric -> Text+prettyMetric mId mData =+ Data.Text.unlines+ [ prettyHelp mId+ , prettyType mId mData+ , prettyMetricShort mId mData+ ]++prettyMetricShort+ :: MetricId+ -> Metric+ -> Text+prettyMetricShort mId mData =+ case mData of+ Counter x -> simple mId x+ Gauge x -> simple mId x+ Summary{..} ->+ Data.Text.unlines+ $ [ simple+ (label+ "quantile"+ (Data.Text.pack $ show k)+ mId+ )+ v+ | (k, v) <- Data.Map.toList sumQuantiles+ ]+ +++ [ simple (sub "sum" mId) sumSum+ , simple (sub "count" mId) sumCount+ ]+ Histogram{..} ->+ Data.Text.unlines+ $ [ simple+ (label+ "le"+ (Data.Text.pack $ show k)+ (sub "bucket" mId)+ )+ v+ | (k, v) <- Data.Map.toList histBuckets+ ]+ +++ [ simple (sub "sum" mId) histSum+ , simple (sub "count" mId) histCount+ ]++ where+ simple i val =+ Data.Text.unwords+ [ prettyId i+ , Data.Text.pack $ show val+ ]++prettyHelp+ :: MetricId+ -> Text+prettyHelp MetricId{..} =+ Data.Text.unwords+ [ "# HELP"+ , metricIdName+ , metricIdHelp+ ]++prettyType+ :: MetricId+ -> Metric+ -> Text+prettyType mId x =+ Data.Text.unwords+ [ "# TYPE"+ , metricIdName mId+ , toTypeStr x+ ]++toTypeStr+ :: IsString p+ => Metric+ -> p+toTypeStr (Counter _) = "counter"+toTypeStr (Gauge _) = "gauge"+toTypeStr (Summary{}) = "summary"+toTypeStr (Histogram{}) = "histogram"++prettyId+ :: MetricId+ -> Text+prettyId MetricId{..} =+ mconcat+ [ metricIdName+ , prettyLabels metricIdLabels+ ]++prettyLabels+ :: Map Text Text+ -> Text+prettyLabels labels | Data.Map.null labels = mempty+prettyLabels labels | otherwise =+ mconcat+ [ "{"+ , Data.Text.intercalate ","+ $ Data.Map.elems+ $ Data.Map.mapWithKey+ (\k v -> mconcat [k, "=\"", v, "\""]) + labels+ , "}"+ ]
+ src/Data/Prometheus/Types.hs view
@@ -0,0 +1,28 @@+module Data.Prometheus.Types+ ( MetricId(..)+ , Metric(..)+ ) where++import Data.Text (Text)+import Data.Map (Map)++data MetricId = MetricId+ { metricIdName :: Text+ , metricIdHelp :: Text+ , metricIdLabels :: Map Text Text }+ deriving (Eq, Ord, Show)++data Metric+ = Counter Double+ | Gauge Double+ | Summary+ { sumQuantiles :: Map Double Double+ , sumSum :: Double+ , sumCount :: Double+ }+ | Histogram+ { histBuckets :: Map Double Double+ , histSum :: Double+ , histCount :: Double+ }+ deriving (Eq, Ord, Show)
+ test/MonadSpec.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}++module MonadSpec where++import SpecHelper+import Data.Function ((&))+import qualified Data.Map as M++complex :: MetricId -> MetricId+complex =+ sub "sub2"+ . sub "sub1"+ . desc "desc"+ . label "a" "b"++complexExpected :: MetricId+complexExpected = complex $ metric "test"++spec :: Spec+spec = do+ it "generates metrics" $ do+ runMetrics (metric "test") $ addMetric' id (mkCounter 7)+ `shouldBe`+ "# HELP test \n# TYPE test counter\ntest 7.0\n"++ it "generates complex metrics" $ do+ runMetrics (metric "test") $ addMetric' complex (mkCounter 7)+ `shouldBe`+ "# HELP test_sub1_sub2 desc\n# TYPE test_sub1_sub2 counter\ntest_sub1_sub2{a=\"b\"} 7.0\n"++ it "adds errors" $ do+ runMetrics (metric "test") $ addMetric' id (Counter 7) >> logError "fail"+ `shouldBe`+ "# HELP test \n# TYPE test counter\ntest 7.0\n# ERROR fail\n"++ it "roundtrips complex" $ do+ parseProm (runMetrics (metric "test") (addMetric' complex (Counter 7)))+ `shouldBe`+ Right (M.fromList [(complexExpected, Counter 7)])++ it "roundtrips complex handles errors" $ do+ parseProm (runMetrics (metric "test") (addMetric' complex (Counter 7) >> logError "nada"))+ `shouldBe`+ Right (M.fromList [(complexExpected, Counter 7)])++ it "roundtrips multiple complex" $ do+ parseProm+ (runMetrics (metric "test") $ do+ addMetric' complex (Counter 7)+ addMetric' (sub "xy" . complex) (Gauge 13.37)+ )+ `shouldBe`+ Right (M.fromList [(complexExpected, Counter 7), (complexExpected & sub "xy", Gauge 13.37)])++main :: IO ()+main = do+ hspec spec
+ test/ParseSpec.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}++module ParseSpec where++import SpecHelper+import Text.RawString.QQ+import Data.Either (isRight)+import qualified Data.Map++gauge = [r|# HELP go_memstats_alloc_bytes Number of bytes allocated and still in use.+# TYPE go_memstats_alloc_bytes gauge+go_memstats_alloc_bytes 1.276272e+06+|]++summary = [r|# HELP go_gc_duration_seconds A summary of the GC invocation durations.+# TYPE go_gc_duration_seconds summary+go_gc_duration_seconds{quantile="0"} 8.1545e-05+go_gc_duration_seconds{quantile="0.25"} 0.000103978+go_gc_duration_seconds{quantile="0.5"} 0.000118208+go_gc_duration_seconds{quantile="0.75"} 0.000140686+go_gc_duration_seconds{quantile="1"} 0.000302995+go_gc_duration_seconds_sum 0.006560726+go_gc_duration_seconds_count 51+|]++counter = [r|# HELP node_context_switches_total Total number of context switches.+# TYPE node_context_switches_total counter+node_context_switches_total 1.54296968e+08+|]++countersLabels = [r|# HELP node_cpu_core_throttles_total helptext+# TYPE node_cpu_core_throttles_total counter+node_cpu_core_throttles_total{core="0",package="0"} 0+node_cpu_core_throttles_total{core="1",package="0"} 0+|]++multiple = [r|# HELP node_arp_entries ARP entries by device+# TYPE node_arp_entries gauge+node_arp_entries{device="eth0"} 2+# HELP node_boot_time_seconds Node boot time, in unixtime.+# TYPE node_boot_time_seconds gauge+node_boot_time_seconds 1.537903224e+09+# HELP node_context_switches_total Total number of context switches.+# TYPE node_context_switches_total counter+node_context_switches_total 1.54296968e+08+|]++-- from https://prometheus.io/docs/instrumenting/exposition_formats/#text-format-example+ref = [r|+# HELP http_requests_total The total number of HTTP requests.+# TYPE http_requests_total counter+http_requests_total{method="post",code="200"} 1027 1395066363000+http_requests_total{method="post",code="400"} 3 1395066363000++# Escaping in label values:+msdos_file_access_time_seconds{path="C:\\DIR\\FILE.TXT",error="Cannot find file:\n\"FILE.TXT\""} 1.458255915e9++# Minimalistic line:+metric_without_timestamp_and_labels 12.47++# A weird metric from before the epoch:+something_weird{problem="division by zero"} +Inf -3982045++# A histogram, which has a pretty complex representation in the text format:+# HELP http_request_duration_seconds A histogram of the request duration.+# TYPE http_request_duration_seconds histogram+http_request_duration_seconds_bucket{le="0.05"} 24054+http_request_duration_seconds_bucket{le="0.1"} 33444+http_request_duration_seconds_bucket{le="0.2"} 100392+http_request_duration_seconds_bucket{le="0.5"} 129389+http_request_duration_seconds_bucket{le="1"} 133988+http_request_duration_seconds_bucket{le="+Inf"} 144320+http_request_duration_seconds_sum 53423+http_request_duration_seconds_count 144320++# Finally a summary, which has a complex representation, too:+# HELP rpc_duration_seconds A summary of the RPC duration in seconds.+# TYPE rpc_duration_seconds summary+rpc_duration_seconds{quantile="0.01"} 3102+rpc_duration_seconds{quantile="0.05"} 3272+rpc_duration_seconds{quantile="0.5"} 4773+rpc_duration_seconds{quantile="0.9"} 9001+rpc_duration_seconds{quantile="0.99"} 76656+rpc_duration_seconds_sum 1.7560473e+07+rpc_duration_seconds_count 2693+|]++testCases = [+ ("", Left "not enough input")+ , ( gauge+ , Right+ $ Data.Map.fromList+ [ ( MetricId+ { metricIdName = "go_memstats_alloc_bytes"+ , metricIdHelp = "Number of bytes allocated and still in use."+ , metricIdLabels = mempty+ }+ , Gauge 1276272.0+ )+ ]+ )++ , ( summary+ , Right+ $ Data.Map.fromList+ [ ( MetricId+ { metricIdName = "go_gc_duration_seconds"+ , metricIdHelp = "A summary of the GC invocation durations."+ , metricIdLabels = mempty+ }+ , Summary+ { sumQuantiles =+ Data.Map.fromList+ [ (0.0, 8.1545e-5)+ , (0.25, 1.03978e-4)+ , (0.5, 1.18208e-4)+ , (0.75, 1.40686e-4)+ , (1.0,3.02995e-4)+ ]+ , sumSum = 6.560726e-3+ , sumCount = 51.0+ }+ )+ ]+ )+ , ( counter+ , Right+ $ Data.Map.fromList+ [ ( MetricId+ { metricIdName = "node_context_switches_total"+ , metricIdHelp = "Total number of context switches."+ , metricIdLabels = mempty+ }+ , Counter 1.54296968e8+ )+ ]+ )+ , ( countersLabels+ , Right+ $ Data.Map.fromList+ [ ( MetricId+ { metricIdName = "node_cpu_core_throttles_total"+ , metricIdHelp = "helptext"+ , metricIdLabels =+ Data.Map.fromList+ [ ("core", "0")+ , ("package","0")+ ]+ }+ , Counter 0.0+ )+ , ( MetricId+ { metricIdName = "node_cpu_core_throttles_total"+ , metricIdHelp = "helptext"+ , metricIdLabels =+ Data.Map.fromList+ [ ("core", "1")+ , ("package", "0")+ ]+ }+ , Counter 0.0+ )+ ]+ )+ , ( multiple+ , Right+ $ Data.Map.fromList+ [ (MetricId+ { metricIdName = "node_arp_entries"+ , metricIdHelp = "ARP entries by device"+ , metricIdLabels = Data.Map.fromList [ ("device", "eth0")]+ }+ , Gauge 2.0+ )+ , ( MetricId+ { metricIdName = "node_boot_time_seconds"+ , metricIdHelp = "Node boot time, in unixtime."+ , metricIdLabels = mempty+ }+ , Gauge 1.537903224e9+ )+ , ( MetricId+ { metricIdName = "node_context_switches_total"+ , metricIdHelp = "Total number of context switches."+ , metricIdLabels = mempty+ }+ , Counter 1.54296968e8+ )+ ]+ )+ ]++spec :: Spec+spec = do+ it "parses samples" $ do+ mapM_ (\(x, y) -> parseProm x `shouldBe` y) testCases++ xit "parses reference"+ $ parseProm ref `shouldSatisfy` isRight++main :: IO ()+main = do+ hspec spec
+ test/PrettySpec.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++module PrettySpec where++import SpecHelper+import qualified Data.Map++sIdSimple = MetricId "name" "help" mempty+sIdLabels = MetricId "name" "help" (Data.Map.fromList [("a", "b")])+sC = Counter 666+sG = Gauge 123.456++spec :: Spec+spec = do+ it "pretty prints ID with labels" $ do+ prettyId sIdLabels `shouldBe` "name{a=\"b\"}"++ it "pretty prints simple ID" $ do+ prettyId sIdSimple `shouldBe` "name"++ it "pretty prints full metric with help and type" $ do+ prettyMetric sIdLabels sC `shouldBe` "# HELP name help\n# TYPE name counter\nname{a=\"b\"} 666.0\n"++ it "pretty prints metric" $ do+ prettyMetricShort sIdLabels sG `shouldBe` "name{a=\"b\"} 123.456"++main :: IO ()+main = do+ hspec spec
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/SpecHelper.hs view
@@ -0,0 +1,15 @@+module SpecHelper+ ( module Test.Hspec+ , module Data.Prometheus+ , module Data.Prometheus.Monad+ , module Data.Prometheus.Parse+ , module Data.Prometheus.Pretty+ , module Data.Prometheus.Types+ ) where++import Test.Hspec+import Data.Prometheus+import Data.Prometheus.Monad+import Data.Prometheus.Parse+import Data.Prometheus.Pretty+import Data.Prometheus.Types