{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

{- HLINT ignore "Use map" -}
{- HLINT ignore "Use map with tuple-section" -}

module Cardano.Logging.DocuGenerator (
  -- First call documentTracer for every tracer and then
  -- docuResultToText on all results
    documentTracer
  , documentTracer'
  , docuResultsToText
  , docuResultsToMetricsHelptext
  -- Callbacks
  , docTracer
  , docTracerDatapoint
  , docIt
  , addFiltered
  , addLimiter
  , addSilent
  , addDocumentedNamespace
  , DocuResult
  , DocTracer(..)
) where

import           Cardano.Logging.ConfigurationParser ()
import           Cardano.Logging.DocuGenerator.Tree
import           Cardano.Logging.DocuGenerator.Result (DocuResult (..))
import qualified Cardano.Logging.DocuGenerator.Result as DocuResult
import           Cardano.Logging.Types

import           Prelude hiding (lines, unlines)

import           Control.Monad (mfilter)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Control.Tracer as TR
import           Data.Aeson (ToJSON)
import qualified Data.Aeson.Encode.Pretty as AE
import           Data.IORef (modifyIORef, newIORef, readIORef)
import           Data.List (find, groupBy, intersperse, isPrefixOf, nub, sortBy)
import qualified Data.Map.Strict as Map
import           Data.Maybe (fromJust, fromMaybe, mapMaybe)
import           Data.Text (split)
import           Data.Text as T (Text, empty, intercalate, lines, pack, stripPrefix, toLower,
                   unlines)
import           Data.Text.Internal.Builder (toLazyText)
import           Data.Text.Lazy (toStrict)
import           Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton)

type InconsistencyWarning = Text

utf16CircledT :: Text
utf16CircledT :: Text
utf16CircledT = Text
"\x24E3"

utf16CircledS :: Text
utf16CircledS :: Text
utf16CircledS = Text
"\x24E2"

utf16CircledM :: Text
utf16CircledM :: Text
utf16CircledM = Text
"\x24DC"

-- | Convenience function for adding a namespace prefix to a documented
addDocumentedNamespace  :: [Text] -> Documented a -> Documented a
addDocumentedNamespace :: forall a. [Text] -> Documented a -> Documented a
addDocumentedNamespace  [Text]
out (Documented [DocMsg a]
list) =
  [DocMsg a] -> Documented a
forall a. [DocMsg a] -> Documented a
Documented ([DocMsg a] -> Documented a) -> [DocMsg a] -> Documented a
forall a b. (a -> b) -> a -> b
$ (DocMsg a -> DocMsg a) -> [DocMsg a] -> [DocMsg a]
forall a b. (a -> b) -> [a] -> [b]
map
    (\ dm :: DocMsg a
dm@DocMsg {} -> DocMsg a
dm {dmNamespace = nsReplacePrefix out (dmNamespace dm)})
    [DocMsg a]
list

data DocTracer = DocTracer {
      DocTracer -> [[Text]]
dtTracerNames :: [[Text]]
    , DocTracer -> [[Text]]
dtSilent      :: [[Text]]
    , DocTracer -> [[Text]]
dtNoMetrics   :: [[Text]]
    , DocTracer -> [([Text], DocuResult)]
dtBuilderList :: [([Text], DocuResult)]
    , DocTracer -> [Text]
dtWarnings    :: [InconsistencyWarning]
} deriving (Int -> DocTracer -> ShowS
[DocTracer] -> ShowS
DocTracer -> String
(Int -> DocTracer -> ShowS)
-> (DocTracer -> String)
-> ([DocTracer] -> ShowS)
-> Show DocTracer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocTracer -> ShowS
showsPrec :: Int -> DocTracer -> ShowS
$cshow :: DocTracer -> String
show :: DocTracer -> String
$cshowList :: [DocTracer] -> ShowS
showList :: [DocTracer] -> ShowS
Show)

instance Semigroup DocTracer where
  DocTracer
dtl <> :: DocTracer -> DocTracer -> DocTracer
<> DocTracer
dtr = [[Text]]
-> [[Text]]
-> [[Text]]
-> [([Text], DocuResult)]
-> [Text]
-> DocTracer
DocTracer
                 (DocTracer -> [[Text]]
dtTracerNames DocTracer
dtl [[Text]] -> [[Text]] -> [[Text]]
forall a. Semigroup a => a -> a -> a
<> DocTracer -> [[Text]]
dtTracerNames DocTracer
dtr)
                 (DocTracer -> [[Text]]
dtSilent DocTracer
dtl [[Text]] -> [[Text]] -> [[Text]]
forall a. Semigroup a => a -> a -> a
<> DocTracer -> [[Text]]
dtSilent DocTracer
dtr)
                 (DocTracer -> [[Text]]
dtNoMetrics DocTracer
dtl [[Text]] -> [[Text]] -> [[Text]]
forall a. Semigroup a => a -> a -> a
<> DocTracer -> [[Text]]
dtNoMetrics DocTracer
dtr)
                 (DocTracer -> [([Text], DocuResult)]
dtBuilderList DocTracer
dtl [([Text], DocuResult)]
-> [([Text], DocuResult)] -> [([Text], DocuResult)]
forall a. Semigroup a => a -> a -> a
<> DocTracer -> [([Text], DocuResult)]
dtBuilderList DocTracer
dtr)
                 (DocTracer -> [Text]
dtWarnings DocTracer
dtl [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> DocTracer -> [Text]
dtWarnings DocTracer
dtr)

documentTracer' :: forall a a1.
     MetaTrace a
  => (Trace IO a1 -> IO (Trace IO a))
  -> Trace IO a1
  -> IO DocTracer
documentTracer' :: forall a a1.
MetaTrace a =>
(Trace IO a1 -> IO (Trace IO a)) -> Trace IO a1 -> IO DocTracer
documentTracer' Trace IO a1 -> IO (Trace IO a)
hook Trace IO a1
tracer = do
    Trace IO a
tr' <- Trace IO a1 -> IO (Trace IO a)
hook Trace IO a1
tracer
    Trace IO a -> IO DocTracer
forall a. MetaTrace a => Trace IO a -> IO DocTracer
documentTracer Trace IO a
tr'

-- This function calls document tracers and returns a DocTracer result
documentTracer :: forall a.
     MetaTrace a
  => Trace IO a
  -> IO DocTracer
documentTracer :: forall a. MetaTrace a => Trace IO a -> IO DocTracer
documentTracer Trace IO a
tracer = do
    DocCollector IORef (Map Int LogDoc)
docRef <- [Trace IO a] -> IO DocCollector
forall a. MetaTrace a => [Trace IO a] -> IO DocCollector
documentTracersRun [Trace IO a
tracer]
    [(Int, LogDoc)]
items <- (Map Int LogDoc -> [(Int, LogDoc)])
-> IO (Map Int LogDoc) -> IO [(Int, LogDoc)]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Int LogDoc -> [(Int, LogDoc)]
forall k a. Map k a -> [(k, a)]
Map.toList (IO (Map Int LogDoc) -> IO (Map Int LogDoc)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Map Int LogDoc) -> IO (Map Int LogDoc)
forall a. IORef a -> IO a
readIORef IORef (Map Int LogDoc)
docRef))
    let sortedItems :: [(Int, LogDoc)]
sortedItems = ((Int, LogDoc) -> (Int, LogDoc) -> Ordering)
-> [(Int, LogDoc)] -> [(Int, LogDoc)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy
                        (\ (Int
_,LogDoc
l) (Int
_,LogDoc
r) -> [([Text], [Text])] -> [([Text], [Text])] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (LogDoc -> [([Text], [Text])]
ldNamespace LogDoc
l) (LogDoc -> [([Text], [Text])]
ldNamespace LogDoc
r))
                        [(Int, LogDoc)]
items
    let messageDocs :: [([Text], DocuResult)]
messageDocs = ((Int, LogDoc) -> ([Text], DocuResult))
-> [(Int, LogDoc)] -> [([Text], DocuResult)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, LogDoc
ld) -> case LogDoc -> [([Text], [Text])]
ldNamespace LogDoc
ld of
                                        ([Text]
prn,[Text]
pon) : [([Text], [Text])]
_  -> ([Text]
prn [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
pon, (Int, LogDoc) -> DocuResult
documentItem (Int
i, LogDoc
ld))
                                        []             -> ([Text
"No ns"], (Int, LogDoc) -> DocuResult
documentItem (Int
i, LogDoc
ld))) [(Int, LogDoc)]
sortedItems
        metricsItems :: [LogDoc]
metricsItems = ((Int, LogDoc) -> LogDoc) -> [(Int, LogDoc)] -> [LogDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Int, LogDoc) -> LogDoc
forall a b. (a, b) -> b
snd ([(Int, LogDoc)] -> [LogDoc]) -> [(Int, LogDoc)] -> [LogDoc]
forall a b. (a -> b) -> a -> b
$ ((Int, LogDoc) -> Bool) -> [(Int, LogDoc)] -> [(Int, LogDoc)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Int, LogDoc) -> Bool) -> (Int, LogDoc) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Text -> Bool
forall k a. Map k a -> Bool
Map.null (Map Text Text -> Bool)
-> ((Int, LogDoc) -> Map Text Text) -> (Int, LogDoc) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogDoc -> Map Text Text
ldMetricsDoc (LogDoc -> Map Text Text)
-> ((Int, LogDoc) -> LogDoc) -> (Int, LogDoc) -> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, LogDoc) -> LogDoc
forall a b. (a, b) -> b
snd) [(Int, LogDoc)]
sortedItems
        metricsDocs :: [([Text], DocuResult)]
