Keep doc comments and comments in place in four formatter cases

changes/formatter-comment-placement.fix.md

@@ -0,0 +1 @@
+- Fix the formatter's placement of a doc comment on a single hugged parameter, of doc comments after an attribute, and of a comment before a list's tail spread, and the extra newline after a file with only a line comment.

compiler/syntax/src/res_parsetree_viewer.ml

@@ -366,13 +366,6 @@ let collect_ternary_parts expr =
   in
   collect [] expr
 
-let parameters_should_hug parameters =
-  match parameters with
-  | [Parameter {attrs = []; lbl = Nolabel; default_expr = None; pat}]
-    when is_huggable_pattern pat ->
-    true
-  | _ -> false
-
 let should_indent_binary_expr expr =
   let same_precedence_sub_expression operator sub_expression =
     match sub_expression with
@@ -430,8 +423,25 @@ let is_doc_comment_attribute ((id, payload) : Parsetree.attribute) =
     true
   | _ -> false
 
+(* Only the doc comments before every other attribute: one after an attribute
+   stays in its place, so that printing keeps the order of the attributes. *)
 let partition_doc_comment_attributes attrs =
-  List.partition is_doc_comment_attribute attrs
+  let rec split doc_comments = function
+    | attr :: attrs when is_doc_comment_attribute attr ->
+      split (attr :: doc_comments) attrs
+    | attrs -> (List.rev doc_comments, attrs)
+  in
+  split [] attrs
+
+(* A doc comment can be printed on its own line, which a hugged parameter
+   cannot start. *)
+let parameters_should_hug parameters =
+  match parameters with
+  | [Parameter {attrs = []; lbl = Nolabel; default_expr = None; pat}]
+    when is_huggable_pattern pat
+         && not (List.exists is_doc_comment_attribute pat.ppat_attributes) ->
+    true
+  | _ -> false
 
 let rec is_fun_expr expr =
   match expr.pexp_desc with

compiler/syntax/src/res_parsetree_viewer.mli

@@ -80,6 +80,9 @@ val should_indent_binary_expr : Parsetree.expression -> bool
 val should_inline_rhs_binary_expr : Parsetree.expression -> bool
 val mod_expr_has_attributes : Parsetree.module_expr -> bool
 val is_doc_comment_attribute : Parsetree.attribute -> bool
+
+(* The doc comments before every other attribute, and the attributes after
+   them, which may include later doc comments *)
 val partition_doc_comment_attributes :
   Parsetree.attributes -> Parsetree.attributes * Parsetree.attributes
 

compiler/syntax/src/res_printer.ml

@@ -222,13 +222,14 @@ let print_trailing_comment (prev_loc : Location.t) (node_loc : Location.t)
   else if not single_line then Doc.concat [Doc.space; content]
   else Doc.line_suffix (Doc.concat [Doc.space; content])
 
+let print_comment_content comment =
+  let txt = Comment.txt comment in
+  if Comment.is_single_line_comment comment then Doc.text ("//" ^ txt)
+  else print_multiline_comment_content txt
+
 let print_leading_comment ?next_comment comment =
   let single_line = Comment.is_single_line_comment comment in
-  let content =
-    let txt = Comment.txt comment in
-    if single_line then Doc.text ("//" ^ txt)
-    else print_multiline_comment_content txt
-  in
+  let content = print_comment_content comment in
   let separator =
     Doc.concat
       [
@@ -294,7 +295,9 @@ let print_comments_inside_file cmt_tbl =
     match comments with
     | [] -> Doc.nil
     | [comment] ->
-      let cmt_doc = print_leading_comment comment in
+      (* Nothing follows the last comment: the line break after a line comment
+         would add an empty line to the final newline of the file. *)
+      let cmt_doc = print_comment_content comment in
       let doc =
         Doc.group (Doc.concat [Doc.concat (List.rev (cmt_doc :: acc))])
       in
@@ -1754,25 +1757,31 @@ and print_literal_dict_expr ~state (e : Parsetree.expression) cmt_tbl =
            Doc.soft_line;
          ])
 
