Experimental command to format code blocks embedded in docstrings (#7598)

* add experimental command to format code blocks embedded in docstrings

* normalize whitespace better

* fix offset lines calculation

* fix tests

* format Stdlib_Result.resi with the new docstrings formatter

* just output the filename without the full path for now

* fix

* disable color in docstring format tests since it breaks in different environments in CI

* better approach than a new env variable

* more tweaks to not make more changes to docstrings than needed

* do not edit anything if we didnt have any code blocks

* use cmarkit for transforming codeblocks

* add to opam file

* add to dune-project

* make markdown code block formatter work on markdown files as well

* restructure args

* refactor

* add transform for assertEqual -> == in code blocks

* change printer to make width optional

* explicit cmarkit

* add note about --transform-assert-equal

* support more rescript lang tags

* support resi code blocks as well

* add missing help text

* changelog

Author: zth

CHANGELOG.md

@@ -12,6 +12,10 @@
 
 # 12.0.0-beta.1 (Unreleased)
 
+#### :rocket: New Feature
+
+- Add experimental command to `rescript-tools` for formatting all ReScript code blocks in markdown. Either in a markdown file directly, or inside of docstrings in ReScript code. https://github.com/rescript-lang/rescript/pull/7598
+
 # 12.0.0-alpha.15
 
 #### :boom: Breaking Change

analysis/src/Commands.ml

@@ -282,17 +282,13 @@ let format ~path =
         ~filename:path
     in
     if List.length diagnostics > 0 then ""
-    else
-      Res_printer.print_implementation
-        ~width:Res_multi_printer.default_print_width ~comments structure
+    else Res_printer.print_implementation ~comments structure
   else if Filename.check_suffix path ".resi" then
     let {Res_driver.parsetree = signature; comments; diagnostics} =
       Res_driver.parsing_engine.parse_interface ~for_printer:true ~filename:path
     in
     if List.length diagnostics > 0 then ""
-    else
-      Res_printer.print_interface ~width:Res_multi_printer.default_print_width
-        ~comments signature
+    else Res_printer.print_interface ~comments signature
   else ""
 
 let diagnosticSyntax ~path =

analysis/src/CreateInterface.ml

@@ -102,7 +102,7 @@ let printSignature ~extractor ~signature =
   Printtyp.reset_names ();
   let sigItemToString (item : Outcometree.out_sig_item) =
     item |> Res_outcome_printer.print_out_sig_item_doc
-    |> Res_doc.to_string ~width:Res_multi_printer.default_print_width
+    |> Res_doc.to_string ~width:Res_printer.default_print_width
   in
 
   let genSigStrForInlineAttr lines attributes id vd =

analysis/src/Xform.ml

@@ -855,7 +855,6 @@ let parseImplementation ~filename =
     let structure = [Ast_helper.Str.eval ~loc:expr.pexp_loc expr] in
     structure
     |> Res_printer.print_implementation
-         ~width:Res_multi_printer.default_print_width
          ~comments:(comments |> filterComments ~loc:expr.pexp_loc)
     |> Utils.indent range.start.character
   in
@@ -864,14 +863,12 @@ let parseImplementation ~filename =
     let structure = [item] in
     structure
     |> Res_printer.print_implementation
-         ~width:Res_multi_printer.default_print_width
          ~comments:(comments |> filterComments ~loc:item.pstr_loc)
     |> Utils.indent range.start.character
   in
   let printStandaloneStructure ~(loc : Location.t) structure =
     structure
     |> Res_printer.print_implementation
-         ~width:Res_multi_printer.default_print_width
          ~comments:(comments |> filterComments ~loc)
   in
   (structure, printExpr, printStructureItem, printStandaloneStructure)
@@ -891,7 +888,7 @@ let parseInterface ~filename =
       (item : Parsetree.signature_item) =
     let signature_item = [item] in
     signature_item
-    |> Res_printer.print_interface ~width:Res_multi_printer.default_print_width
+    |> Res_printer.print_interface
          ~comments:(comments |> filterComments ~loc:item.psig_loc)
     |> Utils.indent range.start.character
   in

compiler/ml/location.ml

@@ -231,24 +231,29 @@ let error_of_exn exn =
 
 (* taken from https://github.com/rescript-lang/ocaml/blob/d4144647d1bf9bc7dc3aadc24c25a7efa3a67915/parsing/location.ml#L380 *)
 (* This is the error report entry point. We'll replace the default reporter with this one. *)
-let rec default_error_reporter ?(src = None) ppf {loc; msg; sub} =
+let rec default_error_reporter ?(custom_intro = None) ?(src = None) ppf
+    {loc; msg; sub} =
   setup_colors ();
   (* open a vertical box. Everything in our message is indented 2 spaces *)
   (* If src is given, it will display a syntax error after parsing. *)
   let intro =
-    match src with
-    | Some _ -> "Syntax error!"
-    | None -> "We've found a bug for you!"
+    match (custom_intro, src) with
+    | Some intro, _ -> intro
+    | None, Some _ -> "Syntax error!"
+    | None, None -> "We've found a bug for you!"
   in
   Format.fprintf ppf "@[<v>@,  %a@,  %s@,@]"
     (print ~src ~message_kind:`error intro)
     loc msg;
-  List.iter (Format.fprintf ppf "@,@[%a@]" (default_error_reporter ~src)) sub
+  List.iter
+    (Format.fprintf ppf "@,@[%a@]" (default_error_reporter ~custom_intro ~src))
+    sub
 (* no need to flush here; location's report_exception (which uses this ultimately) flushes *)
 
 let error_reporter = ref default_error_reporter
 
-let report_error ?(src = None) ppf err = !error_reporter ~src ppf err
+let report_error ?(custom_intro = None) ?(src = None) ppf err =
+  !error_reporter ~custom_intro ~src ppf err
 
 let error_of_printer loc print x = errorf ~loc "%a@?" print x
 
@@ -276,7 +281,8 @@ let rec report_exception_rec n ppf exn =
     match error_of_exn exn with
     | None -> reraise exn
     | Some `Already_displayed -> ()
-    | Some (`Ok err) -> fprintf ppf "@[%a@]@." (report_error ~src:None) err
+    | Some (`Ok err) ->
+      fprintf ppf "@[%a@]@." (report_error ~custom_intro:None ~src:None) err
   with exn when n > 0 -> report_exception_rec (n - 1) ppf exn
 
 let report_exception ppf exn = report_exception_rec 5 ppf exn

compiler/ml/location.mli

@@ -103,12 +103,28 @@ val register_error_of_exn : (exn -> error option) -> unit
     a location, a message, and optionally sub-messages (each of them
     being located as well). *)
 
-val report_error : ?src:string option -> formatter -> error -> unit
-
-val error_reporter : (?src:string option -> formatter -> error -> unit) ref
+val report_error :
+  ?custom_intro:string option ->
+  ?src:string option ->
+  formatter ->
+  error ->
+  unit
+
+val error_reporter :
+  (?custom_intro:string option ->
+  ?src:string option ->
+  formatter ->
+  error ->
+  unit)
+  ref
 (** Hook for intercepting error reports. *)
 
-val default_error_reporter : ?src:string option -> formatter -> error -> unit
+val default_error_reporter :
+  ?custom_intro:string option ->
+  ?src:string option ->
+  formatter ->
+  error ->
+  unit
 (** Original error reporter for use in hooks. *)
 
 val report_exception : formatter -> exn -> unit

compiler/syntax/src/res_diagnostics.ml

@@ -131,12 +131,13 @@ let explain t =
 
 let make ~start_pos ~end_pos category = {start_pos; end_pos; category}
 
-let print_report diagnostics src =
+let print_report ?(custom_intro = None) ?(formatter = Format.err_formatter)
+    diagnostics src =
   let rec print diagnostics src =
     match diagnostics with
     | [] -> ()
     | d :: rest ->
-      Location.report_error ~src:(Some src) Format.err_formatter
+      Location.report_error ~custom_intro ~src:(Some src) formatter
         Location.
           {
             loc =
@@ -147,12 +148,12 @@ let print_report diagnostics src =
           };
       (match rest with
       | [] -> ()
-      | _ -> Format.fprintf Format.err_formatter "@.");
+      | _ -> Format.fprintf formatter "@.");
       print rest src
   in
-  Format.fprintf Format.err_formatter "@[<v>";
+  Format.fprintf formatter "@[<v>";
   print (List.rev diagnostics) src;
-  Format.fprintf Format.err_formatter "@]@."
+  Format.fprintf formatter "@]@."
 
 let unexpected token context = Unexpected {token; context}
 

compiler/syntax/src/res_diagnostics.mli

@@ -22,4 +22,9 @@ val message : string -> category
 
 val make : start_pos:Lexing.position -> end_pos:Lexing.position -> category -> t
 
-val print_report : t list -> string -> unit
+val print_report :
+  ?custom_intro:string option ->
+  ?formatter:Format.formatter ->
+  t list ->
+  string ->
+  unit

compiler/syntax/src/res_multi_printer.ml

@@ -1,5 +1,3 @@
-let default_print_width = 100
-
 (* print res files to res syntax *)
 let print_res ~ignore_parse_errors ~is_interface ~filename =
   if is_interface then (
@@ -9,7 +7,7 @@ let print_res ~ignore_parse_errors ~is_interface ~filename =
     if parse_result.invalid then (
       Res_diagnostics.print_report parse_result.diagnostics parse_result.source;
       if not ignore_parse_errors then exit 1);
-    Res_printer.print_interface ~width:default_print_width
+    Res_printer.print_interface ~width:Res_printer.default_print_width
       ~comments:parse_result.comments parse_result.parsetree)
   else
     let parse_result =
@@ -18,7 +16,7 @@ let print_res ~ignore_parse_errors ~is_interface ~filename =
     if parse_result.invalid then (
       Res_diagnostics.print_report parse_result.diagnostics parse_result.source;
       if not ignore_parse_errors then exit 1);
-    Res_printer.print_implementation ~width:default_print_width
+    Res_printer.print_implementation ~width:Res_printer.default_print_width
       ~comments:parse_result.comments parse_result.parsetree
 [@@raises exit]
 

compiler/syntax/src/res_multi_printer.mli

@@ -1,5 +1,3 @@
-val default_print_width : int [@@live]
-
 (* Interface to print source code to res.
  * Takes a filename called "input" and returns the corresponding formatted res syntax *)
 val print : ?ignore_parse_errors:bool -> string -> string [@@dead "+print"]