metricsDocs = [LogDoc] -> [([Text], DocuResult)]
documentMetrics [LogDoc]
metricsItems
        tracerName :: [Text]
tracerName = case [(Int, LogDoc)]
sortedItems of
                      ((Int
_i, LogDoc
ld) : [(Int, LogDoc)]
_) -> case LogDoc -> [([Text], [Text])]
ldNamespace LogDoc
ld of
                                          ([Text]
prn, [Text]
_pon) : [([Text], [Text])]
_  -> [Text]
prn
                                          []               -> []
                      []             -> []
        silent :: Bool
silent = case [(Int, LogDoc)]
sortedItems of
                      ((Int
_i, LogDoc
ld) : [(Int, LogDoc)]
_) -> LogDoc -> Bool
ldSilent LogDoc
ld
                      [] -> Bool
False
        hasNoMetrics :: Bool
hasNoMetrics = [LogDoc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogDoc]
metricsItems
        warnings :: [Text]
warnings = ((Int, LogDoc) -> [Text]) -> [(Int, LogDoc)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
i, LogDoc
ld) -> case LogDoc -> [([Text], [Text])]
ldNamespace LogDoc
ld of
                                            ([Text]
_,[Text]
_): [([Text], [Text])]
_       -> (Int, LogDoc) -> [Text]
warningItem (Int
i, LogDoc
ld)
                                            []             -> (String -> Text
pack String
"No ns for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogDoc -> Text
ldDoc LogDoc
ld) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
                                              (Int, LogDoc) -> [Text]
warningItem (Int
i, LogDoc
ld)) [(Int, LogDoc)]
sortedItems
    DocTracer -> IO DocTracer
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DocTracer -> IO DocTracer) -> DocTracer -> IO DocTracer
forall a b. (a -> b) -> a -> b
$ [[Text]]
-> [[Text]]
-> [[Text]]
-> [([Text], DocuResult)]
-> [Text]
-> DocTracer
DocTracer
            [[Text]
tracerName]
            [[Text]
tracerName | Bool
silent]
            [[Text]
tracerName | Bool
hasNoMetrics]
            ([([Text], DocuResult)]
messageDocs [([Text], DocuResult)]
-> [([Text], DocuResult)] -> [([Text], DocuResult)]
forall a. [a] -> [a] -> [a]
++ [([Text], DocuResult)]
metricsDocs)
            [Text]
warnings

  where
    documentItem :: (Int, LogDoc) -> DocuResult
    documentItem :: (Int, LogDoc) -> DocuResult
documentItem (Int
_idx, ld :: LogDoc
ld@LogDoc {Bool
[([Text], [Text])]
[(Text, Double)]
[BackendConfig]
[SeverityF]
[DetailLevel]
Maybe SeverityS
Maybe Privacy
Maybe DetailLevel
Text
Map Text Text
ldNamespace :: LogDoc -> [([Text], [Text])]
ldMetricsDoc :: LogDoc -> Map Text Text
ldSilent :: LogDoc -> Bool
ldDoc :: LogDoc -> Text
ldDoc :: Text
ldMetricsDoc :: Map Text Text
ldNamespace :: [([Text], [Text])]
ldSeverityCoded :: Maybe SeverityS
ldPrivacyCoded :: Maybe Privacy
ldDetailsCoded :: Maybe DetailLevel
ldDetails :: [DetailLevel]
ldBackends :: [BackendConfig]
ldFiltered :: [SeverityF]
ldLimiter :: [(Text, Double)]
ldSilent :: Bool
ldSeverityCoded :: LogDoc -> Maybe SeverityS
ldPrivacyCoded :: LogDoc -> Maybe Privacy
ldDetailsCoded :: LogDoc -> Maybe DetailLevel
ldDetails :: LogDoc -> [DetailLevel]
ldBackends :: LogDoc -> [BackendConfig]
ldFiltered :: LogDoc -> [SeverityF]
ldLimiter :: LogDoc -> [(Text, Double)]
..}) =
      case [BackendConfig]
ldBackends of
        [BackendConfig
DatapointBackend] -> Builder -> DocuResult
DocuDatapoint (Builder -> DocuResult) -> Builder -> DocuResult
forall a b. (a -> b) -> a -> b
$
                    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Text -> Builder
fromText Text
"\n\n")
                      [ [([Text], [Text])] -> Builder
namespacesBuilder ([([Text], [Text])] -> [([Text], [Text])]
forall a. Eq a => [a] -> [a]
nub [([Text], [Text])]
ldNamespace)
                      , Text -> Builder
accentuated Text
ldDoc
                      ]
        [BackendConfig]
_ -> Builder -> DocuResult
DocuTracer (Builder -> DocuResult) -> Builder -> DocuResult
forall a b. (a -> b) -> a -> b
$
                    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Text -> Builder
fromText Text
"\n\n")
                      [ [([Text], [Text])] -> Builder
namespacesBuilder ([([Text], [Text])] -> [([Text], [Text])]
forall a. Eq a => [a] -> [a]
nub [([Text], [Text])]
ldNamespace)
                      , Text -> Builder
accentuated Text
ldDoc
                      , LogDoc -> Builder
propertiesBuilder LogDoc
ld
                      , LogDoc -> Builder
configBuilder LogDoc
ld
                      ]

    warningItem :: (Int, LogDoc) -> [InconsistencyWarning]
    warningItem :: (Int, LogDoc) -> [Text]
warningItem (Int
_idx, ld :: LogDoc
ld@LogDoc {Bool
[([Text], [Text])]
[(Text, Double)]
[BackendConfig]
[SeverityF]
[DetailLevel]
Maybe SeverityS
Maybe Privacy
Maybe DetailLevel
Text
Map Text Text
ldNamespace :: LogDoc -> [([Text], [Text])]
ldMetricsDoc :: LogDoc -> Map Text Text
ldSilent :: LogDoc -> Bool
ldDoc :: LogDoc -> Text
ldSeverityCoded :: LogDoc -> Maybe SeverityS
ldPrivacyCoded :: LogDoc -> Maybe Privacy
ldDetailsCoded :: LogDoc -> Maybe DetailLevel
ldDetails :: LogDoc -> [DetailLevel]
ldBackends :: LogDoc -> [BackendConfig]
ldFiltered :: LogDoc -> [SeverityF]
ldLimiter :: LogDoc -> [(Text, Double)]
ldDoc :: Text
ldMetricsDoc :: Map Text Text
ldNamespace :: [([Text], [Text])]
ldSeverityCoded :: Maybe SeverityS
ldPrivacyCoded :: Maybe Privacy
ldDetailsCoded :: Maybe DetailLevel
ldDetails :: [DetailLevel]
ldBackends :: [BackendConfig]
ldFiltered :: [SeverityF]
ldLimiter :: [(Text, Double)]
ldSilent :: Bool
..}) =
      case [BackendConfig]
ldBackends of
        [BackendConfig
DatapointBackend] -> [([Text], [Text])] -> LogDoc -> [Text]
namespacesWarning ([([Text], [Text])] -> [([Text], [Text])]
forall a. Eq a => [a] -> [a]
nub [([Text], [Text])]
ldNamespace) LogDoc
ld
        [BackendConfig]
_ -> [([Text], [Text])] -> LogDoc -> [Text]
namespacesWarning ([([Text], [Text])] -> [([Text], [Text])]
forall a. Eq a => [a] -> [a]
nub [([Text], [Text])]
ldNamespace) LogDoc
ld
                [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ LogDoc -> [Text]
propertiesWarning LogDoc
ld

    documentMetrics :: [LogDoc] -> [([Text],DocuResult)]
    documentMetrics :: [LogDoc] -> [([Text], DocuResult)]
documentMetrics [LogDoc]
logDocs =
      let nameCommentNamespaceList :: [((Text, Text), [([Text], [Text])])]
nameCommentNamespaceList =
            (LogDoc -> [((Text, Text), [([Text], [Text])])])
-> [LogDoc] -> [((Text, Text), [([Text], [Text])])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\LogDoc
ld -> [(Text, Text)]
-> [[([Text], [Text])]] -> [((Text, Text), [([Text], [Text])])]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList (LogDoc -> Map Text Text
ldMetricsDoc LogDoc
ld)) ([([Text], [Text])] -> [[([Text], [Text])]]
forall a. a -> [a]
repeat (LogDoc -> [([Text], [Text])]
ldNamespace LogDoc
ld))) [LogDoc]
logDocs
          sortedNameCommentNamespaceList :: [((Text, Text), [([Text], [Text])])]
