{-# 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 :: MetricId -> MetricSample -> Builder
encodeHeader MetricId
mid MetricSample
sample =
    Builder
"# TYPE " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nm Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
space Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> MetricSample -> Builder
encodeSampleType MetricSample
sample
  where
    -- <> "# HELP " <> nm <> space <> escape "help" <> newline <>
    nm :: Builder
nm = Name -> Builder
encodeName (MetricId -> Name
name MetricId
mid)


encodeSampleType :: MetricSample -> Builder
encodeSampleType :: MetricSample -> Builder
encodeSampleType =
    ByteString -> Builder
byteString
        (ByteString -> Builder)
-> (MetricSample -> ByteString) -> MetricSample -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CounterSample -> ByteString)
-> (GaugeSample -> ByteString)
-> (HistogramSample -> ByteString)
-> (SummarySample -> ByteString)
-> MetricSample
-> ByteString
forall a.
(CounterSample -> a)
-> (GaugeSample -> a)
-> (HistogramSample -> a)
-> (SummarySample -> a)
-> MetricSample
-> a
metricSample
            (ByteString -> CounterSample -> ByteString
forall a b. a -> b -> a
const ByteString
"counter")
            (ByteString -> GaugeSample -> ByteString
forall a b. a -> b -> a
const ByteString
"gauge")
            (ByteString -> HistogramSample -> ByteString
forall a b. a -> b -> a
const ByteString
"histogram")
            (ByteString -> SummarySample -> ByteString
forall a b. a -> b -> a
const ByteString
"summary")


encodeMetricId :: MetricId -> Builder
encodeMetricId :: MetricId -> Builder
encodeMetricId MetricId
mid = Name -> Builder
encodeName (MetricId -> Name
name MetricId
mid) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Labels -> Builder
encodeLabels (MetricId -> Labels
labels MetricId
mid)


encodeName :: Name -> Builder
encodeName :: Name -> Builder
encodeName = Text -> Builder
text (Text -> Builder) -> (Name -> Text) -> Name -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
unName


encodeLabels :: Labels -> Builder
encodeLabels :: Labels -> Builder
encodeLabels Labels
ls
    | Labels -> Bool
null Labels
ls = Builder
space
    | Bool
otherwise =
        Builder
openBracket
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([(Text, Text)] -> [Builder]) -> [(Text, Text)] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
comma ([Builder] -> [Builder])
-> ([(Text, Text)] -> [Builder]) -> [(Text, Text)] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Builder) -> [(Text, Text)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Builder
encodeLabel ([(Text, Text)] -> Builder) -> [(Text, Text)] -> Builder
forall a b. (a -> b) -> a -> b
$ Labels -> [(Text, Text)]
toList Labels
ls)
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
closeBracket


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


textValue :: RealFloat f => f -> Text
textValue :: forall f. RealFloat f => f -> Text
textValue f
x
    | f -> Bool
forall a. RealFloat a => a -> Bool
isInfinite f
x Bool -> Bool -> Bool
&& f
x f -> f -> Bool
forall a. Ord a => a -> a -> Bool
> f
0 = Text
"+Inf"
    | f -> Bool
forall a. RealFloat a => a -> Bool
isInfinite f
x Bool -> Bool -> Bool
&& f
x f -> f -> Bool
forall a. Ord a => a -> a -> Bool
< f
0 = Text
"-Inf"
    | f -> Bool
forall a. RealFloat a => a -> Bool
isNaN f
x = Text
"NaN"
    | Bool
otherwise = Text -> Text
toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> f -> Builder
forall a. RealFloat a => FPFormat -> Maybe Int -> a -> Builder
formatRealFloat FPFormat
Generic Maybe Int
forall a. Maybe a
Nothing f
x


encodeDouble :: RealFloat f => f -> Builder
encodeDouble :: forall f. RealFloat f => f -> Builder
encodeDouble = Text -> Builder
text (Text -> Builder) -> (f -> Text) -> f -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f -> Text
forall f. RealFloat f => f -> Text
textValue


encodeInt :: Int -> Builder
encodeInt :: Int -> Builder
encodeInt = Int -> Builder
intDec


text :: Text -> Builder
text :: Text -> Builder
text = ByteString -> Builder
byteString (ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8


escape :: Text -> Text
escape :: Text -> Text
escape = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
replace Text
"\n" Text
"\\n" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
replace Text
"\"" Text
"\\\"" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
replace Text
"\\" Text
"\\\\"


space :: Builder
space :: Builder
space = Char -> Builder
char8 Char
' '


newline :: Builder
newline :: Builder
newline = Char -> Builder
char8 Char
'\n'


openBracket :: Builder
openBracket :: Builder
openBracket = Char -> Builder
char8 Char
'{'


closeBracket :: Builder
closeBracket :: Builder
closeBracket = Char -> Builder
char8 Char
'}'


comma :: Builder
comma :: Builder
comma = Char -> Builder
char8 Char
','


equals :: Builder
equals :: Builder
equals = Char -> Builder
char8 Char
'='


quote :: Builder
quote :: Builder
quote = Char -> Builder
char8 Char
'"'