{-# 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
    -- <> "# HELP " <> nm <> space <> escape "help" <> newline <>
  where 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 '"'