sortedNameCommentNamespaceList =
            (((Text, Text), [([Text], [Text])])
 -> ((Text, Text), [([Text], [Text])]) -> Ordering)
-> [((Text, Text), [([Text], [Text])])]
-> [((Text, Text), [([Text], [Text])])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\((Text, Text), [([Text], [Text])])
a ((Text, Text), [([Text], [Text])])
b -> Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text)
-> (((Text, Text), [([Text], [Text])]) -> (Text, Text))
-> ((Text, Text), [([Text], [Text])])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text), [([Text], [Text])]) -> (Text, Text)
forall a b. (a, b) -> a
fst) ((Text, Text), [([Text], [Text])])
a) (((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text)
-> (((Text, Text), [([Text], [Text])]) -> (Text, Text))
-> ((Text, Text), [([Text], [Text])])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text), [([Text], [Text])]) -> (Text, Text)
forall a b. (a, b) -> a
fst) ((Text, Text), [([Text], [Text])])
b)) [((Text, Text), [([Text], [Text])])]
nameCommentNamespaceList
          groupedNameCommentNamespaceList :: [[((Text, Text), [([Text], [Text])])]]
groupedNameCommentNamespaceList =
            (((Text, Text), [([Text], [Text])])
 -> ((Text, Text), [([Text], [Text])]) -> Bool)
-> [((Text, Text), [([Text], [Text])])]
-> [[((Text, Text), [([Text], [Text])])]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\((Text, Text), [([Text], [Text])])
a ((Text, Text), [([Text], [Text])])
b -> ((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text)
-> (((Text, Text), [([Text], [Text])]) -> (Text, Text))
-> ((Text, Text), [([Text], [Text])])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text), [([Text], [Text])]) -> (Text, Text)
forall a b. (a, b) -> a
fst) ((Text, Text), [([Text], [Text])])
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== ((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text)
-> (((Text, Text), [([Text], [Text])]) -> (Text, Text))
-> ((Text, Text), [([Text], [Text])])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text), [([Text], [Text])]) -> (Text, Text)
forall a b. (a, b) -> a
fst) ((Text, Text), [([Text], [Text])])
b) [((Text, Text), [([Text], [Text])])]
sortedNameCommentNamespaceList
      in ([((Text, Text), [([Text], [Text])])]
 -> Maybe ([Text], DocuResult))
-> [[((Text, Text), [([Text], [Text])])]] -> [([Text], DocuResult)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [((Text, Text), [([Text], [Text])])] -> Maybe ([Text], DocuResult)
documentMetrics' [[((Text, Text), [([Text], [Text])])]]
groupedNameCommentNamespaceList

    documentMetrics' :: [( (Text, Text) , [([Text],[Text])] )] -> Maybe ([Text], DocuResult)
    documentMetrics' :: [((Text, Text), [([Text], [Text])])] -> Maybe ([Text], DocuResult)
documentMetrics' ncns :: [((Text, Text), [([Text], [Text])])]
ncns@(((Text
name, Text
comment), [([Text], [Text])]
_) : [((Text, Text), [([Text], [Text])])]
_tail) =
      ([Text], DocuResult) -> Maybe ([Text], DocuResult)
forall a. a -> Maybe a
Just ([Text
name], Builder -> DocuResult
DocuMetric
              (Builder -> DocuResult) -> Builder -> DocuResult
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Text -> Builder
fromText Text
"\n\n")
                    [ (Text, Text) -> Builder
metricToBuilder (Text
name,Text
comment)
                    , [([Text], [Text])] -> Builder
namespacesMetricsBuilder ([([Text], [Text])] -> [([Text], [Text])]
forall a. Eq a => [a] -> [a]
nub ((((Text, Text), [([Text], [Text])]) -> [([Text], [Text])])
-> [((Text, Text), [([Text], [Text])])] -> [([Text], [Text])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Text, Text), [([Text], [Text])]) -> [([Text], [Text])]
forall a b. (a, b) -> b
snd [((Text, Text), [([Text], [Text])])]
ncns))
                    ])
    documentMetrics' [] = Maybe ([Text], DocuResult)
forall a. Maybe a
Nothing

    namespacesBuilder :: [([Text], [Text])] -> Builder
    namespacesBuilder :: [([Text], [Text])] -> Builder
namespacesBuilder [([Text], [Text])
ns] = ([Text], [Text]) -> Builder
namespaceBuilder ([Text], [Text])
ns
    namespacesBuilder []   = Text -> Builder
fromText Text
"__Warning__: namespace missing"
    namespacesBuilder [([Text], [Text])]
nsl  =
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
singleton Char
'\n') ((([Text], [Text]) -> Builder) -> [([Text], [Text])] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ([Text], [Text]) -> Builder
namespaceBuilder [([Text], [Text])]
nsl))

    namespaceBuilder :: ([Text], [Text]) -> Builder
    namespaceBuilder :: ([Text], [Text]) -> Builder
namespaceBuilder ([Text]
nsPr, [Text]
nsPo) = Text -> Builder
fromText Text
"### " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
singleton Char
'.') ((Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
fromText ([Text]
nsPr [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
nsPo)))

    namespacesMetricsBuilder :: [ ([Text], [Text])] -> Builder
    namespacesMetricsBuilder :: [([Text], [Text])] -> Builder
namespacesMetricsBuilder [([Text], [Text])
ns] = Text -> Builder
fromText Text
"Dispatched by: \n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ([Text], [Text]) -> Builder
namespaceMetricsBuilder ([Text], [Text])
ns
    namespacesMetricsBuilder []   = Builder
forall a. Monoid a => a
mempty
    namespacesMetricsBuilder [([Text], [Text])]
nsl  = Text -> Builder
fromText Text
"Dispatched by: \n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
singleton Char
'\n') ((([Text], [Text]) -> Builder) -> [([Text], [Text])] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ([Text], [Text]) -> Builder
namespaceMetricsBuilder [([Text], [Text])]
nsl))

    namespaceMetricsBuilder :: ([Text], [Text]) -> Builder
    namespaceMetricsBuilder :: ([Text], [Text]) -> Builder
