Fix 'wrap-comments' not working with the janestreet profile (#2645)

Fix asterisk-prefixed comments and the wrap-comments option

Asterisk-prefixed comments were recognized as documentation with the
janestreet profile and the wrap-comments option didn't have an effect.

Author: Julow

CHANGES.md

@@ -4,6 +4,14 @@ Items marked with an asterisk (\*) are changes that are likely to format
 existing code differently from the previous release when using the default
 profile. This started with version 0.26.0.
 
+## unreleased
+
+### Fixed
+
+- Fixed `wrap-comments=true` not working with the janestreet profile (#2645, @Julow)
+  Asterisk-prefixed comments are also now formatted the same way as with the
+  default profile.
+
 ## 0.27.0
 
 ### Highlight

lib/Cmt.ml

@@ -146,7 +146,7 @@ let split_asterisk_prefixed =
 
 let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}
 
-let decode_comment ~parse_comments_as_doc txt loc =
+let decode_comment txt loc =
   let txt =
     (* Windows compatibility *)
     let f = function '\r' -> false | _ -> true in
@@ -170,7 +170,6 @@ let decode_comment ~parse_comments_as_doc txt loc =
     | '=' -> mk (Verbatim txt)
     | _ when is_all_whitespace txt ->
         mk (Verbatim " ") (* Make sure not to format to [(**)]. *)
-    | _ when parse_comments_as_doc -> mk (Doc txt)
     | _ -> (
         let lines =
           let content_offset = opn_offset + 2 in
@@ -194,6 +193,6 @@ let decode_docstring _loc = function
   | "\n" | " " -> mk (Verbatim " ")
   | txt -> mk ~prefix:"*" (Doc txt)
 
-let decode ~parse_comments_as_doc = function
-  | Comment {txt; loc} -> decode_comment ~parse_comments_as_doc txt loc
+let decode = function
+  | Comment {txt; loc} -> decode_comment txt loc
   | Docstring {txt; loc} -> decode_docstring loc txt

lib/Cmt.mli

@@ -48,4 +48,4 @@ type decoded =
   ; suffix: string  (** Just before the closing. *)
   ; kind: decoded_kind }
 
-val decode : parse_comments_as_doc:bool -> t -> decoded
+val decode : t -> decoded

lib/Cmts.ml

@@ -581,18 +581,22 @@ end
 
 let fmt_cmt (conf : Conf.t) cmt ~fmt_code =
   let open Fmt in
-  let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in
-  let decoded = Cmt.decode ~parse_comments_as_doc cmt in
+  let decoded = Cmt.decode cmt in
   (* TODO: Offset should be computed from location. *)
   let offset = 2 + String.length decoded.prefix in
   let pro = str "(*" $ str decoded.prefix
   and epi = str decoded.suffix $ str "*)" in
+  let fmt_doc txt =
+    Doc.fmt ~pro ~epi ~fmt_code conf ~loc:(Cmt.loc cmt) txt ~offset
+  in
   match decoded.kind with
   | Verbatim txt -> Verbatim.fmt ~pro ~epi txt
-  | Doc txt ->
-      Doc.fmt ~pro ~epi ~fmt_code conf ~loc:(Cmt.loc cmt) txt ~offset
+  | Doc txt -> fmt_doc txt
   | Normal txt ->
-      if conf.fmt_opts.wrap_comments.v then Wrapped.fmt ~pro ~epi txt
+      if
+        conf.fmt_opts.ocp_indent_compat.v && conf.fmt_opts.parse_docstrings.v
+      then fmt_doc txt
+      else if conf.fmt_opts.wrap_comments.v then Wrapped.fmt ~pro ~epi txt
       else Unwrapped.fmt ~pro ~epi txt
   | Code code -> Cinaps.fmt ~pro ~epi ~fmt_code conf ~offset code
   | Asterisk_prefixed lines -> Asterisk_prefixed.fmt ~pro ~epi lines

lib/Normalize_extended_ast.ml

@@ -152,14 +152,18 @@ let make_mapper ~ignore_doc_comments ~normalize_doc =
   ; typ }
 
 let normalize_cmt (conf : Conf.t) =
-  let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in
+  let parse_comments_as_doc =
+    conf.fmt_opts.ocp_indent_compat.v && conf.fmt_opts.parse_docstrings.v
+  in
   object (self)
     method cmt c =
-      let decoded = Cmt.decode ~parse_comments_as_doc c in
+      let decoded = Cmt.decode c in
       match decoded.Cmt.kind with
       | Verbatim txt -> txt
       | Doc txt -> self#doc txt
-      | Normal txt -> Docstring.normalize_text txt
+      | Normal txt ->
+          if parse_comments_as_doc then self#doc txt
+          else Docstring.normalize_text txt
       | Code txt -> self#code txt
       | Asterisk_prefixed lines ->
           String.concat ~sep:" " (List.map ~f:Docstring.normalize_text lines)

test/passing/refs.janestreet/comment_header.ml.ref

@@ -45,7 +45,7 @@ type typ = typ
 
 (* TEST
   arguments = "???"
-*)
+  *)
 
 (* On Windows the runtime expand windows wildcards (asterisks and
  * question marks).
@@ -57,4 +57,4 @@ type typ = typ
  *
  * The source code of this test is empty: we just check the arguments
  * expansion.
- * *)
+ *)

test/passing/refs.janestreet/comments-no-wrap.ml.ref

@@ -483,13 +483,13 @@ let _ =
   *)
   ();
   (* indentation preserved
-  *)
+   *)
   ();
   (* indentation preserved
-  *)
+     *)
   ();
   (* indentation not preserved
-  *)
+*)
   ()
 ;;
 

