Fix doc-comments '*)' exceeding the margin (ocaml-ppx#2550)

This change applies to doc-comments and regular comments parsed as
doc-comments.

Author: Julow

CHANGES.md

@@ -50,6 +50,7 @@ profile. This started with version 0.26.0.
 - Fix the formatting of the `in` keyword when `[@ocamlformat disable]` is attached to a let-binding (#2242, @EmileTrotignon)
 - Fix comments around underscore in record patterns (#2540, @Julow)
 - Fix dropped comments before `begin .. end` in a match case (#2541, @Julow)
+- Fix closing `*)` in doc-comments exceeding the margin (#2550, @Julow)
 
 ### Changes
 - The location of attributes for structure items is now tracked and preserved. (#2247, @EmileTrotignon)

lib/Cmts.ml

@@ -554,14 +554,23 @@ module Doc = struct
           let l = List.last_exn lines in
           (is_only_whitespaces h, is_only_whitespaces l)
     in
+    let force_trailing_space =
+      String.length txt > 1 && String.ends_with_whitespace txt
+    in
     let txt = if pre_nl then String.lstrip txt else txt in
     let txt = if trail_nl then String.rstrip txt else txt in
     let parsed = Docstring.parse ~loc txt in
     (* Disable warnings when parsing of code blocks fails. *)
     let quiet = Conf_t.Elt.make true `Default in
     let conf = {conf with Conf.opr_opts= {conf.Conf.opr_opts with quiet}} in
-    let doc = Fmt_odoc.fmt_parsed conf ~fmt_code ~input:txt ~offset parsed in
     let open Fmt in
+    let trailing_space =
+      if (not trail_nl) && force_trailing_space then str " " else noop
+    in
+    let doc =
+      Fmt_odoc.fmt_parsed conf ~trailing_space ~fmt_code ~input:txt ~offset
+        parsed
+    in
     hvbox 2
       ( pro
       $ fmt_if pre_nl (break 1000 1)

lib/Fmt_ast.ml

@@ -413,7 +413,7 @@ let fmt_parsed_docstring c ~loc ?pro ~epi input parsed =
   let doc = Fmt_odoc.fmt_parsed c.conf ~fmt_code ~offset ~input parsed in
   Cmts.fmt c loc
   @@ vbox_if (Option.is_none pro) 0
-       (fmt_opt pro $ wrap (str "(**") (str "*)") doc $ epi)
+       (fmt_opt pro $ hovbox 0 (str "(**" $ doc $ str "*)") $ epi)
 
 let docstring_epi ~standalone ~next ~epi ~floating =
   let epi = if Option.is_some next then force_newline else fmt_opt epi in

lib/Fmt_odoc.ml

@@ -372,20 +372,27 @@ let beginning_offset (conf : Conf.t) input =
     whitespace_count
   else min whitespace_count 1
 
-let fmt_parsed (conf : Conf.t) ~fmt_code ~input ~offset parsed =
+let fmt_parsed (conf : Conf.t) ?trailing_space ~fmt_code ~input ~offset
+    parsed =
   let open Fmt in
   let begin_offset = beginning_offset conf input in
   (* The offset is used to adjust the margin when formatting code blocks. *)
   let offset = offset + begin_offset in
   let fmt_code conf ~offset:offset' ~set_margin input =
     fmt_code conf ~offset:(offset + offset') ~set_margin input
   in
+  let trailing_space =
+    match trailing_space with
+    | Some sp -> sp
+    | None ->
+        fmt_if
+          (String.length input > 1 && String.ends_with_whitespace input)
+          space_break
+  in
   let fmt_parsed parsed =
     str (String.make begin_offset ' ')
     $ fmt_ast conf ~fmt_code parsed
-    $ fmt_if
-        (String.length input > 1 && String.ends_with_whitespace input)
-        (str " ")
+    $ trailing_space
   in
   match parsed with
   | _ when not conf.fmt_opts.parse_docstrings.v -> str input

lib/Fmt_odoc.mli

@@ -23,6 +23,7 @@ val fmt_ast :
 
 val fmt_parsed :
      Conf.t
+  -> ?trailing_space:Fmt.t
   -> fmt_code:fmt_code
   -> input:string
   -> offset:int

test/passing/tests/break_separators-after.ml.err

@@ -1 +0,0 @@
-Warning: tests/break_separators.ml:289 exceeds the margin

test/passing/tests/break_separators-after.ml.ref

@@ -287,7 +287,8 @@ let foooooooooooo =
 
 let foooooooooooo =
   { foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo
+    *)
     fooooooooooooooooooooooooooooo= fooooooooooooo;
     fooooooooooooo= foooooooooooooo }
 
@@ -381,6 +382,7 @@ let () =
   match x with
   | ( _,
       (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1
-         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 *)
+         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2
+      *)
       Some _ ) ->
       x

test/passing/tests/break_separators-after_docked.ml.err

@@ -1,2 +1 @@
-Warning: tests/break_separators.ml:324 exceeds the margin
-Warning: tests/break_separators.ml:334 exceeds the margin
+Warning: tests/break_separators.ml:335 exceeds the margin

test/passing/tests/break_separators-after_docked.ml.ref

@@ -322,7 +322,8 @@ let foooooooooooo =
 let foooooooooooo =
   {
     foooooooooooooo with
-    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo *)
+    (* foooooooooooooooo fooooooooooooooooooooooooo foooooooooooooooooooooo
+    *)
     fooooooooooooooooooooooooooooo= fooooooooooooo;
     fooooooooooooo= foooooooooooooo;
   }
@@ -430,6 +431,7 @@ let () =
   match x with
   | ( _,
       (* verrrrrrrrrrrrrrrrrrrrrrrry looooooooooooooooong line 1
-         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2 *)
+         veeeeeeeeeeeeeeeeeeeeeryyyy loooooooooooooooooong line 2
+      *)
       Some _ ) ->
       x

test/passing/tests/break_separators-before_docked.ml.err

@@ -1 +0,0 @@
-Warning: tests/break_separators.ml:324 exceeds the margin