namespaceMetricsBuilder ([Text]
nsPr, [Text]
nsPo) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
singleton Char
'.')
                                                      ((Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
fromText ([Text]
nsPr [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
nsPo)))

    namespacesWarning :: [([Text], [Text])] -> LogDoc -> [InconsistencyWarning]
    namespacesWarning :: [([Text], [Text])] -> LogDoc -> [Text]
namespacesWarning [] LogDoc
ld  = [Text
"Namespace missing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogDoc -> Text
ldDoc LogDoc
ld]
    namespacesWarning [([Text], [Text])]
_ LogDoc
_  = []

    propertiesBuilder :: LogDoc -> Builder
    propertiesBuilder :: LogDoc -> Builder
propertiesBuilder LogDoc {Bool
[([Text], [Text])]
[(Text, Double)]
[BackendConfig]
[SeverityF]
[DetailLevel]
Maybe SeverityS
Maybe Privacy
Maybe DetailLevel
Text
Map Text Text
ldNamespace :: LogDoc -> [([Text], [Text])]
ldMetricsDoc :: LogDoc -> Map Text Text
ldSilent :: LogDoc -> Bool
ldDoc :: LogDoc -> Text
ldSeverityCoded :: LogDoc -> Maybe SeverityS
ldPrivacyCoded :: LogDoc -> Maybe Privacy
ldDetailsCoded :: LogDoc -> Maybe DetailLevel
ldDetails :: LogDoc -> [DetailLevel]
ldBackends :: LogDoc -> [BackendConfig]
ldFiltered :: LogDoc -> [SeverityF]
ldLimiter :: LogDoc -> [(Text, Double)]
ldDoc :: Text
ldMetricsDoc :: Map Text Text
ldNamespace :: [([Text], [Text])]
ldSeverityCoded :: Maybe SeverityS
ldPrivacyCoded :: Maybe Privacy
ldDetailsCoded :: Maybe DetailLevel
ldDetails :: [DetailLevel]
ldBackends :: [BackendConfig]
ldFiltered :: [SeverityF]
ldLimiter :: [(Text, Double)]
ldSilent :: Bool
..} =
        case Maybe SeverityS
ldSeverityCoded of
          Just SeverityS
s  -> Text -> Builder
fromText Text
"Severity:  " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
asCode (String -> Builder
fromString (SeverityS -> String
forall a. Show a => a -> String
show SeverityS
s)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
          Maybe SeverityS
Nothing -> Text -> Builder
fromText Text
"Severity missing: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        case Maybe Privacy
ldPrivacyCoded of
          Just Privacy
p  -> Text -> Builder
fromText Text
"Privacy:   " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
asCode (String -> Builder
fromString (Privacy -> String
forall a. Show a => a -> String
show Privacy
p)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
          Maybe Privacy
Nothing -> Text -> Builder
fromText Text
"Privacy missing: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        case Maybe DetailLevel
ldDetailsCoded of
          Just DetailLevel
d  -> Text -> Builder
fromText Text
"Details:   " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
asCode (String -> Builder
fromString (DetailLevel -> String
forall a. Show a => a -> String
show DetailLevel
d)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
          Maybe DetailLevel
Nothing -> Text -> Builder
fromText Text
"Details missing: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"

    propertiesWarning :: LogDoc ->[InconsistencyWarning]
    propertiesWarning :: LogDoc -> [Text]
propertiesWarning LogDoc {Bool
[([Text], [Text])]
[(Text, Double)]
[BackendConfig]
[SeverityF]
[DetailLevel]
Maybe SeverityS
Maybe Privacy
Maybe DetailLevel
Text
Map Text Text
ldNamespace :: LogDoc -> [([Text], [Text])]
ldMetricsDoc :: LogDoc -> Map Text Text
ldSilent :: LogDoc -> Bool
ldDoc :: LogDoc -> Text
ldSeverityCoded :: LogDoc -> Maybe SeverityS
ldPrivacyCoded :: LogDoc -> Maybe Privacy
ldDetailsCoded :: LogDoc -> Maybe DetailLevel
ldDetails :: LogDoc -> [DetailLevel]
ldBackends :: LogDoc -> [BackendConfig]
ldFiltered :: LogDoc -> [SeverityF]
ldLimiter :: LogDoc -> [(Text, Double)]
ldDoc :: Text
ldMetricsDoc :: Map Text Text
ldNamespace :: [([Text], [Text])]
ldSeverityCoded :: Maybe SeverityS
ldPrivacyCoded :: Maybe Privacy
ldDetailsCoded :: Maybe DetailLevel
ldDetails :: [DetailLevel]
ldBackends :: [BackendConfig]
ldFiltered :: [SeverityF]
ldLimiter :: [(Text, Double)]
ldSilent :: Bool
..} =
        case Maybe SeverityS
ldSeverityCoded of
          Just SeverityS
_s -> []
          Maybe SeverityS
Nothing -> (([Text], [Text]) -> Text) -> [([Text], [Text])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\([Text], [Text])
ns -> String -> Text
pack String
"Severity missing: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text], [Text]) -> Text
nsRawToText ([Text], [Text])
ns) [([Text], [Text])]
ldNamespace
      [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
        case Maybe Privacy
ldPrivacyCoded of
          Just Privacy
_p -> []
          Maybe Privacy
Nothing -> (([Text], [Text]) -> Text) -> [([Text], [Text])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\([Text], [Text])
ns -> String -> Text
pack String
"Privacy missing: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text], [Text]) -> Text
nsRawToText ([Text], [Text])
ns) [([Text], [Text])]
ldNamespace
      [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
        case Maybe DetailLevel
ldDetailsCoded of
          Just DetailLevel
_d -> []
          Maybe DetailLevel
Nothing -> (([Text], [Text]) -> Text) -> [([Text], [Text])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\([Text], [Text])
ns -> String -> Text
pack String
"Details missing: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text], [Text]) -> Text
nsRawToText ([Text], [Text])
ns) [([Text], [Text])]
ldNamespace

    configBuilder :: LogDoc -> Builder
    configBuilder :: LogDoc -> Builder
configBuilder LogDoc {Bool
[([Text], [Text])]
[(Text, Double)]
[BackendConfig]
[SeverityF]
[DetailLevel]
Maybe SeverityS
Maybe Privacy
Maybe DetailLevel
Text
Map Text Text
ldNamespace :: LogDoc -> [([Text], [Text])]
ldMetricsDoc :: LogDoc -> Map Text Text
ldSilent :: LogDoc -> Bool
ldDoc :: LogDoc -> Text
ldSeverityCoded :: LogDoc -> Maybe SeverityS
ldPrivacyCoded :: LogDoc -> Maybe Privacy
ldDetailsCoded :: LogDoc -> Maybe DetailLevel
ldDetails :: LogDoc -> [DetailLevel]
ldBackends :: LogDoc -> [BackendConfig]
ldFiltered :: LogDoc -> [SeverityF]
ldLimiter :: LogDoc -> [(Text, Double)]
ldDoc :: Text
ldMetricsDoc :: Map Text Text
ldNamespace :: [([Text], [Text])]
ldSeverityCoded :: Maybe SeverityS
ldPrivacyCoded :: Maybe Privacy
ldDetailsCoded :: Maybe DetailLevel
ldDetails :: [DetailLevel]
ldBackends :: [BackendConfig]
ldFiltered :: [SeverityF]
ldLimiter :: [(Text, Double)]
ldSilent :: Bool
..} =
      Text -> Builder
fromText Text
"From current configuration:\n"
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> case [DetailLevel] -> [DetailLevel]
forall a. Eq a => [a] -> [a]
nub [DetailLevel]
ldDetails of
          []  -> Builder
forall a. Monoid a => a
mempty
          [DetailLevel
d] -> if DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
d Maybe DetailLevel -> Maybe DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe DetailLevel
ldDetailsCoded
                    then Text -> Builder
fromText Text
"Details:   "
                            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
asCode (String -> Builder
fromString (DetailLevel -> String
forall a. Show a => a -> String
show DetailLevel
d))
                    else Builder
forall a. Monoid a => a
mempty
          [DetailLevel]
l   -> Text -> Builder
fromText Text
"Details:   "
                  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Text -> Builder
fromText Text
",\n      ")
                               ((DetailLevel -> Builder) -> [DetailLevel] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Builder
asCode (Builder -> Builder)
-> (DetailLevel -> Builder) -> DetailLevel -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
fromString (String -> Builder)
-> (DetailLevel -> String) -> DetailLevel -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DetailLevel -> String
forall a. Show a => a -> String
show) [DetailLevel]
l))
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"\n"
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [BackendConfig] -> Builder
backendsBuilder ([BackendConfig] -> [BackendConfig]
forall a. Eq a => [a] -> [a]
nub [BackendConfig]
ldBackends)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"\n"
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [SeverityF] -> Maybe SeverityS -> Builder
filteredBuilder ([SeverityF] -> [SeverityF]
forall a. Eq a => [a] -> [a]
nub [SeverityF]
ldFiltered) Maybe SeverityS
ldSeverityCoded
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [(Text, Double)] -> Builder
limiterBuilder ([(Text, Double)] -> [(Text, Double)]
forall a. Eq a => [a] -> [a]
nub [(Text, Double)]
ldLimiter)

    backendsBuilder :: [BackendConfig] -> Builder
    backendsBuilder :: [BackendConfig] -> Builder
backendsBuilder [] = Text -> Builder
fromText Text
"No backends found"
    backendsBuilder [BackendConfig]
l  = Text -> Builder
fromText Text
"Backends:\n      "
                          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Text -> Builder
fromText Text
",\n      ")
                                ((BackendConfig -> Builder) -> [BackendConfig] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map BackendConfig -> Builder
backendFormatToText [BackendConfig]
l))

    backendFormatToText :: BackendConfig -> Builder
    backendFormatToText :: BackendConfig -> Builder
backendFormatToText BackendConfig
be = Builder -> Builder
asCode (String -> Builder
fromString (BackendConfig -> String
forall a. Show a => a -> String
show BackendConfig
be))

    filteredBuilder :: [SeverityF] -> Maybe SeverityS -> Builder
    filteredBuilder :: [SeverityF] -> Maybe SeverityS -> Builder
filteredBuilder [] Maybe SeverityS
_ = Builder
forall a. Monoid a => a
mempty
    filteredBuilder [SeverityF]
_ Maybe SeverityS
Nothing = Builder
forall a. Monoid a => a
mempty
    filteredBuilder [SeverityF]
l (Just SeverityS
r) =
      Text -> Builder
fromText Text
"Filtered "
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> case [SeverityF]
l of
            [SeverityF (Just SeverityS
lh)] ->
              if SeverityS -> Int
forall a. Enum a => a -> Int
fromEnum SeverityS
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= SeverityS -> Int
forall a. Enum a => a -> Int
fromEnum SeverityS
lh
                then (Builder -> Builder
asCode (Builder -> Builder) -> (String -> Builder) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
fromString) String
"Visible"
                else (Builder -> Builder
asCode (Builder -> Builder) -> (String -> Builder) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
fromString) String
"Invisible"
            [SeverityF Maybe SeverityS
Nothing] -> Builder
"Invisible"
            [SeverityF]
_ -> Builder
forall a. Monoid a => a
mempty
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
" by config value: "
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Text -> Builder
fromText Text
", ")
          ((SeverityF -> Builder) -> [SeverityF] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Builder
asCode (Builder -> Builder)
-> (SeverityF -> Builder) -> SeverityF -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
fromString (String -> Builder)
-> (SeverityF -> String) -> SeverityF -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeverityF -> String
forall a. Show a => a -> String
show) [SeverityF]
l))

    limiterBuilder ::
         [(Text, Double)]
      -> Builder
    limiterBuilder :: [(Text, Double)] -> Builder
