MetricId.hs

{-# LANGUAGE OverloadedStrings #-}

module System.Metrics.Prometheus.Encode.Text.MetricId (
    encodeHeader,
    encodeMetricId,
    encodeLabels,
    encodeName,
    textValue,
    encodeDouble,
    encodeInt,
    escape,
    newline,
    space,
) where

import Data.ByteString.Builder (
    Builder,
    byteString,
    char8,
    intDec,
 )
import Data.List (intersperse)
import Data.Monoid ((<>))
import Data.Text (Text, replace)
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Text.Lazy.Builder.RealFloat (
    FPFormat (Generic),
    formatRealFloat,
 )
import Prelude hiding (null)

import System.Metrics.Prometheus.Metric (
    MetricSample (..),
    metricSample,
 )
import System.Metrics.Prometheus.MetricId (
    Labels (..),
    MetricId (..),
    Name (..),
    null,
    toList,
 )


encodeHeader :: MetricId -> MetricSample -> Builder
encodeHeader mid sample =
    "# TYPE " <> nm <> space <> encodeSampleType sample
  where
    -- <> "# HELP " <> nm <> space <> escape "help" <> newline <>
    nm = encodeName (name mid)


encodeSampleType :: MetricSample -> Builder
encodeSampleType =
    byteString
        . metricSample
            (const "counter")
            (const "gauge")
            (const "histogram")
            (const "summary")


encodeMetricId :: MetricId -> Builder
encodeMetricId mid = encodeName (name mid) <> encodeLabels (labels mid)


encodeName :: Name -> Builder
encodeName = text . unName


encodeLabels :: Labels -> Builder
encodeLabels ls
    | null ls = space
    | otherwise =
        openBracket
            <> (mconcat . intersperse comma . map encodeLabel $ toList ls)
            <> closeBracket


encodeLabel :: (Text, Text) -> Builder
encodeLabel (key, val) = text key <> equals <> quote <> text (escape val) <> quote


textValue :: RealFloat f => f -> Text
textValue x
    | isInfinite x && x > 0 = "+Inf"
    | isInfinite x && x < 0 = "-Inf"
    | isNaN x = "NaN"
    | otherwise = toStrict . toLazyText $ formatRealFloat Generic Nothing x


encodeDouble :: RealFloat f => f -> Builder
encodeDouble = text . textValue


encodeInt :: Int -> Builder
encodeInt = intDec


text :: Text -> Builder
text = byteString . encodeUtf8


escape :: Text -> Text
escape = replace "\n" "\\n" . replace "\"" "\\\"" . replace "\\" "\\\\"


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


quote :: Builder
quote = char8 '"'