generate machine-readable metrics docs

cardano-node/src/Cardano/Node/Tracing/Documentation.hs

@@ -95,7 +95,8 @@ import           Ouroboros.Network.Subscription.Worker (SubscriptionTrace (..))
 import           Ouroboros.Network.TxSubmission.Inbound (TraceTxSubmissionInbound)
 import           Ouroboros.Network.TxSubmission.Outbound (TraceTxSubmissionOutbound)
 
-import           Control.Exception (SomeException)
+import           Control.Exception (SomeException, bracket)
+import           Control.Monad (forM_)
 import           Data.Aeson.Types (ToJSON)
 import           Data.Proxy (Proxy (..))
 import qualified Data.Text.IO as T
@@ -110,6 +111,7 @@ data TraceDocumentationCmd
   = TraceDocumentationCmd
     { tdcConfigFile :: FilePath
     , tdcOutput     :: FilePath
+    , tdMetricsHelp :: Maybe FilePath
     }
 
 parseTraceDocumentationCmd :: Opt.Parser TraceDocumentationCmd
@@ -124,14 +126,20 @@ parseTraceDocumentationCmd =
          (TraceDocumentationCmd
            <$> Opt.strOption
                ( Opt.long "config"
-                 <> Opt.metavar "NODE-CONFIGURATION"
+                 <> Opt.metavar "FILE"
                  <> Opt.help "Configuration file for the cardano-node"
                )
            <*> Opt.strOption
                ( Opt.long "output-file"
                  <> Opt.metavar "FILE"
-                 <> Opt.help "Generated documentation output file"
+                 <> Opt.help "Generated documentation output file (Markdown)"
                )
+           <*> Opt.optional (Opt.strOption
+                ( Opt.long "output-metric-help"
+                  <> Opt.metavar "FILE"
+                  <> Opt.help "Metrics helptext file for cardano-tracer (JSON)"
+                )
+              )
            Opt.<**> Opt.helper)
        $ mconcat [ Opt.progDesc "Generate the trace documentation" ]
      ]
@@ -147,18 +155,19 @@ runTraceDocumentationCmd
   :: TraceDocumentationCmd
   -> IO ()
 runTraceDocumentationCmd TraceDocumentationCmd{..} = do
-  docTracers tdcConfigFile tdcOutput
+  docTracers tdcConfigFile tdcOutput tdMetricsHelp
 
 -- Have to repeat the construction of the tracers here,
 -- as the tracers are behind old tracer interface after construction in mkDispatchTracers.
 -- Can be changed, when old tracers have gone
 docTracers ::
      FilePath
   -> FilePath
+  -> Maybe FilePath
   -> IO ()
-docTracers configFileName outputFileName = do
+docTracers configFileName outputFileName mbMetricsHelpFilename = do
     (bl, trConfig) <- docTracersFirstPhase (Just configFileName)
-    docTracersSecondPhase outputFileName trConfig bl
+    docTracersSecondPhase outputFileName mbMetricsHelpFilename trConfig bl
 
 
 -- Have to repeat the construction of the tracers here,
@@ -761,12 +770,18 @@ docTracersFirstPhase condConfigFileName = do
 
 docTracersSecondPhase ::
      FilePath
+  -> Maybe FilePath
   -> TraceConfig
   -> DocTracer
   -> IO ()
-docTracersSecondPhase outputFileName trConfig bl = do
-    content <- docuResultsToText bl trConfig
-    handle <- openFile outputFileName WriteMode
-    hSetEncoding handle utf8
-    T.hPutStr handle content
-    hClose handle
+docTracersSecondPhase outputFileName mbMetricsHelpFilename trConfig bl = do
+    docuResultsToText bl trConfig
+      >>= doWrite outputFileName
+    forM_ mbMetricsHelpFilename $ \f ->
+       doWrite f (docuResultsToMetricsHelptext bl)
+  where
+    doWrite outfile text =
+      bracket
+        (openFile outfile WriteMode)
+        hClose
+        (\handle -> hSetEncoding handle utf8 >> T.hPutStr handle text)

trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -10,6 +12,7 @@ module Cardano.Logging.DocuGenerator (
     documentTracer
   , documentTracer'
   , docuResultsToText
+  , docuResultsToMetricsHelptext
   -- Callbacks
   , docTracer
   , docTracerDatapoint
@@ -30,12 +33,14 @@ import           Prelude hiding (lines, unlines)
 
 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 (groupBy, intersperse, nub, sortBy)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (fromMaybe, mapMaybe)
-import           Data.Text (Text, lines, pack, split, toLower, unlines)
+import           Data.Text as T (Text, intercalate, lines, pack, split, stripPrefix, toLower,
+                   unlines)
 import           Data.Text.Internal.Builder (toLazyText)
 import           Data.Text.Lazy (toStrict)
 import           Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton)
@@ -618,4 +623,23 @@ accentuated t = if t == ""
                     then ">"
                     else "> " <> t'
 
+-- this reflects the type cardano-tracer expects the metrics help texts to be serialized of:
+-- simple key-value map
+newtype MetricsHelp = MH (Map.Map Text Text)
+        deriving ToJSON via (Map.Map Text Text)
 
+docuResultsToMetricsHelptext :: DocTracer -> Text
+docuResultsToMetricsHelptext DocTracer{dtBuilderList} =
+  toStrict $ toLazyText $
+    AE.encodePrettyToTextBuilder' conf mh
+  where
+    conf = AE.defConfig { AE.confCompare = compare, AE.confTrailingNewline = True }
+    mh = MH $ Map.fromList
+      [(intercalate "." ns, fromMaybe "" x)
+        | (ns, DocuMetric helpDescr) <- dtBuilderList
+
+        -- for now, just extract the helptext (if any) from the markdown paragraph:
+        -- it's the line that starts with "> "
+        , let xs  = T.lines $ toStrict $ toLazyText helpDescr
+        , let x   = mconcat $ map (stripPrefix "> ") xs
+      ]