+(* [...expr] in an array, list or dict. The leading comments of [expr] go
+   before the dots, which are part of the spread and not of [expr]. *)
+and print_spread_with_comments ~state expr cmt_tbl =
+  let leading_comments_doc =
+    print_leading_comments Doc.nil cmt_tbl.Comment_table.leading
+      expr.Parsetree.pexp_loc
+  in
+  let doc =
+    let doc = print_expression ~state expr cmt_tbl in
+    match Parens.expr_allowing_coercion expr with
+    | Parens.Parenthesized -> add_parens doc
+    | Braced braces -> print_braces doc expr braces
+    | Nothing -> doc
+  in
+  Doc.concat
+    [
+      leading_comments_doc;
+      Doc.dotdotdot;
+      print_trailing_comments doc cmt_tbl.Comment_table.trailing
+        expr.Parsetree.pexp_loc;
+    ]
+
 and print_spread_dict_expr ~state parts (expr : Parsetree.expression) cmt_tbl =
   let print_spread_part spread_expr =
-    let leading_comments_doc =
-      print_leading_comments Doc.nil cmt_tbl.Comment_table.leading
-        spread_expr.Parsetree.pexp_loc
-    in
-    let spread_doc =
-      let doc = print_expression ~state spread_expr cmt_tbl in
-      match Parens.expr_allowing_coercion spread_expr with
-      | Parens.Parenthesized -> add_parens doc
-      | Braced braces -> print_braces doc spread_expr braces
-      | Nothing -> doc
-    in
-    let spread_with_trailing_comments =
-      print_trailing_comments spread_doc cmt_tbl.Comment_table.trailing
-        spread_expr.Parsetree.pexp_loc
-    in
-    Doc.concat
-      [leading_comments_doc; Doc.dotdotdot; spread_with_trailing_comments]
+    print_spread_with_comments ~state spread_expr cmt_tbl
   in
   let parts_doc =
     Doc.join
@@ -2835,11 +2844,18 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl =
             (match tail.Parsetree.ppat_desc with
             | Ppat_construct ({txt = Longident.Lident "[]"}, _) -> Doc.nil
             | _ ->
-              let doc =
-                Doc.concat [Doc.text "..."; print_pattern ~state tail cmt_tbl]
+              (* Taken before [print_pattern] prints the other comments *)
+              let leading =
+                print_leading_comments Doc.nil cmt_tbl.leading tail.ppat_loc
               in
-              let tail = print_comments doc cmt_tbl tail.ppat_loc in
-              Doc.concat [Doc.text ","; Doc.line; tail]);
+              Doc.concat
+                [
+                  Doc.text ",";
+                  Doc.line;
+                  leading;
+                  Doc.text "...";
+                  print_pattern ~state tail cmt_tbl;
+                ]);
           ]
       in
       Doc.group
@@ -3372,12 +3388,7 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl =
             [
               Doc.text ",";
               Doc.line;
-              Doc.dotdotdot;
-              (let doc = print_expression_with_comments ~state expr cmt_tbl in
-               match Parens.expr_allowing_coercion expr with
-               | Parens.Parenthesized -> add_parens doc
-               | Braced braces -> print_braces doc expr braces
-               | Nothing -> doc);
+              print_spread_with_comments ~state expr cmt_tbl;
             ]
         | None -> Doc.nil
       in
@@ -4337,18 +4348,7 @@ and print_spread_expr ~state kind elements cmt_tbl =
   let element_doc = function
     | Parsetree.Pspread_item expr ->
       print_comments (expr_doc expr) cmt_tbl expr.pexp_loc