limiterBuilder [] = Builder
forall a. Monoid a => a
mempty
    limiterBuilder [(Text, Double)]
l  =
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Text -> Builder
fromText Text
", ")
        (((Text, Double) -> Builder) -> [(Text, Double)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\ (Text
n, Double
d) ->  Text -> Builder
fromText Text
"\nLimiter "
                        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Builder -> Builder
asCode (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
fromText) Text
n
                        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
" with frequency "
                        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Builder -> Builder
asCode (Builder -> Builder) -> (Double -> Builder) -> Double -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
fromString(String -> Builder) -> (Double -> String) -> Double -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) Double
d)
              [(Text, Double)]
l))

    metricToBuilder :: (Text, Text) -> Builder
    metricToBuilder :: (Text, Text) -> Builder
metricToBuilder (Text
name, Text
text) =
        Text -> Builder
fromText Text
"### "
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
name
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"\n"
              Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
accentuated Text
text



-- | Calls the tracers in a documentation control mode,
-- and returns a DocCollector, from which the documentation gets generated
documentTracersRun :: forall a. MetaTrace a => [Trace IO a] -> IO DocCollector
documentTracersRun :: forall a. MetaTrace a => [Trace IO a] -> IO DocCollector
documentTracersRun [Trace IO a]
tracers = do
    let nss :: [Namespace a]
nss = [Namespace a]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace a]
        nsIdx :: [(Namespace a, Int)]
nsIdx = [Namespace a] -> [Int] -> [(Namespace a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Namespace a]
nss [Int
0..]
    DocCollector
coll <- (IORef (Map Int LogDoc) -> DocCollector)
-> IO (IORef (Map Int LogDoc)) -> IO DocCollector
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IORef (Map Int LogDoc) -> DocCollector
DocCollector (IO (IORef (Map Int LogDoc)) -> IO (IORef (Map Int LogDoc))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Map Int LogDoc)) -> IO (IORef (Map Int LogDoc)))
-> IO (IORef (Map Int LogDoc)) -> IO (IORef (Map Int LogDoc))
forall a b. (a -> b) -> a -> b
$ Map Int LogDoc -> IO (IORef (Map Int LogDoc))
forall a. a -> IO (IORef a)
newIORef (Map Int LogDoc
forall k a. Map k a
Map.empty :: Map.Map Int LogDoc))
    (Trace IO a -> IO ()) -> [Trace IO a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([(Namespace a, Int)] -> DocCollector -> Trace IO a -> IO ()
forall {t :: * -> *} {a} {a}.
(Foldable t, MetaTrace a) =>
t (Namespace a, Int) -> DocCollector -> Trace IO a -> IO ()
docTrace [(Namespace a, Int)]
nsIdx DocCollector
coll) [Trace IO a]
tracers
    DocCollector -> IO DocCollector
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DocCollector
coll
  where
    docTrace :: t (Namespace a, Int) -> DocCollector -> Trace IO a -> IO ()
docTrace t (Namespace a, Int)
nsIdx dc :: DocCollector
dc@(DocCollector IORef (Map Int LogDoc)
docRef) (Trace Tracer IO (LoggingContext, Either TraceControl a)
tr) =
      ((Namespace a, Int) -> IO ()) -> t (Namespace a, Int) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
        (\ (Namespace a
ns, Int
idx) -> do
            let condDoc :: Maybe Text
condDoc = Namespace a -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor Namespace a
ns
                doc :: Text
doc = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty Maybe Text
condDoc

            IORef (Map Int LogDoc)
-> (Map Int LogDoc -> Map Int LogDoc) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Map Int LogDoc)
docRef
                        (Int -> LogDoc -> Map Int LogDoc -> Map Int LogDoc
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
                          Int
idx
                          ((Text -> [(Text, Text)] -> LogDoc
emptyLogDoc
                              Text
doc
                              (Namespace a -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor Namespace a
ns))
                            { ldSeverityCoded = severityFor ns Nothing
                            , ldPrivacyCoded  = privacyFor ns Nothing
                            , ldDetailsCoded  = detailsFor ns Nothing
                          }))
            Tracer IO (LoggingContext, Either TraceControl a)
-> (LoggingContext, Either TraceControl a) -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
TR.traceWith Tracer IO (LoggingContext, Either TraceControl a)
tr (LoggingContext
emptyLoggingContext {lcNSInner = nsInner ns},
                            TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left (Int -> DocCollector -> TraceControl
TCDocument Int
idx DocCollector
dc)))
        t (Namespace a, Int)
nsIdx

-------------------- Callbacks ---------------------------

docTracer :: MonadIO m =>
     BackendConfig
  -> Trace m FormattedMessage
docTracer :: forall (m :: * -> *).
MonadIO m =>
BackendConfig -> Trace m FormattedMessage
docTracer BackendConfig
backendConfig = Tracer m (LoggingContext, Either TraceControl FormattedMessage)
-> Trace m FormattedMessage
forall (m :: * -> *) a.
Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
Trace (Tracer m (LoggingContext, Either TraceControl FormattedMessage)
 -> Trace m FormattedMessage)
-> Tracer m (LoggingContext, Either TraceControl FormattedMessage)
-> Trace m FormattedMessage
forall a b. (a -> b) -> a -> b
$ TracerA m (LoggingContext, Either TraceControl FormattedMessage) ()
-> Tracer m (LoggingContext, Either TraceControl FormattedMessage)
forall (m :: * -> *) a. TracerA m a () -> Tracer m a
TR.arrow (TracerA
   m (LoggingContext, Either TraceControl FormattedMessage) ()
 -> Tracer m (LoggingContext, Either TraceControl FormattedMessage))
-> TracerA
     m (LoggingContext, Either TraceControl FormattedMessage) ()
-> Tracer m (LoggingContext, Either TraceControl FormattedMessage)
forall a b. (a -> b) -> a -> b
$ ((LoggingContext, Either TraceControl FormattedMessage) -> m ())
-> TracerA
     m (LoggingContext, Either TraceControl FormattedMessage) ()
forall (m :: * -> *) a.
Applicative m =>
(a -> m ()) -> TracerA m a ()
TR.emit (LoggingContext, Either TraceControl FormattedMessage) -> m ()
forall {m :: * -> *} {a}.
MonadIO m =>
(LoggingContext, Either TraceControl a) -> m ()
output
  where
    output :: (LoggingContext, Either TraceControl a) -> m ()
output p :: (LoggingContext, Either TraceControl a)
p@(LoggingContext
_, Left TCDocument {}) =
      BackendConfig -> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
BackendConfig -> (LoggingContext, Either TraceControl a) -> m ()
docIt BackendConfig
backendConfig (LoggingContext, Either TraceControl a)
p
    output (LoggingContext
_, Either TraceControl a
_) = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

docTracerDatapoint :: MonadIO m =>
     BackendConfig
  -> Trace m a
docTracerDatapoint :: forall (m :: * -> *) a. MonadIO m => BackendConfig -> Trace m a
docTracerDatapoint BackendConfig
backendConfig = Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
forall (m :: * -> *) a.
Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
Trace (Tracer m (LoggingContext, Either TraceControl a) -> Trace m a)
-> Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
forall a b. (a -> b) -> a -> b
$ TracerA m (LoggingContext, Either TraceControl a) ()
-> Tracer m (LoggingContext, Either TraceControl a)
forall (m :: * -> *) a. TracerA m a () -> Tracer m a
TR.arrow (TracerA m (LoggingContext, Either TraceControl a) ()
 -> Tracer m (LoggingContext, Either TraceControl a))
-> TracerA m (LoggingContext, Either TraceControl a) ()
-> Tracer m (LoggingContext, Either TraceControl a)
forall a b. (a -> b) -> a -> b
$ ((LoggingContext, Either TraceControl a) -> m ())
-> TracerA m (LoggingContext, Either TraceControl a) ()
forall (m :: * -> *) a.
Applicative m =>
(a -> m ()) -> TracerA m a ()
TR.emit (LoggingContext, Either TraceControl a) -> m ()
forall {m :: * -> *} {a}.
MonadIO m =>
(LoggingContext, Either TraceControl a) -> m ()
output
  where
    output :: (LoggingContext, Either TraceControl a) -> m ()
output p :: (LoggingContext, Either TraceControl a)
p@(LoggingContext
_, Left TCDocument {}) =
      BackendConfig -> (LoggingContext, Either TraceControl a) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
