Generalize highlighted_roots to prune_upto for more aggressive pr…

…uning.

CHANGELOG.md

@@ -9,6 +9,7 @@
 
 - Rename `debug_html` to `debug_file`, since it now supports both HTML and Markdown. Take file name/path without a suffix.
 - Refactored PrintBox configuration, smaller footprint and allowing control over the backends.
+- Changed `highlighted_roots` to a more general `prune_upto`: prune to only the highlighted boxes up to the given depth.
 - TODO: Fixes #9: handle tuple and record patterns by automatically wrapping in an alias pattern.
 
 ## [0.9.0] -- 2024-01-18

README.md

@@ -135,7 +135,7 @@ leads to:
   9
 ```
 
-At the "top level", there is another mechanism for disabling logging: `highlighted_roots` -- see below.
+There is another mechanism for disabling logging: `prune_upto` -- see below.
 
 #### Traces in HTML as collapsible trees
 
@@ -158,8 +158,8 @@ regular expression. For example:
 ![PrintBox runtime with collapsible/foldable trees](docs/ppx_minidebug-highlight_term_169.png)
 
 To limit the highlight noise, some log entries can be excluded from propagating the highlight status
-using the `exclude_on_path` setting. To trim excessive logging while still providing all the context,
-you can set `highlighted_roots:true`, which only outputs highlighted toplevel boxes.
+using the `exclude_on_path` setting. To trim excessive logging while still providing some context,
+you can set `prune_upto` to a level greater than 0, which only outputs highlighted boxes below that level.
 
 #### `PrintBox` creating helpers with defaults: `debug` and `debug_file`
 

index.mld

@@ -84,8 +84,8 @@ regular expression in the PrintBox runtime. Paths to logs that match [highlight_
 a frame / border: around the log and around summaries on the path to the log. A corresponding setting
 `exclude_on_path` will disable highlighting on logs (summaries) this regular expression matches on,
 regardless of children. Therefore, `exclude_on_path` stops the propagation of highlights upward.
-There is also an optional flag [highlighted_roots], to only output highlighted toplevel boxes.
-This makes it simpler to trim excessive logging while still providing all the context.
+There is also an optional flag [prune_upto], to only output highlighted boxes at depths below
+the given level. This makes it simpler to trim excessive logging while providing some context.
 
 {3 Tracking control flow branches, and insufficiently annotated or anonymous functions}
 

minidebug_runtime.ml

@@ -279,7 +279,7 @@ module PrintBox (Log_to : Debug_ch) = struct
     mutable boxify_sexp_from_size : int;
     mutable highlight_terms : Re.re option;
     mutable exclude_on_path : Re.re option;
-    mutable highlighted_roots : bool;
+    mutable prune_upto : int;
     mutable values_first_mode : bool;
     mutable max_inline_sexp_size : int;
     mutable max_inline_sexp_length : int;
@@ -291,7 +291,7 @@ module PrintBox (Log_to : Debug_ch) = struct
       backend = `Text;
       boxify_sexp_from_size = -1;
       highlight_terms = None;
-      highlighted_roots = false;
+      prune_upto = 0;
       exclude_on_path = None;
       values_first_mode = false;
       max_inline_sexp_size = 20;
@@ -376,6 +376,7 @@ module PrintBox (Log_to : Debug_ch) = struct
     stack :=
       (* Design choice: exclude does not apply to its own entry -- its about propagating children. *)
       match !stack with
+      |  { highlight = false; _ } :: bs when config.prune_upto >= List.length !stack -> bs
       | ({ cond = true; highlight = hl; exclude = _; entry_id = result_id; _ } as entry)
         :: { cond; highlight; exclude; uri; path; entry_message; entry_id; body }
         :: bs3 ->
@@ -391,7 +392,6 @@ module PrintBox (Log_to : Debug_ch) = struct
           }
           :: bs3
       | { cond = false; _ } :: bs -> bs
-      | [ { highlight = false; _ } ] when config.highlighted_roots -> []
       | [ ({ cond = true; _ } as entry) ] ->
           let box = stack_to_tree entry in
           let ch = debug_ch () in
