Standardize doc comments printing (#7529)

* Split res.doc attribute with other attributes

* WIP

* Better fix

* Handle edge case

* Handle variant printing with comment

* Refactor

* Update formatted runtimes and tests files

* Update CHANGELOG

* Fix some edge case

* Remove accidentally committed file

* Fix tools_tests

* Fix List.is_empty not available in older ocaml

Author: shulhi

CHANGELOG.md

@@ -38,6 +38,7 @@
 - Improve error message for pipe (`->`) syntax. https://github.com/rescript-lang/rescript/pull/7520
 - Improve a few error messages around various subtyping issues. https://github.com/rescript-lang/rescript/pull/7404
 - In module declarations, accept the invalid syntax `M = {...}` and format it to `M : {...}`. https://github.com/rescript-lang/rescript/pull/7527
+- Improve doc comment formatting to match the style of multiline comments. https://github.com/rescript-lang/rescript/pull/7529
 
 #### :house: Internal
 

compiler/syntax/src/res_parsetree_viewer.ml

@@ -567,6 +567,23 @@ let filter_printable_attributes attrs = List.filter is_printable_attribute attrs
 let partition_printable_attributes attrs =
   List.partition is_printable_attribute attrs
 
+let partition_doc_comment_attributes attrs =
+  List.partition
+    (fun ((id, payload) : Parsetree.attribute) ->
+      match (id, payload) with
+      | ( {txt = "res.doc"},
+          PStr
+            [
+              {
+                pstr_desc =
+                  Pstr_eval
+                    ({pexp_desc = Pexp_constant (Pconst_string (_, _))}, _);
+              };
+            ] ) ->
+        true
+      | _ -> false)
+    attrs
+
 let is_fun_newtype expr =
   match expr.pexp_desc with
   | Pexp_fun _ | Pexp_newtype _ -> true

compiler/syntax/src/res_parsetree_viewer.mli

@@ -98,6 +98,8 @@ val has_printable_attributes : Parsetree.attributes -> bool
 val filter_printable_attributes : Parsetree.attributes -> Parsetree.attributes
 val partition_printable_attributes :
   Parsetree.attributes -> Parsetree.attributes * Parsetree.attributes
+val partition_doc_comment_attributes :
+  Parsetree.attributes -> Parsetree.attributes * Parsetree.attributes
 
 val requires_special_callback_printing_last_arg :
   (Asttypes.arg_label * Parsetree.expression) list -> bool

compiler/syntax/src/res_printer.ml

@@ -1549,7 +1549,15 @@ and print_constructor_declarations ~state ~private_flag
 
 and print_constructor_declaration2 ~state i
     (cd : Parsetree.constructor_declaration) cmt_tbl =
-  let attrs = print_attributes ~state cd.pcd_attributes cmt_tbl in
+  let comment_attrs, attrs =
+    ParsetreeViewer.partition_doc_comment_attributes cd.pcd_attributes
+  in
+  let comment_doc =
+    match comment_attrs with
+    | [] -> Doc.nil
+    | comment_attrs -> print_doc_comments ~state cmt_tbl comment_attrs
+  in
+  let attrs = print_attributes ~state attrs cmt_tbl in
   let is_dot_dot_dot = cd.pcd_name.txt = "..." in
   let bar =
     if i > 0 || cd.pcd_attributes <> [] || is_dot_dot_dot then Doc.text "| "
@@ -1572,6 +1580,7 @@ and print_constructor_declaration2 ~state i
   Doc.concat
     [
       bar;
+      comment_doc;
       Doc.group
         (Doc.concat
            [
@@ -1934,8 +1943,20 @@ and print_typ_expr ?inline_record_definitions ~(state : State.t)
   let doc =
     match typ_expr.ptyp_attributes with
     | _ :: _ as attrs when not should_print_its_own_attributes ->
-      Doc.group
-        (Doc.concat [print_attributes ~state attrs cmt_tbl; rendered_type])
+      let doc_comment_attr, attrs =
+        ParsetreeViewer.partition_doc_comment_attributes attrs
+      in
+      let comment_doc =
+        match doc_comment_attr with
+        | [] -> Doc.nil
+        | _ -> print_doc_comments ~state ~sep:Doc.space cmt_tbl doc_comment_attr
+      in
+      let attrs_doc =
+        match attrs with
+        | [] -> Doc.nil
+        | _ -> print_attributes ~state attrs cmt_tbl
+      in
+      Doc.group (Doc.concat [comment_doc; attrs_doc; rendered_type])
     | _ -> rendered_type
   in
   print_comments doc cmt_tbl typ_expr.ptyp_loc
@@ -5568,6 +5589,15 @@ and print_bs_object_row ~state (lbl, expr) cmt_tbl =
   in
   print_comments doc cmt_tbl cmt_loc
 
+and print_doc_comments ~state ?(sep = Doc.hard_line) cmt_tbl attrs =
+  Doc.concat
+    [
+      Doc.group
+        (Doc.join_with_sep
+           (List.map (fun attr -> print_attribute ~state attr cmt_tbl) attrs));
+      sep;
+    ]
+
 (* The optional loc indicates whether we need to print the attributes in
  * relation to some location. In practise this means the following:
  *  `@attr type t = string` -> on the same line, print on the same line
@@ -5579,6 +5609,9 @@ and print_attributes ?loc ?(inline = false) ~state
   match ParsetreeViewer.filter_parsing_attrs attrs with
   | [] -> Doc.nil
   | attrs ->
+    let comment_attrs, attrs =
+      ParsetreeViewer.partition_doc_comment_attributes attrs
+    in
     let line_break =
       match loc with
       | None -> Doc.line
@@ -5587,15 +5620,30 @@ and print_attributes ?loc ?(inline = false) ~state
         | ({loc = first_loc}, _) :: _
           when loc.loc_start.pos_lnum > first_loc.loc_end.pos_lnum ->
           Doc.hard_line
-        | _ -> Doc.line)
+        | _ ->
+          let has_comment_attrs = not (comment_attrs = []) in
+          if has_comment_attrs then Doc.space else Doc.line)
     in
-    Doc.concat
-      [
-        Doc.group
-          (Doc.join_with_sep
-             (List.map (fun attr -> print_attribute ~state attr cmt_tbl) attrs));
-        (if inline then Doc.space else line_break);
-      ]
+    let comment_doc =
+      match comment_attrs with
+      | [] -> Doc.nil
+      | comment_attrs -> print_doc_comments ~state cmt_tbl comment_attrs
+    in
+    let attrs_doc =
+      match attrs with
+      | [] -> Doc.nil
+      | _ ->
+        Doc.concat
+          [
+            Doc.group
+              (Doc.join_with_sep
+                 (List.map
+                    (fun attr -> print_attribute ~state attr cmt_tbl)
+                    attrs));
+            (if inline then Doc.space else line_break);
+          ]
+    in
+    Doc.concat [comment_doc; attrs_doc]
 
 and print_payload ~state (payload : Parsetree.payload) cmt_tbl =
   match payload with

runtime/Belt_Array.resi

@@ -126,7 +126,6 @@ assertEqual(Belt.Array.reverse([10, 11, 12, 13, 14]), [14, 13, 12, 11, 10])
 */
 let reverse: t<'a> => t<'a>
 
-@new
 /**
 `makeUninitialized(n)` creates an array of length `n` filled with the undefined
 value. You must specify the type of data that will eventually fill the array.
@@ -139,9 +138,9 @@ let arr: array<Js.undefined<string>> = Belt.Array.makeUninitialized(5)
 assertEqual(Belt.Array.getExn(arr, 0), Js.undefined)
 ```
 */
+@new
 external makeUninitialized: int => array<Js.undefined<'a>> = "Array"
 
-@new
 /**
 **Unsafe**
 
@@ -157,6 +156,7 @@ Belt.Array.setExn(arr, 0, "example")
 assertEqual(Belt.Array.getExn(arr, 0), "example")
 ```
 */
+@new
 external makeUninitializedUnsafe: int => t<'a> = "Array"
 
 /**
@@ -335,11 +335,11 @@ assertEqual(Belt.Array.sliceToEnd([10, 11, 12, 13, 14, 15, 16], -4), [13, 14, 15
 */
 let sliceToEnd: (t<'a>, int) => t<'a>
 
-@send
 /**
 `copy(a)` returns a copy of `a`; that is; a fresh array containing the same
 elements as `a`.
 */
+@send
 external copy: (t<'a>, @as(0) _) => t<'a> = "slice"
 
 /**
@@ -770,7 +770,6 @@ assertEqual(Belt.Array.eq([1, 2, 3], [(-1), (-2), (-3)], (a, b) => abs(a) == abs
 */
 let eq: (t<'a>, t<'a>, ('a, 'a) => bool) => bool
 
-@set
 /**
 Unsafe `truncateToLengthUnsafe(xs, n)` sets length of array `xs` to `n`. If `n`
 is greater than the length of `xs`; the extra elements are set to `Js.Null_undefined.null`.
@@ -786,6 +785,7 @@ Belt.Array.truncateToLengthUnsafe(arr, 3)
 assertEqual(arr, ["ant", "bee", "cat"])
 ```
 */
+@set
 external truncateToLengthUnsafe: (t<'a>, int) => unit = "length"
 
 @deprecated("Use `init` instead")

runtime/Belt_Float.resi

@@ -57,7 +57,6 @@ assertEqual(Belt.Float.fromString("1.0"), Some(1.0))
 */
 let fromString: string => option<float>
 
-@val
 /**
 Converts a given `float` to a `string`. Uses the JavaScript `String` constructor under the hood.
 
@@ -67,6 +66,7 @@ Converts a given `float` to a `string`. Uses the JavaScript `String` constructor
 assertEqual(Belt.Float.toString(1.0), "1")
 ```
 */
+@val
 external toString: float => string = "String"
 
 /**

runtime/Belt_List.resi

@@ -790,7 +790,6 @@ assertEqual(Belt.List.keep(list{None, Some(2), Some(3), None}, Belt.Option.isSom
 */
 let keep: (t<'a>, 'a => bool) => t<'a>
 
-@deprecated("This function will soon be deprecated. Please, use `List.keep` instead.")
 /**
 Returns a list of all elements in `someList` which satisfy the predicate function `pred`.
 
@@ -804,6 +803,7 @@ assertEqual(Belt.List.filter(list{1, 2, 3, 4}, isEven), list{2, 4})
 assertEqual(Belt.List.filter(list{None, Some(2), Some(3), None}, Belt.Option.isSome), list{Some(2), Some(3)})
 ```
 */
+@deprecated("This function will soon be deprecated. Please, use `List.keep` instead.")
 let filter: (t<'a>, 'a => bool) => t<'a>
 
 /** Uncurried version of [keepWithIndex](#keepWithIndex). */
@@ -823,10 +823,6 @@ assertEqual(Belt.List.keepWithIndex(list{1, 2, 3, 4}, (_x, index) => isEven(inde
 */
 let keepWithIndex: (t<'a>, ('a, int) => bool) => t<'a>
 
-@deprecated(
-  "This function will soon be deprecated. Please, use `List.keepWithIndex` \
-     instead."
-)
 /**
 Returns a list of all elements in `someList` which satisfy the predicate function `pred`.
 
@@ -838,6 +834,10 @@ let isEven = x => mod(x, 2) == 0
 assertEqual(Belt.List.filterWithIndex(list{1, 2, 3, 4}, (_x, index) => isEven(index)), list{1, 3})
 ```
 */
+@deprecated(
+  "This function will soon be deprecated. Please, use `List.keepWithIndex` \
+     instead."
+)
 let filterWithIndex: (t<'a>, ('a, int) => bool) => t<'a>
 
 /** Uncurried version of [keepMap](#keepMap). */

runtime/Js.res

@@ -219,15 +219,17 @@ external undefined: undefined<'a> = "%undefined"
 */
 external typeof: 'a => string = "%typeof"
 
-@val @scope("console") /** Equivalent to console.log any value. */
+/** Equivalent to console.log any value. */
+@val @scope("console")
 external log: 'a => unit = "log"
 
 @val @scope("console") external log2: ('a, 'b) => unit = "log"
 @val @scope("console") external log3: ('a, 'b, 'c) => unit = "log"
 
 @val @scope("console") external log4: ('a, 'b, 'c, 'd) => unit = "log"
 
-@val @scope("console") @variadic /** A convenience function to console.log more than 4 arguments */
+/** A convenience function to console.log more than 4 arguments */
+@val @scope("console") @variadic
 external logMany: array<'a> => unit = "log"
 
 external eqNull: ('a, null<'a>) => bool = "%equal_null"