-    | Pspread expr ->
-      (* The leading comments go before the dots, so they're taken before the
-         expression is printed *)
-      let leading_comments_doc =
-        print_leading_comments Doc.nil cmt_tbl.Comment_table.leading
-          expr.pexp_loc
-      in
-      let expr_doc =
-        print_trailing_comments (expr_doc expr) cmt_tbl.Comment_table.trailing
-          expr.pexp_loc
-      in
-      Doc.concat [leading_comments_doc; Doc.dotdotdot; expr_doc]
+    | Pspread expr -> print_spread_with_comments ~state expr cmt_tbl
   in
   Doc.group
     (Doc.concat
@@ -5960,10 +5960,11 @@ and print_attributes ?loc ?(inline = false) ~state
       | _ ->
         Doc.concat
           [
+            (* A doc comment here follows an attribute and stays on its line *)
             Doc.group
-              (Doc.join_with_sep
+              (Doc.join ~sep:Doc.line
                  (List.map
-                    (fun attr -> print_attribute ~state attr cmt_tbl)
+                    (fun attr -> fst (print_attribute ~state attr cmt_tbl))
                     attrs));
             (if inline then Doc.space else line_break);
           ]

tests/syntax_tests/data/printer/comments/array.res

@@ -61,3 +61,15 @@ let _ = list{
   /* comment 2 */ ...ys /* comment 3 */,
   b,
 }
+
+// A comment before a list's tail spread
+let _ = list{1, /* c0 */ ...xs}
+let _ = list{1, /* c0 */ ...xs /* c1 */}
+let _ = list{1, /* c0 */ ...(xs :> list<int>) /* c1 */}
+let _ = list{
+  1,
+  // c0
+  ...xs,
+}
+let f = (list{a, /* c0 */ ...rest}) => a
+let f = (list{a, /* c0 */ ...rest /* c1 */}) => a

tests/syntax_tests/data/printer/comments/docCommentAttributes.res

@@ -19,3 +19,15 @@ Normal comment Normal comment Normal comment Normal comment Normal comment
 */
 @a @b
 external f: unit => unit = "f"
+
+// A doc comment after an attribute stays after it
+@a /** Doc comment */ @b
+external f: unit => unit = "f"
+
+/** Doc comment 1 */ @a /** Doc comment 2 */
+let x = 1
+
+type t = | @a /** Doc comment */ A | B
+type r = {@a /** Doc comment */ x: int}
+type p = [@a /** Doc comment */ #A | #B]
+type q = @a /** Doc comment */ int

tests/syntax_tests/data/printer/comments/docCommentParameters.res

@@ -3,3 +3,11 @@ let f = (/** The runner */ run: string) => run
 let f = (/** Positional */ x, /** Labelled */ ~y, /** Typed */ ~z: int) => x + y + z
 let f = (/** Optional */ ~a=?, /** Default */ ~b=1, /** Aliased */ ~c as d) => d
 let f = (/** Locally abstract */ type a, x: a) => x
+
+// A doc comment on a single parameter that would be hugged
+let f = (/** Record */ {x, y}) => x
+let f = (/** Array */ [a]) => a
+let f = (/** Tuple */ (a, b)) => a
+let f = (/** Unit */ ()) => 1
+let f = (@a /** After an attribute */ {x, y}) => x
+

tests/syntax_tests/data/printer/comments/expected/array.res.txt

@@ -58,3 +58,15 @@ let _ = list{
   /* comment 2 */ ...ys /* comment 3 */,
   b,
 }
+
+// A comment before a list's tail spread
+let _ = list{1, /* c0 */ ...xs}
+let _ = list{1, /* c0 */ ...xs /* c1 */}
+let _ = list{1, /* c0 */ ...xs :> list<int> /* c1 */}
+let _ = list{
+  1,
+  // c0
+  ...xs,
+}
+let f = (list{a, /* c0 */ ...rest}) => a
+let f = (list{a, /* c0 */ ...rest /* c1 */}) => a

tests/syntax_tests/data/printer/comments/expected/docCommentAttributes.res.txt

@@ -19,3 +19,16 @@ Normal comment Normal comment Normal comment Normal comment Normal comment
 */
 @a @b
 external f: unit => unit = "f"
+
+// A doc comment after an attribute stays after it
+@a /** Doc comment */ @b
+external f: unit => unit = "f"
+
+/** Doc comment 1 */
+@a /** Doc comment 2 */
+let x = 1
+
+type t = | @a /** Doc comment */ A | B
+type r = {@a /** Doc comment */ x: int}
+type p = [@a /** Doc comment */ #A | #B]
+type q = @a /** Doc comment */ int

tests/syntax_tests/data/printer/comments/expected/docCommentParameters.res.txt

@@ -27,3 +27,22 @@ let f = (
   type a,
   x: a,
 ) => x
+
+// A doc comment on a single parameter that would be hugged
+let f = (
+  /** Record */
+  {x, y},
+) => x
+let f = (
+  /** Array */
+  [a],
+) => a
+let f = (
+  /** Tuple */
+  (a, b),
+) => a
+let f = (
+  /** Unit */
+  (),
+) => 1
+let f = (@a /** After an attribute */ {x, y}) => x

tests/syntax_tests/data/printer/comments/expected/fileWithOneSingleLineComment.res.txt

@@ -1,2 +1 @@
 // retain this comment
-

tests/syntax_tests/data/printer/comments/expected/fileWithOnlyComments.res.txt

@@ -6,4 +6,3 @@ comment
 */
 
 // more comments
-

tests/syntax_tests/data/printer/comments/expected/interfaceWithOneSingleComment.resi.txt

@@ -1,2 +1 @@
 // retain this comment
-

tests/syntax_tests/data/printer/comments/expected/interfaceWithOnlyComments.resi.txt

@@ -3,4 +3,3 @@
 /* test */
 
 // ok
-

tests/syntax_tests/data/printer/comments/expected/pattern.res.txt

@@ -45,7 +45,7 @@ let [/* inside */] = []
 let list{/* inside */} = list{}
 
 let /* before */ list{/* a1 */ a /* a2 */, /* b1 */ b /* b2 */} /* after */ = list{1, 2}
-let /* before */ list{/* a1 */ a /* a2 */, .../* b1 */ b /* b2 */} /* after */ = list{1, 2}
+let /* before */ list{/* a1 */ a /* a2 */, /* b1 */ ...b /* b2 */} /* after */ = list{1, 2}
 
 // Ppat_record
 let /* before */ {/* c0 */ name /* c1 */, /* c2 */ age /* c3 */} /* after */ = {

tests/syntax_tests/data/printer/modExpr/expected/attributes.res.txt

@@ -42,7 +42,7 @@ module U = (@JSX F(A))(B)
 module V = @JSX (X: S)
 
 // a functor argument can't start with a doc comment
-module W = H((/** doc */ @w X))
+module W = H((@w /** doc */ X))
 module Y = H((/** doc */ X: S))
 module AA = H(await /** doc */ X)
 module Z = /** doc */ X

tests/syntax_tests/data/printer/typeDef/attributes.res

@@ -22,6 +22,7 @@ type t = /** doc */ {x: int}
 type t = /** doc */ ..
 type t = /** doc */ @attr {x: int}
 type t = @attr /** doc */ @attr2 ..
+type t = /** d1 */ @attr /** d2 */ {x: int}
 @outer
 type t = /* c1 */ /** doc */ /* c2 */ {x: int} // trail
 type t = /** doc */ A | B

tests/syntax_tests/data/printer/typeDef/expected/attributes.res.txt

@@ -23,20 +23,18 @@ type t = {
   email: string,
   name: string,
 }
-/** doc */
-@attr type t = {x: int}
+@attr /** doc */ type t = {x: int}
 @attr type t = ..
 /** doc */
 type t = {x: int}
 /** doc */
 type t = ..
 /** doc */
 @attr type t = {x: int}
-/** doc */
-@attr @attr2 type t = ..
-/** doc */
-@outer
-type t = {/* c1 */ /* c2 */ x: int} // trail
+@attr /** doc */ @attr2 type t = ..
+/** d1 */
+@attr /** d2 */ type t = {x: int}
+@outer /** doc */ type t = {/* c1 */ /* c2 */ x: int} // trail
 type t =
   /** doc */
   | A