From 7eb7ae123e69a4d05647a099dea2574ebb606be6 Mon Sep 17 00:00:00 2001 From: Lukasz Stafiniak Date: Sat, 20 Jan 2024 22:55:01 +0100 Subject: [PATCH] PrintBox Markdown backend, yay! --- CHANGELOG.md | 15 ++- README.md | 6 +- dune | 2 +- dune-project | 1 + index.mld | 8 +- minidebug_runtime.ml | 24 ++-- minidebug_runtime.mli | 18 +-- ppx_minidebug.opam | 1 + test/debugger_sexp_md.expected.md | 188 ++++++++++++++++++++++++++++++ test/dune | 16 +++ test/test_debug_html.ml | 2 +- test/test_debug_md.ml | 42 +++++++ 12 files changed, 296 insertions(+), 27 deletions(-) create mode 100644 test/debugger_sexp_md.expected.md create mode 100644 test/test_debug_md.ml diff --git a/CHANGELOG.md b/CHANGELOG.md index 1ce956b..5f63ce4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,19 @@ +## [1.0.0] -- current + +### Added + +- PrintBox Markdown backend. + +### Changed + +- Rename `debug_html` to `debug_file`, since it now supports both HTML and Markdown. Take file name/path without a suffix. +- TODO: Fixes #9: handle tuple and record patterns by automatically wrapping in an alias pattern. + ## [0.9.0] -- 2024-01-18 -## Added +### Added -- Optionally output source locations as hyperlinks -- requires an address prefix. +- Optionally output source locations as hyperlinks -- requires a (potentially empty) address prefix. - A setting `values_first_mode` for the PrintBox runtime, to put results of computation as headers, and push paths beneath headers (friendly for HTML-backed foldable output). ### Changed diff --git a/README.md b/README.md index ec612b5..1702b1a 100644 --- a/README.md +++ b/README.md @@ -161,12 +161,12 @@ To limit the highlight noise, some log entries can be excluded from propagating 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. -#### `PrintBox` creating helpers with defaults: `debug` and `debug_html` +#### `PrintBox` creating helpers with defaults: `debug` and `debug_file` The configuration for the above example is more concisely just: ```ocaml -module Debug_runtime = (val Minidebug_runtime.debug_html ~highlight_terms:(Re.str "169") "debug.html") +module Debug_runtime = (val Minidebug_runtime.debug_file ~highlight_terms:(Re.str "169") "debug") ``` Similarly, `debug` returns a `PrintBox` module, which by default logs to `stdout`: @@ -180,7 +180,7 @@ module Debug_runtime = (val Minidebug_runtime.debug ()) The HTML output supports emitting file locations as hyperlinks. For example: ```ocaml -module Debug_runtime = (val Minidebug_runtime.debug_html ~hyperlink:"" "debug.html") +module Debug_runtime = (val Minidebug_runtime.debug_file ~hyperlink:"" "debug") ``` where `~hyperlink` is the prefix to let you tune the file path and select a browsing option. For illustration, diff --git a/dune b/dune index db61331..25349ff 100644 --- a/dune +++ b/dune @@ -11,7 +11,7 @@ (public_name ppx_minidebug.runtime) (name minidebug_runtime) (modules minidebug_runtime) - (libraries printbox printbox-text printbox-html ptime.clock.os re sexplib0)) + (libraries printbox printbox-text printbox-html printbox-md ptime.clock.os re sexplib0)) (documentation (package ppx_minidebug) diff --git a/dune-project b/dune-project index b37ab66..de7bc46 100644 --- a/dune-project +++ b/dune-project @@ -35,6 +35,7 @@ printbox-text (printbox-html (>= 0.8)) + printbox-md ptime re sexplib0 diff --git a/index.mld b/index.mld index 7c53292..0c7c7d0 100644 --- a/index.mld +++ b/index.mld @@ -58,9 +58,9 @@ let () = Debug_runtime.html_config := `Html let () = Debug_runtime.boxify_sexp_from_size := 50 ]} -[debug_html] is a configurable shorthand for the above setup: +[debug_file] is a configurable shorthand for the above setup: {[ -module Debug_runtime = (val Minidebug_runtime.debug_html "debug.html") +module Debug_runtime = (val Minidebug_runtime.debug_file "debug") ]} Similarly, [debug] and [debug_flushing] are configurable shorthands that default to logging to [stdout] (but accept a `~debug_ch` argument). @@ -72,7 +72,7 @@ The first raises a failure when the nesting of logs exceeds the given threshold, a failure when the number of log entries under a single parent exceeds the threshold. E.g.: {[ module Debug_runtime = - (val Minidebug_runtime.debug_html ~max_nesting_depth:20 ~max_num_children:50 "debug.html") + (val Minidebug_runtime.debug_file ~max_nesting_depth:20 ~max_num_children:50 "debug") ]} The cutoff points are indicated in the logs. @@ -169,7 +169,7 @@ BEGIN DEBUG SESSION The PrintBox HTML output supports emitting file locations as hyperlinks. For example: {[ -module Debug_runtime = (val Minidebug_runtime.debug_html ~hyperlink:"" "debug.html") +module Debug_runtime = (val Minidebug_runtime.debug_file ~hyperlink:"" "debug") ]} where [~hyperlink] is the prefix to let you tune the file path and select a browsing option. For illustration, diff --git a/minidebug_runtime.ml b/minidebug_runtime.ml index 32bc861..2030f63 100644 --- a/minidebug_runtime.ml +++ b/minidebug_runtime.ml @@ -249,7 +249,7 @@ module PrintBox (Log_to : Debug_ch) = struct let hyperlink_path ~uri ~inner = match !html_config with - | `Hyperlink prefix -> B.link ~uri:(prefix ^ uri) inner + | `Hyperlink prefix | `Hyperlink_md prefix -> B.link ~uri:(prefix ^ uri) inner | _ -> inner let stack_next ~entry_id (hl, b) = @@ -326,9 +326,12 @@ module PrintBox (Log_to : Debug_ch) = struct let box = stack_to_tree entry in (match !html_config with | `Text -> PrintBox_text.output debug_ch box - | _ -> + | `Html | `Hyperlink _ -> output_string debug_ch - @@ PrintBox_html.(to_string ~config:Config.(tree_summary true default) box)); + @@ PrintBox_html.(to_string ~config:Config.(tree_summary true default) box) + | `Markdown | `Hyperlink_md _ -> + output_string debug_ch + @@ PrintBox_md.(to_string ~tables:`Html ~foldable_trees:true box)); output_string debug_ch "\n"; [] (* CFormat.fprintf ppf "@\n%!"; [] *) @@ -338,7 +341,7 @@ module PrintBox (Log_to : Debug_ch) = struct ~entry_id ~brief = let uri = match !html_config with - | `Hyperlink prefix + | (`Hyperlink prefix | `Hyperlink_md prefix) when String.length prefix = 0 || Char.equal prefix.[0] '.' || String.equal (String.sub prefix 0 5) "http:" @@ -481,16 +484,21 @@ module PrintBox (Log_to : Debug_ch) = struct !global_id end -let debug_html ?(time_tagged = false) ?max_nesting_depth ?max_num_children +let debug_file ?(time_tagged = false) ?max_nesting_depth ?max_num_children ?highlight_terms ?exclude_on_path ?(highlighted_roots = false) ?(for_append = false) - ?(boxify_sexp_from_size = 50) ?hyperlink ?(values_first_mode = false) filename : - (module Debug_runtime_cond) = + ?(boxify_sexp_from_size = 50) ?(markdown = false) ?hyperlink + ?(values_first_mode = false) filename : (module Debug_runtime_cond) = + let filename = if markdown then filename ^ ".md" else filename ^ ".html" in let module Debug = PrintBox ((val debug_ch ~time_tagged ~for_append ?max_nesting_depth ?max_num_children filename)) in (Debug.html_config := - match hyperlink with None -> `Html | Some prefix -> `Hyperlink prefix); + match (hyperlink, markdown) with + | None, false -> `Html + | None, true -> `Markdown + | Some prefix, false -> `Hyperlink prefix + | Some prefix, true -> `Hyperlink_md prefix); Debug.boxify_sexp_from_size := boxify_sexp_from_size; Debug.highlight_terms := Option.map Re.compile highlight_terms; Debug.highlighted_roots := highlighted_roots; diff --git a/minidebug_runtime.mli b/minidebug_runtime.mli index 225531a..1823fa4 100644 --- a/minidebug_runtime.mli +++ b/minidebug_runtime.mli @@ -78,16 +78,17 @@ end module PrintBox : functor (_ : Debug_ch) -> sig include Debug_runtime_cond - val html_config : [ `Text | `Html | `Hyperlink of string ] ref - (** If the content is [`Text], logs are generated as monospaced text; for other settings as html. - If the content is [`Hyperlink prefix], code pointers are rendered as hyperlinks. + val html_config : [ `Text | `Html | `Markdown | `Hyperlink of string | `Hyperlink_md of string ] ref + (** If the content is [`Text], logs are generated as monospaced text; for other settings as html + or markdown. If the content is [`Hyperlink prefix] or [`Hyperlink_md prefix], code pointers + are rendered as hyperlinks. When [prefix] is either empty, starts with a dot, or starts with ["http:"] or ["https:"], the link address has the form [sprintf "%s#L%d" fname start_lnum], allowing browsing in HTML directly. Otherwise, it has the form [sprintf "%s:%d:%d" fname start_lnum (start_colnum + 1)], intended for editor-specific prefixes such as ["vscode://file/"]. Note that rendering a link on a node will make the node non-foldable, therefore it is best - to combine [`Hyperlink prefix] with [values_first_mode]. *) + to combine [`Hyperlink prefix] and [`Hyperlink_md prefix] with [values_first_mode]. *) val boxify_sexp_from_size : int ref (** If positive, [Sexp.t]-based logs with this many or more atoms are converted to print-boxes @@ -118,7 +119,7 @@ module PrintBox : functor (_ : Debug_ch) -> sig (** Maximal length (in characters/bytes) up to which a sexp value can be inlined during "boxification". *) end -val debug_html : +val debug_file : ?time_tagged:bool -> ?max_nesting_depth:int -> ?max_num_children:int -> @@ -127,13 +128,14 @@ val debug_html : ?highlighted_roots:bool -> ?for_append:bool -> ?boxify_sexp_from_size:int -> + ?markdown:bool -> ?hyperlink:string -> ?values_first_mode:bool -> string -> (module Debug_runtime_cond) -(** Creates a PrintBox-based debug runtime configured to output html to a file with the given name. - By default the logging will not be time tagged and the file will be created or erased - by this function. The default [boxify_sexp_from_size] value is 50. +(** Creates a PrintBox-based debug runtime configured to output html or markdown to a file with + the given name suffixed with [".html"] resp. [".md"]. By default the logging will not be time tagged + and the file will be created or erased by this function. The default [boxify_sexp_from_size] value is 50. By default {!PrintBox.html_config} will be set to [`Html], unless [~hyperlink] is passed, then [html_config := `Hyperlink hyperlink]. See {!PrintBox.html_config} for details. *) diff --git a/ppx_minidebug.opam b/ppx_minidebug.opam index 1fe8634..72936d3 100644 --- a/ppx_minidebug.opam +++ b/ppx_minidebug.opam @@ -20,6 +20,7 @@ depends: [ "printbox" {>= "0.7"} "printbox-text" "printbox-html" {>= "0.8"} + "printbox-md" "ptime" "re" "sexplib0" diff --git a/test/debugger_sexp_md.expected.md b/test/debugger_sexp_md.expected.md new file mode 100644 index 0000000..673d654 --- /dev/null +++ b/test/debugger_sexp_md.expected.md @@ -0,0 +1,188 @@ + +BEGIN DEBUG SESSION + +HTML CONFIG: values_first_mode=true hyperlink=../ + +
`foo = (7 8 16)` + +- ["test/test_debug_md.ml":7:19-9:17](../test/test_debug_md.ml#L7) +- `x = 7` +-
`y = 8` + + - ["test/test_debug_md.ml":8:6](../test/test_debug_md.ml#L8) +
+
+ +
`bar = 336` + +- ["test/test_debug_md.ml":15:19-17:14](../test/test_debug_md.ml#L15) +- `x = ((first 7) (second 42))` +-
`y = 8` + + - ["test/test_debug_md.ml":16:6](../test/test_debug_md.ml#L16) +
+
+ +
`baz = 359` + +- ["test/test_debug_md.ml":21:19-24:28](../test/test_debug_md.ml#L21) +- `x = ((first 7) (second 42))` +-
`_yz = (8 3)` + + - ["test/test_debug_md.ml":22:17](../test/test_debug_md.ml#L22) +
+-
`_uw = (7 13)` + + - ["test/test_debug_md.ml":23:17](../test/test_debug_md.ml#L23) +
+
+ +
`lab = (7 8 16)` + +- ["test/test_debug_md.ml":28:19-30:17](../test/test_debug_md.ml#L28) +- `x = 7` +-
`y = 8` + + - ["test/test_debug_md.ml":29:6](../test/test_debug_md.ml#L29) +
+
+ +
`loop = 36` + +- ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) +- `depth = 0` +- `x = ((first 7) (second 42))` +-
`y = 24` + + - ["test/test_debug_md.ml":38:8](../test/test_debug_md.ml#L38) + -
`loop = 24` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 1` + - `x = ((first 41) (second 9))` + -
`y = 25` + + - ["test/test_debug_md.ml":38:8](../test/test_debug_md.ml#L38) + -
`loop = 25` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 2` + - `x = ((first 8) (second 43))` + -
`loop = 25` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 3` + - `x = ((first 44) (second 4))` + -
`loop = 25` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 4` + - `x = ((first 5) (second 22))` + -
`loop = 25` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 5` + - `x = ((first 23) (second 2))` +
+
+
+
+
+ -
`z = 17` + + - ["test/test_debug_md.ml":39:8](../test/test_debug_md.ml#L39) + -
`loop = 17` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 2` + - `x = ((first 10) (second 25))` + -
`loop = 17` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 3` + - `x = ((first 26) (second 5))` + -
`loop = 17` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 4` + - `x = ((first 6) (second 13))` + -
`loop = 17` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 5` + - `x = ((first 14) (second 3))` +
+
+
+
+
+
+
+-
`z = 29` + + - ["test/test_debug_md.ml":39:8](../test/test_debug_md.ml#L39) + -
`loop = 29` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 1` + - `x = ((first 43) (second 24))` + -
`y = 30` + + - ["test/test_debug_md.ml":38:8](../test/test_debug_md.ml#L38) + -
`loop = 30` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 2` + - `x = ((first 23) (second 45))` + -
`loop = 30` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 3` + - `x = ((first 46) (second 11))` + -
`loop = 30` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 4` + - `x = ((first 12) (second 23))` + -
`loop = 30` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 5` + - `x = ((first 24) (second 6))` +
+
+
+
+
+ -
`z = 22` + + - ["test/test_debug_md.ml":39:8](../test/test_debug_md.ml#L39) + -
`loop = 22` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 2` + - `x = ((first 25) (second 30))` + -
`loop = 22` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 3` + - `x = ((first 31) (second 12))` + -
`loop = 22` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 4` + - `x = ((first 13) (second 15))` + -
`loop = 22` + + - ["test/test_debug_md.ml":34:24-40:9](../test/test_debug_md.ml#L34) + - `depth = 5` + - `x = ((first 16) (second 6))` +
+
+
+
+
+
+
+
+ diff --git a/test/dune b/test/dune index 5e48757..21f57de 100644 --- a/test/dune +++ b/test/dune @@ -99,14 +99,30 @@ (preprocess (pps ppx_minidebug ppx_sexp_conv))) +(executable + (name test_debug_md) + (modules test_debug_md) + (libraries sexplib0 minidebug_runtime) + (modes exe) + (preprocess + (pps ppx_minidebug ppx_sexp_conv))) + (rule (target debugger_sexp_html.html) (action (run %{dep:test_debug_html.exe}))) +(rule + (target debugger_sexp_md.md) + (action (run %{dep:test_debug_md.exe}))) + (rule (alias runtest) (action (diff debugger_sexp_html.expected.html debugger_sexp_html.html))) +(rule + (alias runtest) + (action (diff debugger_sexp_md.expected.md debugger_sexp_md.md))) + (library (name test_inline_tests) (inline_tests) diff --git a/test/test_debug_html.ml b/test/test_debug_html.ml index dbb751d..14bcd7a 100644 --- a/test/test_debug_html.ml +++ b/test/test_debug_html.ml @@ -1,7 +1,7 @@ open Sexplib0.Sexp_conv module Debug_runtime = - (val Minidebug_runtime.debug_html ~hyperlink:"../" "debugger_sexp_html.html") + (val Minidebug_runtime.debug_file ~hyperlink:"../" "debugger_sexp_html") let%debug_sexp foo (x : int) : int list = let y : int = x + 1 in diff --git a/test/test_debug_md.ml b/test/test_debug_md.ml new file mode 100644 index 0000000..f93b250 --- /dev/null +++ b/test/test_debug_md.ml @@ -0,0 +1,42 @@ +open Sexplib0.Sexp_conv + +module Debug_runtime = + (val Minidebug_runtime.debug_file ~hyperlink:"../" ~markdown:true + ~values_first_mode:true "debugger_sexp_md") + +let%debug_sexp foo (x : int) : int list = + let y : int = x + 1 in + [ x; y; 2 * y ] + +let () = ignore @@ List.hd @@ foo 7 + +type t = { first : int; second : int } [@@deriving sexp] + +let%debug_sexp bar (x : t) : int = + let y : int = x.first + 1 in + x.second * y + +let () = ignore @@ bar { first = 7; second = 42 } + +let%debug_sexp baz (x : t) : int = + let ((y, z) as _yz) : int * int = (x.first + 1, 3) in + let ((u, w) as _uw) : int * int = (7, 13) in + (x.second * y) + z + u + w + +let () = ignore @@ baz { first = 7; second = 42 } + +let%debug_sexp lab ~(x : int) : int list = + let y : int = x + 1 in + [ x; y; 2 * y ] + +let () = ignore @@ List.hd @@ lab ~x:7 + +let%debug_sexp rec loop (depth : int) (x : t) : int = + if depth > 4 then x.first + x.second + else if depth > 1 then loop (depth + 1) { first = x.second + 1; second = x.first / 2 } + else + let y : int = loop (depth + 1) { first = x.second - 1; second = x.first + 2 } in + let z : int = loop (depth + 1) { first = x.second + 1; second = y } in + z + 7 + +let () = ignore @@ loop 0 { first = 7; second = 42 }