BackendConfig -> (LoggingContext, Either TraceControl a) -> m ()
docItDatapoint BackendConfig
backendConfig (LoggingContext, Either TraceControl a)
p
    output (LoggingContext
_, Either TraceControl a
_) = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | Callback for doc collection
addFiltered :: MonadIO m => TraceControl -> Maybe SeverityF -> m ()
addFiltered :: forall (m :: * -> *).
MonadIO m =>
TraceControl -> Maybe SeverityF -> m ()
addFiltered (TCDocument Int
idx (DocCollector IORef (Map Int LogDoc)
docRef)) (Just SeverityF
sev) = do
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map Int LogDoc)
-> (Map Int LogDoc -> Map Int LogDoc) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Map Int LogDoc)
docRef (\ Map Int LogDoc
docMap ->
      Int -> LogDoc -> Map Int LogDoc -> Map Int LogDoc
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
        Int
idx
        ((\LogDoc
e -> LogDoc
e { ldFiltered = seq sev (sev : ldFiltered e)})
          (case Int -> Map Int LogDoc -> Maybe LogDoc
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
idx Map Int LogDoc
docMap of
                        Just LogDoc
e  -> LogDoc
e
                        Maybe LogDoc
Nothing -> String -> LogDoc
forall a. HasCallStack => String -> a
error String
"DocuGenerator>>missing log doc"))
        Map Int LogDoc
docMap)
addFiltered TraceControl
_ Maybe SeverityF
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Callback for doc collection
addLimiter :: MonadIO m => TraceControl -> (Text, Double) -> m ()
addLimiter :: forall (m :: * -> *).
MonadIO m =>
TraceControl -> (Text, Double) -> m ()
addLimiter (TCDocument Int
idx (DocCollector IORef (Map Int LogDoc)
docRef)) (Text
ln, Double
lf) = do
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map Int LogDoc)
-> (Map Int LogDoc -> Map Int LogDoc) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Map Int LogDoc)
docRef (\ Map Int LogDoc
docMap ->
      Int -> LogDoc -> Map Int LogDoc -> Map Int LogDoc
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
        Int
idx
        ((\LogDoc
e -> LogDoc
e { ldLimiter = seq ln (seq lf ((ln, lf) : ldLimiter e))})
          (case Int -> Map Int LogDoc -> Maybe LogDoc
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
idx Map Int LogDoc
docMap of
                        Just LogDoc
e  -> LogDoc
e
                        Maybe LogDoc
Nothing -> String -> LogDoc
forall a. HasCallStack => String -> a
error String
"DocuGenerator>>missing log doc"))
        Map Int LogDoc
docMap)
addLimiter TraceControl
_ (Text, Double)
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

addSilent :: MonadIO m => TraceControl -> Maybe Bool -> m ()
addSilent :: forall (m :: * -> *).
MonadIO m =>
TraceControl -> Maybe Bool -> m ()
addSilent (TCDocument Int
idx (DocCollector IORef (Map Int LogDoc)
docRef)) (Just Bool
silent) = do
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map Int LogDoc)
-> (Map Int LogDoc -> Map Int LogDoc) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Map Int LogDoc)
docRef (\ Map Int LogDoc
docMap ->
      Int -> LogDoc -> Map Int LogDoc -> Map Int LogDoc
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
        Int
idx
        ((\LogDoc
e -> LogDoc
e { ldSilent = silent})
          (case Int -> Map Int LogDoc -> Maybe LogDoc
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
idx Map Int LogDoc
docMap of
                        Just LogDoc
e  -> LogDoc
e
                        Maybe LogDoc
Nothing -> String -> LogDoc
forall a. HasCallStack => String -> a
error String
"DocuGenerator>>missing log doc"))
        Map Int LogDoc
docMap)
addSilent TraceControl
_ Maybe Bool
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Callback for doc collection
docIt :: MonadIO m
  => BackendConfig
  -> (LoggingContext, Either TraceControl a)
  -> m ()
docIt :: forall (m :: * -> *) a.
MonadIO m =>
BackendConfig -> (LoggingContext, Either TraceControl a) -> m ()
docIt BackendConfig
EKGBackend (LoggingContext{},
  Left (TCDocument Int
idx (DocCollector IORef (Map Int LogDoc)
docRef))) = do
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map Int LogDoc)
-> (Map Int LogDoc -> Map Int LogDoc) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Map Int LogDoc)
docRef (\ Map Int LogDoc
docMap ->
        Int -> LogDoc -> Map Int LogDoc -> Map Int LogDoc
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
          Int
idx
          ((\LogDoc
e -> LogDoc
e { ldBackends  = EKGBackend : ldBackends e
                    })
            (case Int -> Map Int LogDoc -> Maybe LogDoc
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
idx Map Int LogDoc
docMap of
                          Just LogDoc
e  -> LogDoc
e
                          Maybe LogDoc
Nothing -> String -> LogDoc
forall a. HasCallStack => String -> a
error String
"DocuGenerator>>missing log doc"))
          Map Int LogDoc
docMap)
docIt BackendConfig
backend (LoggingContext {[Text]
Maybe SeverityS
Maybe Privacy
Maybe DetailLevel
lcNSInner :: LoggingContext -> [Text]
lcNSInner :: [Text]
lcNSPrefix :: [Text]
lcSeverity :: Maybe SeverityS
lcPrivacy :: Maybe Privacy
lcDetails :: Maybe DetailLevel
lcNSPrefix :: LoggingContext -> [Text]
lcSeverity :: LoggingContext -> Maybe SeverityS
lcPrivacy :: LoggingContext -> Maybe Privacy
lcDetails :: LoggingContext -> Maybe DetailLevel
..},
  Left (TCDocument Int
idx (DocCollector IORef (Map Int LogDoc)
docRef))) = do
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map Int LogDoc)
-> (Map Int LogDoc -> Map Int LogDoc) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Map Int LogDoc)
docRef (\ Map Int LogDoc
docMap ->
      Int -> LogDoc -> Map Int LogDoc -> Map Int LogDoc
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
        Int
idx
        ((\LogDoc
e -> LogDoc
e { ldBackends  = backend : ldBackends e
                  , ldNamespace = nub ((lcNSPrefix,lcNSInner) : ldNamespace e)
                  , ldDetails   = case lcDetails of
                                    Maybe DetailLevel
Nothing -> LogDoc -> [DetailLevel]
ldDetails LogDoc
e
                                    Just DetailLevel
d  -> DetailLevel
d DetailLevel -> [DetailLevel] -> [DetailLevel]
forall a. a -> [a] -> [a]
: LogDoc -> [DetailLevel]
ldDetails LogDoc
e
                  })
          (case Int -> Map Int LogDoc -> Maybe LogDoc
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
idx Map Int LogDoc
docMap of
                        Just LogDoc
e  -> LogDoc
e
                        Maybe LogDoc
Nothing -> String -> LogDoc
forall a. HasCallStack => String -> a
error String
"DocuGenerator>>missing log doc"))
        Map Int LogDoc
docMap)
docIt BackendConfig
_ (LoggingContext
_, Either TraceControl a
_) = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Callback for doc collection
docItDatapoint :: MonadIO m =>
     BackendConfig
  -> (LoggingContext, Either TraceControl a)
  -> m ()
docItDatapoint :: forall (m :: * -> *) a.
MonadIO m =>
BackendConfig -> (LoggingContext, Either TraceControl a) -> m ()
docItDatapoint BackendConfig
_backend (LoggingContext {[Text]
Maybe SeverityS
Maybe Privacy
Maybe DetailLevel
lcNSInner :: LoggingContext -> [Text]
lcNSPrefix :: LoggingContext -> [Text]
lcSeverity :: LoggingContext -> Maybe SeverityS
lcPrivacy :: LoggingContext -> Maybe Privacy
lcDetails :: LoggingContext -> Maybe DetailLevel
lcNSInner :: [Text]
lcNSPrefix :: [Text]
lcSeverity :: Maybe SeverityS
lcPrivacy :: Maybe Privacy
lcDetails :: Maybe DetailLevel
..},
  Left (TCDocument Int
idx (DocCollector IORef (Map Int LogDoc)
docRef))) = do
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map Int LogDoc)
-> (Map Int LogDoc -> Map Int LogDoc) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Map Int LogDoc)
docRef (\ Map Int LogDoc
docMap ->
      Int -> LogDoc -> Map Int LogDoc -> Map Int LogDoc
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
        Int
idx
        ((\LogDoc
e -> LogDoc
e { ldNamespace = nub ((lcNSPrefix, lcNSInner) : ldNamespace e)
                  , ldBackends  = [DatapointBackend]
                  })
          (case Int -> Map Int LogDoc -> Maybe LogDoc
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
idx Map Int LogDoc
docMap of
                        Just LogDoc
e  -> LogDoc
e
                        Maybe LogDoc
Nothing -> String -> LogDoc
forall a. HasCallStack => String -> a
error String
"DocuGenerator>>missing log doc"))
        Map Int LogDoc
docMap)
docItDatapoint BackendConfig
_backend (LoggingContext {}, Either TraceControl a
_) = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- Finally generate a text from all the builders
docuResultsToText :: DocTracer -> TraceConfig -> Text
docuResultsToText :: DocTracer -> TraceConfig -> Text
docuResultsToText dt :: DocTracer
dt@DocTracer {[[Text]]
[([Text], DocuResult)]
[Text]
dtTracerNames :: DocTracer -> [[Text]]
dtSilent :: DocTracer -> [[Text]]
dtNoMetrics :: DocTracer -> [[Text]]
dtBuilderList :: DocTracer -> [([Text], DocuResult)]
dtWarnings :: DocTracer -> [Text]
dtTracerNames :: [[Text]]
dtSilent :: [[Text]]
dtNoMetrics :: [[Text]]
dtBuilderList :: [([Text], DocuResult)]
dtWarnings :: [Text]
..} TraceConfig
configuration =
  let traceBuilders :: [([Text], DocuResult)]
