Experimental formatter feature MultilineItemSpacing: blank lines around multi-line module items

changes/formatter-multiline-item-spacing.polish.md

@@ -0,0 +1 @@
+- Add the experimental feature `MultilineItemSpacing`: with `"experimental-features": {"MultilineItemSpacing": true}`, `rescript format` puts a blank line before and after a module item that spans several lines.

compiler/bsc/rescript_compiler_driver.ml

@@ -492,7 +492,8 @@ let command_line_flags () : (string * Bsc_args.spec * string) array =
     ( "-enable-experimental",
       string_call Experimental_features.enable_from_string,
       "Enable experimental features: repeatable, e.g. -enable-experimental \
-       LetUnwrap" );
+       LetUnwrap. Pass it before -format to format with a feature such as \
+       MultilineItemSpacing" );
     (* Not used, the build system did the expansion *)
     ( "-bs-no-bin-annot",
       clear (Clflags.current ()).binary_annotations,

compiler/ml/experimental_features.ml

@@ -1,12 +1,14 @@
-type feature = LetUnwrap
+type feature = LetUnwrap | MultilineItemSpacing
 
 let to_string (f : feature) : string =
   match f with
   | LetUnwrap -> "LetUnwrap"
+  | MultilineItemSpacing -> "MultilineItemSpacing"
 
 let from_string (s : string) : feature option =
   match s with
   | "LetUnwrap" -> Some LetUnwrap
+  | "MultilineItemSpacing" -> Some MultilineItemSpacing
   | _ -> None
 
 module Feature_set = Set.Make (struct

compiler/ml/experimental_features.mli

@@ -1,4 +1,8 @@
-type feature = LetUnwrap
+type feature =
+  | LetUnwrap
+  | MultilineItemSpacing
+      (** The formatter separates module items that span several lines with a
+          blank line. *)
 
 val enable_from_string : string -> unit
 

compiler/syntax/cli/res_cli.ml

@@ -55,6 +55,9 @@ end = struct
       ( "-test-ast-conversion",
         Arg.Unit (fun () -> test_ast_conversion := true),
         "Test the ast conversion" );
+      ( "-enable-experimental",
+        Arg.String Experimental_features.enable_from_string,
+        "Enable an experimental feature, e.g. MultilineItemSpacing" );
     ]
 
   let parse () = Arg.parse spec (fun f -> file := f) usage

compiler/syntax/src/res_doc.ml

@@ -23,6 +23,8 @@ type t =
   | Group of {mutable should_break: bool; doc: t}
   | CustomLayout of t list
   | BreakParent
+  | ItemSeparator of {prev: t; next: t} (* see [item_separator] *)
+  | Comment of t (* see [comment] *)
 
 let nil = Nil
 let line = LineBreak Classic
@@ -52,6 +54,8 @@ let group d = Group {should_break = false; doc = d}
 let breakable_group ~force_break d = Group {should_break = force_break; doc = d}
 let custom_layout gs = CustomLayout gs
 let break_parent = BreakParent
+let item_separator ~prev ~next = ItemSeparator {prev; next}
+let comment d = Comment d
 
 let space = Text " "
 let comma = Text ","
@@ -75,9 +79,9 @@ let propagate_forced_breaks doc =
     match doc with
     | Text _ | Nil | LineSuffix _ -> false
     | BreakParent -> true
-    | LineBreak (Hard | Literal) -> true
+    | LineBreak (Hard | Literal) | ItemSeparator _ -> true
     | LineBreak (Classic | Soft) -> false
-    | Indent children ->
+    | Indent children | Comment children ->
       let child_forces_break = walk children in
       child_forces_break
     | IfBreaks ({yes = true_doc; no = false_doc} as ib) ->
@@ -115,9 +119,12 @@ let propagate_forced_breaks doc =
 (* See documentation in interface file *)
 let rec will_break doc =
   match doc with
-  | LineBreak (Hard | Literal) | BreakParent | Group {should_break = true} ->
+  | LineBreak (Hard | Literal)
+  | BreakParent | ItemSeparator _
+  | Group {should_break = true} ->
     true
-  | Group {doc} | Indent doc | CustomLayout (doc :: _) -> will_break doc
+  | Group {doc} | Indent doc | Comment doc | CustomLayout (doc :: _) ->
+    will_break doc
   | Concat docs -> List.exists will_break docs
   | IfBreaks {yes; no} -> will_break yes || will_break no
   | _ -> false
@@ -151,10 +158,12 @@ let fits w stack =
     | _, Nil | _, LineSuffix _ | _, BreakParent -> ()
     | _, Text txt -> width := width.contents - String.length txt
     | _, Indent doc -> calculate (indent + 2) mode doc
+    | _, Comment doc -> calculate indent mode doc
     | Flat, LineBreak Hard | Flat, LineBreak Literal -> result := Some true
     | Flat, LineBreak Classic -> width := width.contents - 1
     | Flat, LineBreak Soft -> ()
     | Break, LineBreak _ -> result := Some true
+    | _, ItemSeparator _ -> result := Some true
     | _, Group {should_break = true; doc} -> calculate indent Break doc
     | _, Group {doc} -> calculate indent mode doc
     | _, IfBreaks {yes = break_doc; broken = true} ->
@@ -184,6 +193,61 @@ let fits w stack =
   in
   calculate_all stack
 
+let select_custom_layout ~width ~pos ind rest docs =
+  let rec find_group_that_fits groups =
+    match groups with
+    | [] -> Nil
+    | [last_group] -> last_group
+    | doc :: docs ->
+      if fits (width - pos) ((ind, Flat, doc) :: rest) then doc
+      else find_group_that_fits docs
+  in
+  find_group_that_fits docs
+
+(* Whether [doc], printed from the start of a line indented by [ind], spans more
+   than one line. Takes the layout decisions of [to_string] up to the first line
+   break. Comments and line suffixes do not count. *)
+let spans_lines ~width ind mode doc =
+  let rec loop ~pos stack =
+    match stack with
+    | [] -> false
+    | (ind, mode, doc) :: rest -> (
+      match doc with
+      | Nil | BreakParent | LineSuffix _ | Comment _ -> loop ~pos rest
+      | Text txt ->
+        String.contains txt '\n' || loop ~pos:(pos + String.length txt) rest
+      | Concat docs ->
+        loop ~pos (List.map (fun doc -> (ind, mode, doc)) docs @ rest)
+      | Indent doc -> loop ~pos ((ind + 2, mode, doc) :: rest)
+      | IfBreaks {yes; no; broken} ->
+        let doc = if broken || mode = Break then yes else no in
+        loop ~pos ((ind, mode, doc) :: rest)
+      | LineBreak (Hard | Literal) | ItemSeparator _ -> true
+      | LineBreak Classic -> mode = Break || loop ~pos:(pos + 1) rest
+      | LineBreak Soft -> mode = Break || loop ~pos rest
+      | Group {should_break; doc} ->
+        let flat = (ind, Flat, doc) :: rest in
+        if should_break || not (fits (width - pos) flat) then
+          loop ~pos ((ind, Break, doc) :: rest)
+        else loop ~pos flat
+      | CustomLayout docs ->
+        let doc = select_custom_layout ~width ~pos ind rest docs in
+        loop ~pos ((ind, Flat, doc) :: rest))
+  in
+  loop ~pos:ind [(ind, mode, doc)]
+
+(* Own-line trailing comments are line suffixes that start with a hard line. *)
+let starts_with_hard_line doc =
+  match doc with
+  | LineBreak Hard | Concat (LineBreak Hard :: _) -> true
+  | _ -> false
+
+let rec drop_leading_hard_lines doc =
+  match doc with
+  | LineBreak Hard -> Nil
+  | Concat (LineBreak Hard :: docs) -> drop_leading_hard_lines (Concat docs)
+  | doc -> doc
+
 let to_string ~width doc =
   propagate_forced_breaks doc;
   let buffer = Mini_buffer.create 1000 in
@@ -201,6 +265,7 @@ let to_string ~width doc =
         let ops = List.map (fun doc -> (ind, mode, doc)) docs in
         process ~pos line_suffices (List.append ops rest)
       | Indent doc -> process ~pos line_suffices ((ind + 2, mode, doc) :: rest)
+      | Comment doc -> process ~pos line_suffices ((ind, mode, doc) :: rest)
       | IfBreaks {yes = break_doc; broken = true} ->
         process ~pos line_suffices ((ind, mode, break_doc) :: rest)
       | IfBreaks {yes = break_doc; no = flat_doc} ->
@@ -243,16 +308,28 @@ let to_string ~width doc =
         then process ~pos line_suffices ((ind, Break, doc) :: rest)
         else process ~pos line_suffices ((ind, Flat, doc) :: rest)
       | CustomLayout docs ->
-        let rec find_group_that_fits groups =
-          match groups with
-          | [] -> Nil
-          | [last_group] -> last_group
-          | doc :: docs ->
-            if fits (width - pos) ((ind, Flat, doc) :: rest) then doc
-            else find_group_that_fits docs
-        in
-        let doc = find_group_that_fits docs in
-        process ~pos line_suffices ((ind, Flat, doc) :: rest))
+        let doc = select_custom_layout ~width ~pos ind rest docs in
+        process ~pos line_suffices ((ind, Flat, doc) :: rest)
+      | ItemSeparator {prev; next} ->
+        if spans_lines ~width ind mode prev || spans_lines ~width ind mode next
+        then
+          (* Own-line trailing comments of [prev] go below the blank line, where
+             they print once they are leading comments of [next]. *)
+          let separator = (ind, mode, hard_line) in
+          let same_line, below =
+            List.partition
+              (fun (_, _, doc) -> not (starts_with_hard_line doc))
+              (List.rev line_suffices)
+          in
+          let rest =
+            match below with
+            | [] -> rest
+            | (ind, mode, doc) :: below ->
+              ((ind, mode, drop_leading_hard_lines doc) :: below)
+              @ (separator :: rest)
+          in
+          process ~pos (List.rev same_line) (separator :: separator :: rest)
+        else process ~pos line_suffices ((ind, mode, hard_line) :: rest))
     | [] -> (
       match line_suffices with
       | [] -> ()
@@ -332,6 +409,8 @@ let debug t =
         | Literal -> "Literal"
       in
       text ("LineBreak(" ^ break_txt ^ ")")
+    | ItemSeparator _ -> text "ItemSeparator"
+    | Comment doc -> concat [text "comment("; to_doc doc; text ")"]
     | Group {should_break; doc} ->
       group
         (concat
@@ -356,5 +435,5 @@ let is_nil doc =
   match doc with
   | Nil -> true
   | Text _ | LineSuffix _ | Concat _ | Indent _ | IfBreaks _ | LineBreak _
-  | Group _ | CustomLayout _ | BreakParent ->
+  | Group _ | CustomLayout _ | BreakParent | ItemSeparator _ | Comment _ ->
     false

compiler/syntax/src/res_doc.mli

@@ -18,6 +18,15 @@ val breakable_group : force_break:bool -> t -> t
  * will be checked until one fits. *)
 val custom_layout : t list -> t
 val break_parent : t
+
+val item_separator : prev:t -> next:t -> t
+(** A hard line, and a blank line when [prev] or [next], the documents printed
+    on each side of it, span several lines. It measures them but does not print
+    them. *)
+
+val comment : t -> t
+(** Prints like its argument, which [item_separator] does not measure. *)
+
 val join : sep:t -> t list -> t
 
 (* [(doc1, sep1); (doc2,sep2)] joins as doc1 sep1 doc2 *)

compiler/syntax/src/res_printer.ml

@@ -326,10 +326,8 @@ let print_leading_comments node tbl loc =
         else if diff > 1 then Doc.concat [Doc.hard_line; Doc.hard_line]
         else Doc.hard_line
       in
-      let doc =
-        Doc.group
-          (Doc.concat [Doc.concat (List.rev (cmt_doc :: acc)); separator; node])
-      in
+      let comments = Doc.concat (List.rev (separator :: cmt_doc :: acc)) in
+      let doc = Doc.group (Doc.concat [Doc.comment comments; node]) in
       doc
     | comment :: (next_comment :: _comments as rest) ->
       let cmt_doc = print_leading_comment ~next_comment comment in
@@ -387,7 +385,9 @@ let print_comments_before_marker doc (tbl : Comment_table.t) loc marker =
     Hashtbl.replace tbl.trailing loc after_marker;
     print_trailing_comments doc tbl.trailing loc
 
-let print_list ~get_loc ~nodes ~print ?(force_break = false) t =
+(* [~space_multiline] adds a blank line next to nodes printed on several lines *)
+let print_list ~get_loc ~nodes ~print ?(force_break = false)
+    ?(space_multiline = false) t =
   let rec loop first_loc_opt prev_loc_opt acc nodes =
     match nodes with
     | [] -> (first_loc_opt, prev_loc_opt, Doc.concat (List.rev acc))
@@ -403,15 +403,17 @@ let print_list ~get_loc ~nodes ~print ?(force_break = false) t =
       else
         let doc = print_comments raw_doc t loc in
         let acc =
-          match prev_loc_opt with
-          | None -> [doc]
-          | Some prev_loc ->
+          match (prev_loc_opt, acc) with
+          | Some prev_loc, prev_doc :: _ ->
             let sep =
               if start_pos.pos_lnum - prev_loc.Location.loc_end.pos_lnum > 1
               then Doc.concat [Doc.hard_line; Doc.hard_line]
+              else if space_multiline then
+                Doc.item_separator ~prev:prev_doc ~next:doc
               else Doc.hard_line
             in
             doc :: sep :: acc
+          | _ -> [doc]
         in
         let first_loc_opt =
           match first_loc_opt with
@@ -685,12 +687,15 @@ module State = struct
   let should_break_callback t = t.custom_layout > custom_layout_threshold
 end
 
+let space_multiline () =
+  Experimental_features.is_enabled Experimental_features.MultilineItemSpacing
+
 let rec print_structure ~state (s : Parsetree.structure) t =
   match s with
   | [] -> print_comments_inside_file t
   | structure ->
     let previous_can_continue = ref false in
-    print_list
+    print_list ~space_multiline:(space_multiline ())
       ~get_loc:(fun s -> s.Parsetree.pstr_loc)
       ~nodes:structure
       ~print:(fun item cmt_tbl ->
@@ -1108,7 +1113,7 @@ and print_signature ~state signature cmt_tbl =
   match signature with
   | [] -> print_comments_inside_file cmt_tbl
   | signature ->
-    print_list
+    print_list ~space_multiline:(space_multiline ())
       ~get_loc:(fun s -> s.Parsetree.psig_loc)
       ~nodes:signature
       ~print:(print_signature_item ~state)

docs/docson/build-schema.json

@@ -556,6 +556,10 @@
         "LetUnwrap": {
           "type": "boolean",
           "description": "Enable `let?` syntax."
+        },
+        "MultilineItemSpacing": {
+          "type": "boolean",
+          "description": "Format a blank line before and after a module item that spans several lines."
         }
       },
       "additionalProperties": false

rewatch-ocaml/config.ml

@@ -246,11 +246,11 @@ let decode_experimental_features path fields =
     reject_duplicates path "experimental-features" features;
     features
     |> List.concat_map (fun (name, value) ->
-        if name <> "LetUnwrap" then
+        if not (List.mem name ["LetUnwrap"; "MultilineItemSpacing"]) then
           fail path
             (Printf.sprintf
                "Unknown experimental feature '%s'. Available features: \
-                LetUnwrap"
+                LetUnwrap, MultilineItemSpacing"
                name);
         match value with
         | `Bool true -> ["-enable-experimental"; name]

rewatch-ocaml/format.ml

@@ -115,11 +115,22 @@ let files_in_scope ~verbosity =
 let formatting_error target stderr =
   Printf.sprintf "Error formatting %s: %s" target stderr
 
-let format_request path =
-  Compiler_process.{args = ["-format"; path]; cwd = Sys.getcwd ()}
+(* The experimental features of the current project, such as
+   MultilineItemSpacing, as bsc flags. They must precede -format. Outside a
+   project, format runs without them, like Rust rewatch. *)
+let experimental_args () =
+  try
+    let current = Config.load_root (Sys.getcwd ()) in
+    (Project_context.workspace_config_for current).experimental_args
+  with Config.Error _ -> []
+
+let format_request ~experimental_args path =
+  Compiler_process.
+    {args = experimental_args @ ["-format"; path]; cwd = Sys.getcwd ()}
 
 let formatted ?poll ~target path =
-  let result = Compiler_process.run ?poll (format_request path) in
+  let request = format_request ~experimental_args:(experimental_args ()) path in
+  let result = Compiler_process.run ?poll request in
   if not (Process.succeeded result) then
     raise (Error (formatting_error target result.stderr));
   result.stdout
@@ -129,6 +140,7 @@ let format_check_summary = function
   | count -> Printf.sprintf "The %d files listed above need formatting" count
 
 let format_files ?poll ~check files =
+  let experimental_args = experimental_args () in
   let incorrect = ref 0 in
   let works =
     files
@@ -137,7 +149,8 @@ let format_files ?poll ~check files =
           {key = Printf.sprintf "%08d" index; dependencies = []; value = path})
   in
   let next path = function
-    | None -> Some (Compiler_process.task (format_request path))
+    | None ->
+      Some (Compiler_process.task (format_request ~experimental_args path))
     | Some result ->
       if not (Process.succeeded result) then
         raise (Error (formatting_error path result.stderr));

rewatch/CompilerConfigurationSpec.md

@@ -122,6 +122,7 @@ An object of feature flags to enable experimental compiler behavior. Only suppor
 Currently supported features:
 
 - LetUnwrap: Enable `let?` syntax.
+- MultilineItemSpacing: `rescript format` puts a blank line before and after a module item that spans several lines.
 
 ### Warnings