add experimental command to format code blocks embedded in docstrings

Author: zth

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

tests/tools_tests/src/docstrings-format/FormatDocstringsTest1.res

@@ -0,0 +1,48 @@
+/**
+This is the first docstring with unformatted ReScript code.
+
+```rescript
+let badly_formatted=(x,y)=>{
+let result=x+y
+if result>0{Console.log("positive")}else{Console.log("negative")}
+result
+}
+```
+
+And another code block in the same docstring:
+
+```rescript
+type user={name:string,age:int,active:bool}
+let createUser=(name,age)=>{name:name,age:age,active:true}
+```
+*/
+let testFunction1 = () => "test1"
+
+module Nested = {
+  /**
+  This is a second docstring with different formatting issues.
+
+  But if I add another line here it should be fine.
+
+  ```rescript
+  module UserService={
+    let validate=user => user.age>=18 && user.name !== ""
+    let getName = user=>user.name
+  }
+  ```  
+*/
+  let testFunction2 = () => "test2"
+}
+
+/**
+Third docstring with array and option types.
+
+```rescript
+let processUsers=(users:array<user>)=>{
+users->Array.map(user=>{...user,active:false})->Array.filter(u=>u.age>21)
+}
+
+type status=|Loading|Success(string)|Error(option<string>)
+```
+*/
+let testFunction3 = () => "test3"

tests/tools_tests/src/docstrings-format/FormatDocstringsTest1.resi

@@ -0,0 +1,48 @@
+/**
+This is the first docstring with unformatted ReScript code.
+
+```rescript
+let badly_formatted=(x,y)=>{
+let result=x+y
+if result>0{Console.log("positive")}else{Console.log("negative")}
+result
+}
+```
+
+And another code block in the same docstring:
+
+```rescript
+type user={name:string,age:int,active:bool}
+let createUser=(name,age)=>{name:name,age:age,active:true}
+```
+*/
+let testFunction1: unit => string
+
+module Nested: {
+  /**
+  This is a second docstring with different formatting issues.
+
+  But if I add another line here it should be fine.
+
+  ```rescript
+  module UserService={
+    let validate=user => user.age>=18 && user.name !== ""
+    let getName = user=>user.name
+  }
+  ```  
+*/
+  let testFunction2: unit => string
+}
+
+/**
+Third docstring with array and option types.
+
+```rescript
+let processUsers=(users:array<user>)=>{
+users->Array.map(user=>{...user,active:false})->Array.filter(u=>u.age>21)
+}
+
+type status=|Loading|Success(string)|Error(option<string>)
+```
+*/
+let testFunction3: unit => string

tests/tools_tests/src/docstrings-format/FormatDocstringsTest2.res

@@ -0,0 +1,41 @@
+/**
+Testing JSX and more complex formatting scenarios.
+
+```rescript
+let component=()=>{
+<div className="container">
+<h1>{"Title"->React.string}</h1>
+<button onClick={_=>Console.log("clicked")}>{"Click me"->React.string}</button>
+</div>
+}
+```
+
+Testing pattern matching and switch expressions:
+
+```rescript
+let handleResult=(result:result<string,string>)=>{
+switch result {
+| Ok(value)=>Console.log(`Success: ${value}`)
+| Error(error)=>Console.error(`Error: ${error}`)
+}
+}
+```
+*/
+let testJsx = () => "jsx test"
+
+/**
+Testing function composition and piping.
+
+```rescript
+let processData=(data:array<int>)=>{
+data->Array.filter(x=>x>0)->Array.map(x=>x*2)->Array.reduce(0,(acc,x)=>acc+x)
+}
+
+let asyncExample=async()=>{
+let data=await fetchData()
+let processed=await processData(data)
+Console.log(processed)
+}
+```
+*/
+let testPipes = () => "pipes test"

tests/tools_tests/src/docstrings-format/FormatDocstringsTestError.res

@@ -0,0 +1,9 @@
+/**
+This docstring has an error.
+
+```rescript
+let name= 
+let x=12
+```
+*/
+let testJsx = () => "jsx test"

tests/tools_tests/src/expected/FormatDocstringsTest1.res.expected

@@ -0,0 +1,55 @@
+/**
+This is the first docstring with unformatted ReScript code.
+
+```rescript
+let badly_formatted = (x, y) => {
+  let result = x + y
+  if result > 0 {
+    Console.log("positive")
+  } else {
+    Console.log("negative")
+  }
+  result
+}
+```
+
+And another code block in the same docstring:
+
+```rescript
+type user = {name: string, age: int, active: bool}
+let createUser = (name, age) => {name, age, active: true}
+```
+*/
+let testFunction1 = () => "test1"
+
+module Nested = {
+  /**
+  This is a second docstring with different formatting issues.
+
+  But if I add another line here it should be fine.
+
+  ```rescript
+  module UserService = {
+    let validate = user => user.age >= 18 && user.name !== ""
+    let getName = user => user.name
+  }
+  ```  
+*/
+  let testFunction2 = () => "test2"
+}
+
+/**
+Third docstring with array and option types.
+
+```rescript
+let processUsers = (users: array<user>) => {
+  users
+  ->Array.map(user => {...user, active: false})
+  ->Array.filter(u => u.age > 21)
+}
+
+type status = Loading | Success(string) | Error(option<string>)
+```
+*/
+let testFunction3 = () => "test3"
+

tests/tools_tests/src/expected/FormatDocstringsTest1.resi.expected

@@ -0,0 +1,55 @@
+/**
+This is the first docstring with unformatted ReScript code.
+
+```rescript
+let badly_formatted = (x, y) => {
+  let result = x + y
+  if result > 0 {
+    Console.log("positive")
+  } else {
+    Console.log("negative")
+  }
+  result
+}
+```
+
+And another code block in the same docstring:
+
+```rescript
+type user = {name: string, age: int, active: bool}
+let createUser = (name, age) => {name, age, active: true}
+```
+*/
+let testFunction1: unit => string
+
+module Nested: {
+  /**
+  This is a second docstring with different formatting issues.
+
+  But if I add another line here it should be fine.
+
+  ```rescript
+  module UserService = {
+    let validate = user => user.age >= 18 && user.name !== ""
+    let getName = user => user.name
+  }
+  ```  
+*/
+  let testFunction2: unit => string
+}
+
+/**
+Third docstring with array and option types.
+
+```rescript
+let processUsers = (users: array<user>) => {
+  users
+  ->Array.map(user => {...user, active: false})
+  ->Array.filter(u => u.age > 21)
+}
+
+type status = Loading | Success(string) | Error(option<string>)
+```
+*/
+let testFunction3: unit => string
+