traceBuilders = (([Text], DocuResult) -> ([Text], DocuResult) -> Ordering)
-> [([Text], DocuResult)] -> [([Text], DocuResult)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\ ([Text]
l,DocuResult
_) ([Text]
r,DocuResult
_) -> [Text] -> [Text] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Text]
l [Text]
r)
                          ((([Text], DocuResult) -> Bool)
-> [([Text], DocuResult)] -> [([Text], DocuResult)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DocuResult -> Bool
DocuResult.isTracer (DocuResult -> Bool)
-> (([Text], DocuResult) -> DocuResult)
-> ([Text], DocuResult)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], DocuResult) -> DocuResult
forall a b. (a, b) -> b
snd) [([Text], DocuResult)]
dtBuilderList)
      metricsBuilders :: [([Text], DocuResult)]
metricsBuilders = (([Text], DocuResult) -> ([Text], DocuResult) -> Ordering)
-> [([Text], DocuResult)] -> [([Text], DocuResult)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\ ([Text]
l,DocuResult
_) ([Text]
r,DocuResult
_) -> [Text] -> [Text] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Text]
l [Text]
r)
                          ((([Text], DocuResult) -> Bool)
-> [([Text], DocuResult)] -> [([Text], DocuResult)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DocuResult -> Bool
DocuResult.isMetric (DocuResult -> Bool)
-> (([Text], DocuResult) -> DocuResult)
-> ([Text], DocuResult)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Text], DocuResult) -> DocuResult
forall a b. (a, b) -> b
snd) [([Text], DocuResult)]
dtBuilderList)
      datapointBuilders :: [([Text], DocuResult)]
datapointBuilders = (([Text], DocuResult) -> ([Text], DocuResult) -> Ordering)
-> [([Text], DocuResult)] -> [([Text], DocuResult)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\ ([Text]
l,DocuResult
_) ([Text]
r,DocuResult
_) -> [Text] -> [Text] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Text]
l [Text]
r)
                          ((([Text], DocuResult) -> Bool)
-> [([Text], DocuResult)] -> [([Text], DocuResult)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DocuResult -> Bool
DocuResult.isDatapoint (DocuResult -> Bool)
-> (([Text], DocuResult) -> DocuResult)
-> ([Text], DocuResult)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], DocuResult) -> DocuResult
forall a b. (a, b) -> b
snd) [([Text], DocuResult)]
dtBuilderList)
      header :: Builder
header  = Text -> Builder
fromText Text
"# Cardano Trace Documentation\n\n"
      header1 :: Builder
header1  = Text -> Builder
fromText Text
"## Table Of Contents\n\n"
      toc :: Builder
toc      = DocTracer -> [[Text]] -> [[Text]] -> [[Text]] -> Builder
generateTOC DocTracer
dt
                    ((([Text], DocuResult) -> [Text])
-> [([Text], DocuResult)] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map ([Text], DocuResult) -> [Text]
forall a b. (a, b) -> a
fst [([Text], DocuResult)]
traceBuilders)
                    ((([Text], DocuResult) -> [Text])
-> [([Text], DocuResult)] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map ([Text], DocuResult) -> [Text]
forall a b. (a, b) -> a
fst [([Text], DocuResult)]
metricsBuilders)
                    ((([Text], DocuResult) -> [Text])
-> [([Text], DocuResult)] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map ([Text], DocuResult) -> [Text]
forall a b. (a, b) -> a
fst [([Text], DocuResult)]
datapointBuilders)

      header2 :: Builder
header2  = Text -> Builder
fromText Text
"\n## Trace Messages\n\n"
      contentT :: Builder
contentT = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Text -> Builder
fromText Text
"\n\n")
                              ((([Text], DocuResult) -> Builder)
-> [([Text], DocuResult)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (DocuResult -> Builder
DocuResult.unpackDocu (DocuResult -> Builder)
-> (([Text], DocuResult) -> DocuResult)
-> ([Text], DocuResult)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], DocuResult) -> DocuResult
forall a b. (a, b) -> b
snd) [([Text], DocuResult)]
traceBuilders)
      header3 :: Builder
header3  = Text -> Builder
fromText Text
"\n## Metrics\n\n"
      contentM :: Builder
contentM = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Text -> Builder
fromText Text
"\n\n")
                              ((([Text], DocuResult) -> Builder)
-> [([Text], DocuResult)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (DocuResult -> Builder
DocuResult.unpackDocu (DocuResult -> Builder)
-> (([Text], DocuResult) -> DocuResult)
-> ([Text], DocuResult)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], DocuResult) -> DocuResult
forall a b. (a, b) -> b
snd) [([Text], DocuResult)]
metricsBuilders)
      header4 :: Builder
header4  = Text -> Builder
fromText Text
"\n## Datapoints\n\n"
      contentD :: Builder
contentD = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Text -> Builder
fromText Text
"\n\n")
                              ((([Text], DocuResult) -> Builder)
-> [([Text], DocuResult)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (DocuResult -> Builder
DocuResult.unpackDocu (DocuResult -> Builder)
-> (([Text], DocuResult) -> DocuResult)
-> ([Text], DocuResult)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], DocuResult) -> DocuResult
forall a b. (a, b) -> b
snd) [([Text], DocuResult)]
datapointBuilders)
      config :: Builder
config  = Text -> Builder
fromText Text
"\n## Configuration: \n```\n"
                        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TraceConfig -> Builder
forall a. ToJSON a => a -> Builder
AE.encodePrettyToTextBuilder TraceConfig
configuration
                        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"\n```\n"
      numbers :: Builder
numbers = String -> Builder
fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$  Int -> String
forall a. Show a => a -> String
show ([([Text], DocuResult)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Text], DocuResult)]
traceBuilders) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" log messages, " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                              Int -> String
forall a. Show a => a -> String
show ([([Text], DocuResult)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Text], DocuResult)]
metricsBuilders) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" metrics," String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                              Int -> String
forall a. Show a => a -> String
show ([([Text], DocuResult)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Text], DocuResult)]
datapointBuilders) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" datapoints." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n\n"

      legend :: Builder
legend  = Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Text
utf16CircledT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"- This is the root of a tracer\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                           Text
utf16CircledS Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"- This is the root of a tracer that is silent because of the current configuration\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                           Text
utf16CircledM Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"- This is the root of a tracer, that provides metrics\n\n" in
      Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
           Builder
header
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
header1
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
toc
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
header2
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
contentT
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
header3
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
contentM
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
header4
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
contentD
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
config
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
numbers
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
legend

generateTOC :: DocTracer -> [[Text]] -> [[Text]] -> [[Text]] -> Builder
generateTOC :: DocTracer -> [[Text]] -> [[Text]] -> [[Text]] -> Builder
generateTOC DocTracer {[[Text]]
[([Text], DocuResult)]
[Text]
dtTracerNames :: DocTracer -> [[Text]]
dtSilent :: DocTracer -> [[Text]]
dtNoMetrics :: DocTracer -> [[Text]]
dtBuilderList :: DocTracer -> [([Text], DocuResult)]
dtWarnings :: DocTracer -> [Text]
dtTracerNames :: [[Text]]
dtSilent :: [[Text]]
dtNoMetrics :: [[Text]]
dtBuilderList :: [([Text], DocuResult)]
dtWarnings :: [Text]
..} [[Text]]
traces [[Text]]
metrics [[Text]]
datapoints =
       Builder
generateTOCTraces
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
generateTOCMetrics
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
generateTOCDatapoints
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
generateTOCRest
  where
    tracesTree :: [Tree Text]
tracesTree = (Tree Text -> Maybe (Tree Text)) -> [Tree Text] -> [Tree Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Text] -> Tree Text -> Maybe (Tree Text)
trim []) ([[Text]] -> [Tree Text]
toForest [[Text]]
traces)
    metricsTree :: [Tree Text]
