New syntax (*= ... *) for verbatim comments

CHANGES.md

@@ -10,6 +10,8 @@
 
 #### New features
 
+  +  New syntax `(*= ... *)` for verbatim comments (#2028, @gpetiot)
+
 ### 0.21.0 (2022-02-25)
 
 #### Bug fixes

lib/Cmts.ml

@@ -533,47 +533,47 @@ module Unwrapped = struct
     in
     vbox 0 ~name:"multiline" (list_fl unindented fmt_line $ fmt_opt epi)
 
-  let fmt ~ocp_indent_compat Cmt.{txt= s; loc} (pos : Cmt.pos) =
+  let fmt Cmt.{txt= s; loc} =
     let open Fmt in
     let is_sp = function ' ' | '\t' -> true | _ -> false in
     match String.split_lines (String.rstrip s) with
     | first_line :: (_ :: _ as tl) when not (String.is_empty first_line) ->
-        if ocp_indent_compat then
-          (* Not adding artificial breaks and keeping the comment contents
-             verbatim will not interfere with ocp-indent. *)
-          match pos with
-          | Before -> wrap "(*" "*)" @@ str s
-          | Within -> wrap "(*" "*)" @@ str s
-          | After -> break_unless_newline 1000 0 $ wrap "(*" "*)" @@ str s
-        else
-          let epi =
-            (* Preserve position of closing but strip empty lines at the
-               end *)
-            match String.rfindi s ~f:(fun _ c -> not (is_sp c)) with
-            | Some i when Char.( = ) s.[i] '\n' ->
-                break 1000 (-2) (* Break before closing *)
-            | Some i when i < String.length s - 1 ->
-                str " " (* Preserve a space at the end *)
-            | _ -> noop
-          in
-          (* Preserve the first level of indentation *)
-          let starts_with_sp = is_sp first_line.[0] in
-          wrap "(*" "*)"
-          @@ fmt_multiline_cmt ~opn_pos:loc.loc_start ~epi ~starts_with_sp
-               first_line tl
+        let epi =
+          (* Preserve position of closing but strip empty lines at the end *)
+          match String.rfindi s ~f:(fun _ c -> not (is_sp c)) with
+          | Some i when Char.( = ) s.[i] '\n' ->
+              break 1000 (-2) (* Break before closing *)
+          | Some i when i < String.length s - 1 ->
+              str " " (* Preserve a space at the end *)
+          | _ -> noop
+        in
+        (* Preserve the first level of indentation *)
+        let starts_with_sp = is_sp first_line.[0] in
+        wrap "(*" "*)"
+        @@ fmt_multiline_cmt ~opn_pos:loc.loc_start ~epi ~starts_with_sp
+             first_line tl
     | _ -> wrap "(*" "*)" @@ str s
 end
 
+module Verbatim = struct
+  let fmt s (pos : Cmt.pos) =
+    let open Fmt in
+    fmt_if_k
+      (Poly.(pos = After) && String.contains s '\n')
+      (break_unless_newline 1000 0)
+    $ wrap "(*" "*)" @@ str s
+end
+
 let fmt_cmt (cmt : Cmt.t) ~wrap:wrap_comments ~ocp_indent_compat ~fmt_code
     pos =
   let mode =
     match cmt.txt with
     | "" -> impossible "not produced by parser"
     (* "(**)" is not parsed as a docstring but as a regular comment
        containing '*' and would be rewritten as "(***)" *)
-    | "*" when Location.width cmt.loc = 4 -> `Verbatim "(**)"
-    | "*" -> `Verbatim "(***)"
-    | "$" -> `Verbatim "(*$*)"
+    | "*" when Location.width cmt.loc = 4 -> `Verbatim ""
+    | "*" -> `Verbatim "*"
+    | "$" -> `Verbatim "$"
     | str when Char.equal str.[0] '$' -> (
         let dollar_suf = Char.equal str.[String.length str - 1] '$' in
         let cls : Fmt.s = if dollar_suf then "$*)" else "*)" in
@@ -582,21 +582,23 @@ let fmt_cmt (cmt : Cmt.t) ~wrap:wrap_comments ~ocp_indent_compat ~fmt_code
         match fmt_code source with
         | Ok formatted -> `Code (formatted, cls)
         | Error (`Msg _) -> `Unwrapped cmt )
+    | str when Char.equal str.[0] '=' -> `Verbatim cmt.txt
     | _ -> (
       match Asterisk_prefixed.split cmt with
       | [] | [""] -> impossible "not produced by split_asterisk_prefixed"
-      | [""; ""] -> `Verbatim "(* *)"
+      | [""; ""] -> `Verbatim " "
       | [text] when wrap_comments -> `Wrapped (text, "*)")
       | [text; ""] when wrap_comments -> `Wrapped (text, " *)")
       | [_] | [_; ""] -> `Unwrapped cmt
       | lines -> `Asterisk_prefixed lines )
   in
   let open Fmt in
   match mode with
-  | `Verbatim x -> str x
+  | `Verbatim x -> Verbatim.fmt x pos
   | `Code (x, cls) -> hvbox 2 @@ wrap "(*$@;" cls (x $ fmt "@;<1 -2>")
   | `Wrapped (x, epi) -> str "(*" $ fill_text x ~epi
-  | `Unwrapped x -> Unwrapped.fmt ~ocp_indent_compat x pos
+  | `Unwrapped x when ocp_indent_compat -> Verbatim.fmt x.txt pos
+  | `Unwrapped x -> Unwrapped.fmt x
   | `Asterisk_prefixed x -> Asterisk_prefixed.fmt x
 
 let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos =

test/passing/dune.inc

@@ -5023,6 +5023,42 @@
  (package ocamlformat)
  (action (diff tests/use_file.mlt.err use_file.mlt.stderr)))
 