test/passing/refs.janestreet/comments.ml.ref

@@ -483,13 +483,13 @@ let _ =
   *)
   ();
   (* indentation preserved
-  *)
+   *)
   ();
   (* indentation preserved
-  *)
+     *)
   ();
   (* indentation not preserved
-  *)
+*)
   ()
 ;;
 

test/passing/refs.janestreet/doc_comments-after.ml.ref

@@ -257,8 +257,8 @@ module A = struct
 end
 
 (* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
-* we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
-* processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
+ * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
+ * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
 let _ = ()
 
 (** Tags without text *)

test/passing/refs.janestreet/doc_comments-before-except-val.ml.ref

@@ -257,8 +257,8 @@ module A = struct
 end
 
 (* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
-* we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
-* processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
+ * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
+ * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
 let _ = ()
 
 (** Tags without text *)

test/passing/refs.janestreet/doc_comments-before.ml.ref

@@ -257,8 +257,8 @@ module A = struct
 end
 
 (* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
-* we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
-* processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
+ * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
+ * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
 let _ = ()
 
 (** Tags without text *)

test/passing/refs.janestreet/doc_comments.ml.ref

@@ -257,8 +257,8 @@ module A = struct
 end
 
 (* Same with get_pure, except that when we have both "x = t" and "y = t" where t is a primed ident,
-* we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
-* processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
+ * we add "x = y" to the result. This is crucial for the normalizer, as it tend to drop "x = t" before
+ * processing "y = t". If we don't explicitly preserve "x = y", the normalizer cannot pick it up *)
 let _ = ()
 
 (** Tags without text *)

test/passing/refs.janestreet/source.ml.ref

@@ -1664,7 +1664,7 @@ let smaller : type a b. (a succ, b succ) le -> (a, b) le = function
 type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
 
 (*
-   let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
+let rec diff : type a b. (a,b) le -> a nat -> b nat -> (a,b) diff =
   fun le a b ->
   match a, b, le with
   | NZ, m, _ -> Diff (m, PlusZ m)
@@ -5901,7 +5901,7 @@ module C : sig module L : module type of List end = A
 include D'
 
 (*
-   let () =
+let () =
   print_endline (Int.to_string D'.M.y)
 *)
 open A
@@ -6528,7 +6528,7 @@ end = struct
   type refer = { poly : 'a 'b 'c. (('b, 'c) #Classdef.cl2 as 'a) }
 end
 (*
-   ocamlc -c pr3918a.mli pr3918b.mli
+  ocamlc -c pr3918a.mli pr3918b.mli
   rm -f pr3918a.cmi
   ocamlc -c pr3918c.ml
 *)
@@ -7410,7 +7410,7 @@ let _ =
 (* Early strict evaluation *)
 
 (*
-   module rec Cyclic
+module rec Cyclic
   : sig val x : int end
   = struct let x = Cyclic.x + 1 end
 ;;
@@ -7507,7 +7507,7 @@ end
 (* Wrong LHS signatures (PR#4336) *)
 
 (*
-   module type ASig = sig type a val a:a val print:a -> unit end
+module type ASig = sig type a val a:a val print:a -> unit end
 module type BSig = sig type b val b:b val print:b -> unit end
 
 module A = struct type a = int let a = 0 let print = print_int end
@@ -7519,6 +7519,7 @@ module MakeB (Empty:sig end) : BSig = B
 module
    rec NewA : ASig = MakeA (struct end)
    and NewB : BSig with type b = NewA.a = MakeB (struct end);;
+
 *)
 
 (* Expressions and bindings *)

test/passing/refs.janestreet/unicode.ml.err

@@ -1,4 +1,2 @@
-Warning: unicode.ml:2 exceeds the margin
-Warning: unicode.ml:4 exceeds the margin
-Warning: unicode.ml:6 exceeds the margin
-Warning: unicode.ml:8 exceeds the margin
+Warning: unicode.ml:5 exceeds the margin
+Warning: unicode.ml:11 exceeds the margin

test/passing/refs.janestreet/unicode.ml.ref

@@ -1,9 +1,13 @@
 (* Don't edit this file with an editor that perform unicode normalization *)
 
-(* normal78901234567890123456789012345678901234567890123456789012345678901 a bū c d e*)
+(* normal78901234567890123456789012345678901234567890123456789012345678901 a bū
+   c d e*)
 
-(* modifier901234567890123456789012345678901234567890123456789012345678901 a bū̃ c d e*)
+(* modifier901234567890123456789012345678901234567890123456789012345678901 a bū̃
+   c d e*)
 
-(* 12345678901234567890123456789012345678901234567890123456789012345678901 a yo c d e*)
+(* 12345678901234567890123456789012345678901234567890123456789012345678901 a yo
+   c d e*)
 
-(* 12345678901234567890123456789012345678901234567890123456789012345678901 a y̲o c d e*)
+(* 12345678901234567890123456789012345678901234567890123456789012345678901 a y̲o
+   c d e*)

test/passing/refs.janestreet/wrap_comments.ml.err

@@ -1,5 +1,4 @@
-Warning: wrap_comments.ml:4 exceeds the margin
-Warning: wrap_comments.ml:85 exceeds the margin
+Warning: wrap_comments.ml:72 exceeds the margin
+Warning: wrap_comments.ml:213 exceeds the margin
 Warning: wrap_comments.ml:224 exceeds the margin
-Warning: wrap_comments.ml:235 exceeds the margin
-Warning: wrap_comments.ml:254 exceeds the margin
+Warning: wrap_comments.ml:243 exceeds the margin