metricsTree = [[Text]] -> [Tree Text]
toForest (([Text] -> [Text]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> [Text]
splitToNS [[Text]]
metrics)
    datapointsTree :: [Tree Text]
datapointsTree = [[Text]] -> [Tree Text]
toForest [[Text]]
datapoints

    generateTOCTraces :: Builder
generateTOCTraces =
      Text -> Builder
fromText Text
"### [Trace Messages](#trace-messages)\n\n"
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Tree Text -> Builder) -> [Tree Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ([[Text]] -> Bool -> [Text] -> Tree Text -> Builder
namespaceToToc [[Text]]
traces Bool
False []) [Tree Text]
tracesTree)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"\n"
    generateTOCMetrics :: Builder
generateTOCMetrics =
      Text -> Builder
fromText Text
"### [Metrics](#metrics)\n\n"
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Tree Text -> Builder) -> [Tree Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ([[Text]] -> Bool -> [Text] -> Tree Text -> Builder
namespaceToToc (([Text] -> [Text]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> [Text]
splitToNS [[Text]]
metrics) Bool
True []) [Tree Text]
metricsTree)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"\n"
    generateTOCDatapoints :: Builder
generateTOCDatapoints =
      Text -> Builder
fromText Text
"### [Datapoints](#datapoints)\n\n"
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Tree Text -> Builder) -> [Tree Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ([[Text]] -> Bool -> [Text] -> Tree Text -> Builder
namespaceToToc [[Text]]
datapoints Bool
True []) [Tree Text]
datapointsTree)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"\n"
    generateTOCRest :: Builder
generateTOCRest =
         Text -> Builder
fromText Text
"### [Configuration](#configuration)\n\n"
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"\n"

    splitToNS :: [Text] -> [Text]
    splitToNS :: [Text] -> [Text]
splitToNS [Text
sym] = (Char -> Bool) -> Text -> [Text]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
sym
    splitToNS [Text]
other = [Text]
other

    isTracerSymbol :: [Text] -> Bool
    isTracerSymbol :: [Text] -> Bool
isTracerSymbol [Text]
tracer = [Text]
tracer [Text] -> [[Text]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Text]]
dtTracerNames

    -- Modify the given tracer tree so that the result is a tree where entries which
    -- are not tracers are removed. In case the whole tree doesn't contain a tracer, return Nothing.
    trim :: [Text] {- accumulated namespace in reverse -} -> Tree Text -> Maybe (Tree Text)
    trim :: [Text] -> Tree Text -> Maybe (Tree Text)
trim [Text]
ns (Node Text
x [Tree Text]
nested) =
      let that :: [Text]
that = [Text] -> [Text]
forall a. [a] -> [a]
reverse (Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ns)
          -- List of all nested tracers that we shall render
          nestedTrimmed :: [Tree Text]
nestedTrimmed = (Tree Text -> Maybe (Tree Text)) -> [Tree Text] -> [Tree Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Text] -> Tree Text -> Maybe (Tree Text)
trim (Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ns)) [Tree Text]
nested in
      (Tree Text -> Bool) -> Maybe (Tree Text) -> Maybe (Tree Text)
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (\Tree Text
_ -> Bool -> Bool
not ([Tree Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree Text]
nestedTrimmed) Bool -> Bool -> Bool
|| [Text] -> Bool
isTracerSymbol [Text]
that) (Tree Text -> Maybe (Tree Text)
forall a. a -> Maybe a
Just (Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
x [Tree Text]
nestedTrimmed))

    namespaceToToc ::
         [[Text]]
      -> Bool
      -> [Text] {- Accumulated namespace in reverse -}
      -> Tree Text
      -> Builder
    namespaceToToc :: [[Text]] -> Bool -> [Text] -> Tree Text -> Builder
namespaceToToc [[Text]]
allTracers Bool
skipSymbols [Text]
accns (Node Text
x [Tree Text]
nested) = Builder
text
      where
        ns :: [Text]
ns = [Text] -> [Text]
forall a. [a] -> [a]
reverse (Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
accns)

        inner :: Builder
inner = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Tree Text -> Builder) -> [Tree Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ([[Text]] -> Bool -> [Text] -> Tree Text -> Builder
namespaceToToc [[Text]]
allTracers Bool
skipSymbols (Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
accns)) [Tree Text]
nested)

        indent :: Int -> a -> a
indent Int
lvl a
txt = [a] -> a
forall a. Monoid a => [a] -> a
mconcat (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
lvl a
"\t") a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
txt

        text :: Builder
        text :: Builder
text =
          Int -> Builder -> Builder
forall {a}. (Monoid a, IsString a) => Int -> a -> a
indent ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
accns)
                 (
                      Builder
"1. "
                   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
symbolsText Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"
                   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"(#" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
link Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")\n"
                 ) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
inner

        symbolsText :: Text
        symbolsText :: Text
symbolsText = if Bool
skipSymbols then Text
"" else
          let isTracer :: Bool
isTracer  = [Text] -> [[Text]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Text]
ns [[Text]]
dtTracerNames
              isSilent :: Bool
isSilent  = [Text] -> [[Text]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Text]
ns [[Text]]
dtSilent
              isMetric :: Bool
isMetric  = [Text] -> [[Text]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [Text]
ns [[Text]]
dtNoMetrics
          in
              (if Bool
isTracer then Text
utf16CircledT else Text
"")
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
isSilent then Text
utf16CircledS else Text
"")
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
isMetric then Text
utf16CircledM else Text
"")

        -- The link to the description of the first tracer in that namespace
        link :: Builder
        link :: Builder
link = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Builder
fromText (Text -> Builder) -> (Text -> Text) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toLower) [Text]
firstTracer)

        -- The first tracer in the list of tracers that has that namespace prefix
        firstTracer :: [Text]
        firstTracer :: [Text]
firstTracer = Maybe [Text] -> [Text]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ([Text] -> Bool) -> [[Text]] -> Maybe [Text]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ([Text]
ns [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [[Text]]
allTracers


asCode :: Builder -> Builder
asCode :: Builder -> Builder
asCode Builder
b = Char -> Builder
singleton Char
'`' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'`'

accentuated :: Text -> Builder
accentuated :: Text -> Builder
accentuated Text
t = if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""
                  then Text -> Builder
fromText Text
"\n"
                  else Text -> Builder
fromText Text
"\n"
                        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText ([Text] -> Text
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
addAccent (Text -> [Text]
lines Text
t))
  where
    addAccent :: Text -> Text
    addAccent :: Text -> Text
addAccent Text
t' = if Text
t' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""
                    then Text
">"
                    else Text
"> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t'

-- this reflects the type cardano-tracer expects the metrics help texts to be serialized from:
-- simple key-value map
newtype MetricsHelp = MH (Map.Map Text Text)
        deriving [MetricsHelp] -> Value
[MetricsHelp] -> Encoding
MetricsHelp -> Bool
MetricsHelp -> Value
MetricsHelp -> Encoding
(MetricsHelp -> Value)
-> (MetricsHelp -> Encoding)
-> ([MetricsHelp] -> Value)
-> ([MetricsHelp] -> Encoding)
-> (MetricsHelp -> Bool)
-> ToJSON MetricsHelp
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: MetricsHelp -> Value
toJSON :: MetricsHelp -> Value
$ctoEncoding :: MetricsHelp -> Encoding
toEncoding :: MetricsHelp -> Encoding
$ctoJSONList :: [MetricsHelp] -> Value
toJSONList :: [MetricsHelp] -> Value
$ctoEncodingList :: [MetricsHelp] -> Encoding
toEncodingList :: [MetricsHelp] -> Encoding
$comitField :: MetricsHelp -> Bool
omitField :: MetricsHelp -> Bool
ToJSON via (Map.Map Text Text)

docuResultsToMetricsHelptext :: DocTracer -> Text
docuResultsToMetricsHelptext :: DocTracer -> Text
docuResultsToMetricsHelptext DocTracer{[([Text], DocuResult)]
dtBuilderList :: DocTracer -> [([Text], DocuResult)]
dtBuilderList :: [([Text], DocuResult)]
dtBuilderList} =
  Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
    Config -> MetricsHelp -> Builder
forall a. ToJSON a => Config -> a -> Builder
AE.encodePrettyToTextBuilder' Config
conf MetricsHelp
mh
  where
    conf :: Config
conf = Config
AE.defConfig { AE.confCompare = compare, AE.confTrailingNewline = True }
    mh :: MetricsHelp
mh = Map Text Text -> MetricsHelp
MH (Map Text Text -> MetricsHelp) -> Map Text Text -> MetricsHelp
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [(Text -> [Text] -> Text
intercalate Text
"." [Text]
ns, Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
T.empty Maybe Text
x)
        | ([Text]
ns, DocuMetric Builder
helpDescr) <- [([Text], DocuResult)]
dtBuilderList

        -- for now, just extract the helptext (if any) from the markdown paragraph:
        -- it's the line that starts with "> "
        , let xs :: [Text]
xs  = Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText Builder
helpDescr
        , let x :: Maybe Text
x   = [Maybe Text] -> Maybe Text
forall a. Monoid a => [a] -> a
mconcat ([Maybe Text] -> Maybe Text) -> [Maybe Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Maybe Text
stripPrefix Text
"> ") [Text]
xs
      ]