content: {-# 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 '"'
  