trace-dispatcher: Review fixes1

Author: jutaro

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

@@ -25,11 +25,10 @@ module Cardano.Logging.DocuGenerator (
 ) where
 
 import           Cardano.Logging.ConfigurationParser ()
-import           Cardano.Logging.DocuGenerator.RoseTree
+import           Cardano.Logging.DocuGenerator.Tree
 import           Cardano.Logging.DocuResult (DocuResult (..))
 import qualified Cardano.Logging.DocuResult as DocuResult
 import           Cardano.Logging.Types
-import           Cardano.Logging.Utils (indent)
 
 import           Prelude hiding (lines, unlines)
 
@@ -487,9 +486,9 @@ generateTOC DocTracer {..} traces metrics datapoints =
     <> generateTOCDatapoints
     <> generateTOCRest
   where
-    tracesTree = mapMaybe (trim []) (toTree traces)
-    metricsTree = toTree (fmap splitToNS metrics)
-    datapointsTree = toTree datapoints
+    tracesTree = mapMaybe (trim []) (toForest traces)
+    metricsTree = toForest (fmap splitToNS metrics)
+    datapointsTree = toForest datapoints
 
     generateTOCTraces =
       fromText "### [Trace Messages](#trace-messages)\n\n"
@@ -516,25 +515,27 @@ generateTOC DocTracer {..} traces metrics datapoints =
 
     -- 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 -} -> RoseTree -> Maybe RoseTree
-    trim ns (RoseTree x nested) =
+    trim :: [Text] {- accumulated namespace in reverse -} -> Tree Text -> Maybe (Tree Text)
+    trim ns (Node x nested) =
       let that = reverse (x : ns)
           -- List of all nested tracers that we shall render
           nestedTrimmed = mapMaybe (trim (x : ns)) nested in
-      mfilter (\_ -> not (null nestedTrimmed) || isTracerSymbol that) (Just (RoseTree x nestedTrimmed))
+      mfilter (\_ -> not (null nestedTrimmed) || isTracerSymbol that) (Just (Node x nestedTrimmed))
 
     namespaceToToc ::
          [[Text]]
       -> Bool
       -> [Text] {- Accumulated namespace in reverse -}
-      -> RoseTree
+      -> Tree Text
       -> Builder
-    namespaceToToc allTracers skipSymbols accns (RoseTree x nested) = text
+    namespaceToToc allTracers skipSymbols accns (Node x nested) = text
       where
         ns = reverse (x : accns)
 
         inner = mconcat (map (namespaceToToc allTracers skipSymbols (x : accns)) nested)
 
+        indent lvl txt = mconcat (replicate lvl "\t") <> txt
+
         text :: Builder
         text =
           indent (length accns)

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

@@ -0,0 +1,40 @@
+module Cardano.Logging.DocuGenerator.Tree (Tree (..), foldTree, printTree, printList, toForest) where
+
+import           Data.Function (on)
+import           Data.List (groupBy, intersperse)
+import           Data.Text.Internal (Text)
+import           Data.Text.Internal.Builder (Builder)
+import           Data.Tree (Forest, Tree (..), foldTree, unfoldForest)
+
+-- T ::= ∙ x
+--     |
+--       ∙ x
+--          T
+--          T
+--         ...
+--          T
+--
+-- Example:
+--
+--  ∙ BlockFetch
+--    ∙ Client
+--      ∙ AcknowledgedFetchRequest
+--      ∙ AddedFetchRequest
+--      ∙ ClientMetrics
+--    ∙ Decision
+--    ∙ Remote
+printTree :: Tree Text -> Text
+printTree =
+  foldTree (\x -> mconcat . intersperse "\n" . ("∙ " <> x :) . map ("\t" <>))
+
+printList :: (a -> Builder) -> [a] -> Builder
+printList fmt = mconcat . intersperse "\n" . map fmt
+
+-- Convert a list of namespaces to a tree representation
+toForest :: [[Text]] -> Forest Text
+toForest = unfoldForest build . groupByHead
+ where
+  groupByHead = groupBy (on (==) head)
+
+  build :: [[Text]] -> (Text, [[[Text]]])
+  build group@(representative : _) = (head representative, (groupByHead . filter (not . null) . map tail) group)

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

@@ -1,5 +1,12 @@
-module Cardano.Logging.DocuResult (DocuResult(..), unpackDocu, isTracer, isMetric, isDatapoint) where
-import Data.Text.Internal.Builder
+module Cardano.Logging.DocuResult
+  (DocuResult(..)
+  , unpackDocu
+  , isTracer
+  , isMetric
+  , isDatapoint)
+  where
+
+import           Data.Text.Internal.Builder
 
 data DocuResult =
   DocuTracer Builder

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

@@ -1,15 +1,15 @@
-module Cardano.Logging.Utils (module Cardano.Logging.Utils)
-where
+module Cardano.Logging.Utils
+       ( module Cardano.Logging.Utils )
+       where
 
 import           Cardano.Logging.Types (HowToConnect)
 
 import           Control.Concurrent (threadDelay)
 import           Control.Exception (SomeAsyncException (..), fromException, tryJust)
 import           Control.Tracer (stdoutTracer, traceWith)
 import qualified Data.Text as T
-import           Data.Text.Internal.Builder (Builder)
 import qualified Data.Text.Lazy as TL (toStrict)
-import qualified Data.Text.Lazy.Builder as T (fromText, toLazyText)
+import qualified Data.Text.Lazy.Builder as T (toLazyText)
 import qualified Data.Text.Lazy.Builder.Int as T
 import qualified Data.Text.Lazy.Builder.RealFloat as T (realFloat)
 import           GHC.Conc (labelThread, myThreadId)
@@ -28,7 +28,7 @@ runInLoop action howToConnect prevDelayInSecs maxReconnectDelay =
  where
   excludeAsyncExceptions e =
     case fromException e of
-      Just SomeAsyncException{} -> Nothing
+      Just SomeAsyncException {} -> Nothing
       _ -> Just e
 
   logTrace = traceWith stdoutTracer
@@ -38,24 +38,16 @@ runInLoop action howToConnect prevDelayInSecs maxReconnectDelay =
 
 -- | Convenience function for a Show instance to be converted to text immediately
 {-# INLINE showT #-}
-showT :: (Show a) => a -> T.Text
+showT :: Show a => a -> T.Text
 showT = T.pack . show
 
 {-# INLINE showTHex #-}
-showTHex :: (Integral a) => a -> T.Text
+showTHex :: Integral a => a -> T.Text
 showTHex = TL.toStrict . T.toLazyText . T.hexadecimal
 
 {-# INLINE showTReal #-}
-showTReal :: (RealFloat a) => a -> T.Text
+showTReal :: RealFloat a => a -> T.Text
 showTReal = TL.toStrict . T.toLazyText . T.realFloat
 
 threadLabelMe :: String -> IO ()
 threadLabelMe label = myThreadId >>= flip labelThread label
-
-indent :: Int -> Builder -> Builder
-indent lvl txt
-  | lvl == 0 = txt
-  | lvl /= 0 = T.fromText tab <> indent (lvl - 1) txt
- where
-  tab :: T.Text
-  tab = "\t"

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

@@ -46,7 +46,7 @@ library
                       Cardano.Logging.ConfigurationParser
                       Cardano.Logging.Consistency
                       Cardano.Logging.DocuGenerator
-                      Cardano.Logging.DocuGenerator.RoseTree
+                      Cardano.Logging.DocuGenerator.Tree
                       Cardano.Logging.DocuResult
                       Cardano.Logging.Formatter
                       Cardano.Logging.Forwarding