+(rule
+ (deps tests/.ocamlformat )
+ (package ocamlformat)
+ (action
+  (with-stdout-to verbatim_comments-wrap.ml.stdout
+   (with-stderr-to verbatim_comments-wrap.ml.stderr
+     (run %{bin:ocamlformat} --margin-check --wrap-comments %{dep:tests/verbatim_comments.ml})))))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/verbatim_comments-wrap.ml.ref verbatim_comments-wrap.ml.stdout)))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/verbatim_comments-wrap.ml.err verbatim_comments-wrap.ml.stderr)))
+
+(rule
+ (deps tests/.ocamlformat )
+ (package ocamlformat)
+ (action
+  (with-stdout-to verbatim_comments.ml.stdout
+   (with-stderr-to verbatim_comments.ml.stderr
+     (run %{bin:ocamlformat} --margin-check %{dep:tests/verbatim_comments.ml})))))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/verbatim_comments.ml.ref verbatim_comments.ml.stdout)))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/verbatim_comments.ml.err verbatim_comments.ml.stderr)))
+
 (rule
  (deps tests/.ocamlformat )
  (enabled_if (<> %{os_type} Win32))

test/passing/tests/verbatim_comments-wrap.ml.opts

@@ -0,0 +1 @@
+--wrap-comments

test/passing/tests/verbatim_comments-wrap.ml.ref

@@ -0,0 +1,23 @@
+(*= Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* [...]
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+[...] *)
+
+let _ =
+  (*= Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* [...]
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+[...] *)
+  ()

test/passing/tests/verbatim_comments.ml

@@ -0,0 +1,23 @@
+(*= Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* [...]
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+[...] *)
+
+let _ =
+  (*= Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* [...]
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+[...] *)
+  ()

test/passing/tests/verbatim_comments.ml.ref

@@ -0,0 +1,23 @@
+(*= Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* [...]
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+[...] *)
+
+let _ =
+  (*= Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* [...]
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+[...] *)
+  ()