{-# language OverloadedStrings #-}

module Prometheus.Export.Text (
    exportMetricsAsText
) where

import Prometheus.Info
import Prometheus.Metric
import Prometheus.Registry

import Control.Monad.IO.Class
import qualified Data.ByteString.Builder as Build
import qualified Data.ByteString.Lazy as BS
import Data.Foldable (foldMap)
import Data.Monoid ((<>), mempty, mconcat)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T


-- $setup
-- >>> :module +Prometheus
-- >>> :set -XOverloadedStrings
-- >>> unregisterAll

-- | Export all registered metrics in the Prometheus 0.0.4 text exposition
-- format.
--
-- For the full specification of the format, see the official Prometheus
-- <http://prometheus.io/docs/instrumenting/exposition_formats/ documentation>.
--
-- >>> :m +Data.ByteString
-- >>> myCounter <- register $ counter (Info "my_counter" "Example counter")
-- >>> incCounter myCounter
-- >>> exportMetricsAsText >>= Data.ByteString.Lazy.putStr
-- # HELP my_counter Example counter
-- # TYPE my_counter counter
-- my_counter 1.0
exportMetricsAsText :: MonadIO m => m BS.ByteString
exportMetricsAsText :: forall (m :: * -> *). MonadIO m => m ByteString
exportMetricsAsText = do
    [SampleGroup]
samples <- m [SampleGroup]
forall (m :: * -> *). MonadIO m => m [SampleGroup]
collectMetrics
    ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Build.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ (SampleGroup -> Builder) -> [SampleGroup] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SampleGroup -> Builder
exportSampleGroup [SampleGroup]
samples

exportSampleGroup :: SampleGroup -> Build.Builder
exportSampleGroup :: SampleGroup -> Builder
exportSampleGroup (SampleGroup Info
info SampleType
ty [Sample]
samples) =
    if [Sample] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Sample]
samples
        then Builder
forall a. Monoid a => a
mempty
        else Builder
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
exportedSamples
    where
        exportedSamples :: Builder
exportedSamples = [Sample] -> Builder
exportSamples [Sample]
samples
        name :: Text
name = Info -> Text
metricName Info
info
        help :: Text
help = Info -> Text
metricHelp Info
info
        prefix :: Builder
prefix = ByteString -> Builder
Build.byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [
                Text
"# HELP " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escape Text
help
            ,   Text
"# TYPE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (SampleType -> String
forall a. Show a => a -> String
show SampleType
ty)
            ]
        escape :: Char -> Text
escape Char
'\n' = Text
"\\n"
        escape Char
'\\' = Text
"\\\\"
        escape Char
other = String -> Text
T.pack [Char
other]

exportSamples :: [Sample] -> Build.Builder
exportSamples :: [Sample] -> Builder
exportSamples [Sample]
samples =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Sample -> Builder
exportSample Sample
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Build.charUtf8 Char
'\n' | Sample
s <- [Sample]
samples ]

exportSample :: Sample -> Build.Builder
exportSample :: Sample -> Builder
exportSample (Sample Text
name LabelPairs
labels ByteString
value) =
  ByteString -> Builder
Build.byteString (Text -> ByteString
T.encodeUtf8 Text
name)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (case LabelPairs
labels of
         [] -> Builder
forall a. Monoid a => a
mempty
         (Text, Text)
l:LabelPairs
ls ->
           Char -> Builder
Build.charUtf8 Char
'{'
             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text, Text) -> Builder
exportLabel (Text, Text)
l
             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Char -> Builder
Build.charUtf8 Char
',' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text, Text) -> Builder
exportLabel (Text, Text)
l' | (Text, Text)
l' <- LabelPairs
ls ]
             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Build.charUtf8 Char
'}')
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Build.charUtf8 Char
' '
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Build.byteString ByteString
value

exportLabel :: (Text, Text) -> Build.Builder
exportLabel :: (Text, Text) -> Builder
exportLabel (Text
key, Text
value) =
  ByteString -> Builder
Build.byteString (Text -> ByteString
T.encodeUtf8 Text
key)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Build.charUtf8 Char
'='
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
Build.stringUtf8 (Text -> String
forall a. Show a => a -> String
show Text
value)