{-# 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 " forall a. Semigroup a => a -> a -> a
<> Builder
nm forall a. Semigroup a => a -> a -> a
<> Builder
space 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
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(CounterSample -> a)
-> (GaugeSample -> a)
-> (HistogramSample -> a)
-> (SummarySample -> a)
-> MetricSample
-> a
metricSample
            (forall a b. a -> b -> a
const ByteString
"counter")
            (forall a b. a -> b -> a
const ByteString
"gauge")
            (forall a b. a -> b -> a
const ByteString
"histogram")
            (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) 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 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
            forall a. Semigroup a => a -> a -> a
<> (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Builder
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Builder
encodeLabel forall a b. (a -> b) -> a -> b
$ Labels -> [(Text, Text)]
toList Labels
ls)
            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 forall a. Semigroup a => a -> a -> a
<> Builder
equals forall a. Semigroup a => a -> a -> a
<> Builder
quote forall a. Semigroup a => a -> a -> a
<> Text -> Builder
text (Text -> Text
escape Text
val) forall a. Semigroup a => a -> a -> a
<> Builder
quote


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


encodeDouble :: RealFloat f => f -> Builder
encodeDouble :: forall f. RealFloat f => f -> Builder
encodeDouble = Text -> Builder
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8


escape :: Text -> Text
escape :: Text -> Text
escape = Text -> Text -> Text -> Text
replace Text
"\n" Text
"\\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replace Text
"\"" Text
"\\\"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
'"'