{-# 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
    -- <> "# HELP " <> nm <> space <> escape "help" <> newline <>
  where 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 :: 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 :: 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 = 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
. Text -> Text -> Text -> Text
replace Text
"\"" Text
"\\\"" (Text -> Text) -> (Text -> Text) -> 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
'"'