@@ -554,7 +554,7 @@ module PrintBox (Log_to : Debug_ch) = struct
 end
 
 let debug_file ?(time_tagged = false) ?max_nesting_depth ?max_num_children
-    ?split_files_after ?highlight_terms ?exclude_on_path ?(highlighted_roots = false)
+    ?split_files_after ?highlight_terms ?exclude_on_path ?(prune_upto = 0)
     ?(for_append = false) ?(boxify_sexp_from_size = 50) ?backend ?hyperlink
     ?(values_first_mode = false) filename : (module Debug_runtime_cond) =
   let filename =
@@ -571,15 +571,15 @@ let debug_file ?(time_tagged = false) ?max_nesting_depth ?max_num_children
     Option.value backend ~default:(`Markdown Debug.default_md_config);
   Debug.config.boxify_sexp_from_size <- boxify_sexp_from_size;
   Debug.config.highlight_terms <- Option.map Re.compile highlight_terms;
-  Debug.config.highlighted_roots <- highlighted_roots;
+  Debug.config.prune_upto <- prune_upto;
   Debug.config.exclude_on_path <- Option.map Re.compile exclude_on_path;
   Debug.config.values_first_mode <- values_first_mode;
   Debug.config.hyperlink <-
     (match hyperlink with None -> `No_hyperlinks | Some prefix -> `Prefix prefix);
   (module Debug)
 
 let debug ?(debug_ch = stdout) ?(time_tagged = false) ?max_nesting_depth ?max_num_children
-    ?highlight_terms ?exclude_on_path ?(highlighted_roots = false)
+    ?highlight_terms ?exclude_on_path ?(prune_upto = 0)
     ?(values_first_mode = false) () : (module Debug_runtime_cond) =
   let module Debug = PrintBox (struct
     let refresh_ch () = false
@@ -590,7 +590,7 @@ let debug ?(debug_ch = stdout) ?(time_tagged = false) ?max_nesting_depth ?max_nu
     let split_files_after = None
   end) in
   Debug.config.highlight_terms <- Option.map Re.compile highlight_terms;
-  Debug.config.highlighted_roots <- highlighted_roots;
+  Debug.config.prune_upto <- prune_upto;
   Debug.config.exclude_on_path <- Option.map Re.compile exclude_on_path;
   Debug.config.values_first_mode <- values_first_mode;
   (module Debug)

minidebug_runtime.mli

@@ -109,9 +109,10 @@ module PrintBox : functor (_ : Debug_ch) -> sig
     mutable exclude_on_path : Re.re option;
         (** Does not propagate the highlight status from child logs through log headers matching
             the given regular expression. *)
-    mutable highlighted_roots : bool;
-        (** If set to true, only ouptputs highlighted toplevel boxes. This makes it simpler to trim
-          excessive logging while still providing all the context. Defaults to [false]. *)
+    mutable prune_upto : int;
+        (** At depths lower than [prune_upto] (or equal if counting from 1) only ouptputs highlighted boxes.
+            This makes it simpler to trim excessive logging while still providing some context.
+            Defaults to [0] -- no pruning. *)
     mutable values_first_mode : bool;
         (** If set to true, does not put the source code location of a computation as a header of its subtree.
             Rather, puts the result of the computation as the header of a computation subtree,
@@ -134,7 +135,7 @@ val debug_file :
   ?split_files_after:int ->
   ?highlight_terms:Re.t ->
   ?exclude_on_path:Re.t ->
-  ?highlighted_roots:bool ->
+  ?prune_upto:int ->
   ?for_append:bool ->
   ?boxify_sexp_from_size:int ->
   ?backend:[ `Text | `Html of PrintBox_html.Config.t | `Markdown of PrintBox_md.Config.t ] ->
@@ -158,7 +159,7 @@ val debug :
   ?max_num_children:int ->
   ?highlight_terms:Re.t ->
   ?exclude_on_path:Re.t ->
-  ?highlighted_roots:bool ->
+  ?prune_upto:int ->
   ?values_first_mode:bool ->
   unit ->
   (module Debug_runtime_cond)