Fix cinaps comment formatting to not change multiline string contents. (

#2463)

Rather than formatting comment code blocks into a string, and then converting that string back into an Fmt.t, we instead just generate the Fmt.t directly, which allows the styling to know about current indentation without needing to manually indent/unindent the formatted text.

CHANGES.md

@@ -19,6 +19,7 @@ profile. This started with version 0.26.0.
 - \* Consistent break after string constant argument (#2453, @Julow)
 - Fix invalid syntax generated with `ocp-indent-compat` (#2445, @Julow)
 - Fixed bug with attributes on sub-expressions of infix operators (#2459, @tdelvecchio-jsc)
+- \* Fix cinaps comment formatting to not change multiline string contents (#2463, @tdelvecchio-jsc)
 
 ## 0.26.1 (2023-09-15)
 

lib/Cmts.ml

@@ -547,16 +547,7 @@ module Cinaps = struct
 
   (** Comments enclosed in [(*$], [$*)] are formatted as code. *)
   let fmt ~cls code =
-    let wrap k = hvbox 2 (fmt "(*$" $ k $ fmt cls) in
-    match String.split_lines code with
-    | [] | [""] -> wrap (str " ")
-    | [line] -> wrap (fmt "@ " $ str line $ fmt "@;<1 -2>")
-    | lines ->
-        let fmt_line = function
-          | "" -> fmt "\n"
-          | line -> fmt "@\n" $ str line
-        in
-        wrap (list lines "" fmt_line $ fmt "@;<1000 -2>")
+    hvbox 0 (fmt "(*$" $ hvbox (-1) (fmt "@;" $ code) $ fmt "@;" $ fmt cls)
 end
 
 module Ocp_indent_compat = struct
@@ -608,12 +599,7 @@ let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos =
         let len = String.length str - if dollar_suf then 2 else 1 in
         let offset = offset + 1 in
         let source = String.sub ~pos:1 ~len str in
-        let source =
-          String.split_lines source
-          |> Cmt.unindent_lines ~offset
-          |> String.concat ~sep:"\n"
-        in
-        match fmt_code conf ~offset source with
+        match fmt_code conf ~offset ~set_margin:false source with
         | Ok formatted -> `Code (formatted, cls)
         | Error (`Msg _) -> `Unwrapped (str, None) )
     | txt when Char.equal txt.[0] '=' -> `Verbatim txt

lib/Fmt_ast.ml

@@ -4591,17 +4591,18 @@ let fmt_file (type a) ~ctx ~fmt_code ~debug (fragment : a Extended_ast.t)
          formatting doc. *)
       Fmt_odoc.fmt_ast c.conf ~fmt_code:c.fmt_code d
 
-let fmt_parse_result conf ~debug ast_kind ast source comments ~fmt_code =
+let fmt_parse_result conf ~debug ast_kind ast source comments
+    ~set_margin:set_margin_p ~fmt_code =
   let cmts = Cmts.init ast_kind ~debug source ast comments in
   let ctx = Top in
   let code =
-    set_margin conf.Conf.fmt_opts.margin.v
+    fmt_if_k set_margin_p (set_margin conf.Conf.fmt_opts.margin.v)
     $ fmt_file ~ctx ~debug ast_kind source cmts conf ast ~fmt_code
   in
-  Ok (Format_.asprintf "%a" Fmt.eval code)
+  Ok code
 
 let fmt_code ~debug =
-  let rec fmt_code (conf : Conf.t) ~offset s =
+  let rec fmt_code (conf : Conf.t) ~offset ~set_margin s =
     let {Conf.fmt_opts; _} = conf in
     let conf =
       (* Adjust margin according to [offset]. *)
@@ -4615,9 +4616,11 @@ let fmt_code ~debug =
         ~input_name ~source:s
     with
     | Either.First {ast; comments; source; prefix= _} ->
-        fmt_parse_result conf ~debug Use_file ast source comments ~fmt_code
+        fmt_parse_result conf ~debug Use_file ast source comments ~set_margin
+          ~fmt_code
     | Second {ast; comments; source; prefix= _} ->
-        fmt_parse_result conf ~debug Repl_file ast source comments ~fmt_code
+        fmt_parse_result conf ~debug Repl_file ast source comments
+          ~set_margin ~fmt_code
     | exception Syntaxerr.Error (Expecting (_, x)) when warn ->
         Error (`Msg (Format.asprintf "expecting: %s" x))
     | exception Syntaxerr.Error (Not_expecting (_, x)) when warn ->

lib/Fmt_odoc.ml

@@ -14,7 +14,11 @@ open Odoc_parser.Ast
 module Loc = Odoc_parser.Loc
 
 type fmt_code =
-  Conf.t -> offset:int -> string -> (string, [`Msg of string]) Result.t
+     Conf.t
+  -> offset:int
+  -> set_margin:bool
+  -> string
+  -> (Fmt.t, [`Msg of string]) Result.t
 
 type c = {fmt_code: fmt_code; conf: Conf.t}
 
@@ -119,8 +123,8 @@ let fmt_code_block c s1 s2 =
   match s1 with
   | Some ({value= "ocaml"; _}, _) | None -> (
     (* [offset] doesn't take into account code blocks nested into lists. *)
-    match c.fmt_code c.conf ~offset:2 original with
-    | Ok formatted -> fmt_code formatted
+    match c.fmt_code c.conf ~offset:2 ~set_margin:true original with
+    | Ok formatted -> formatted |> Format_.asprintf "%a" Fmt.eval |> fmt_code
     | Error (`Msg message) ->
         ( match message with
         | "" -> ()
@@ -356,8 +360,8 @@ let fmt_parsed (conf : Conf.t) ~fmt_code ~input ~offset parsed =
   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' input =
-    fmt_code conf ~offset:(offset + offset') input
+  let fmt_code conf ~offset:offset' ~set_margin input =
+    fmt_code conf ~offset:(offset + offset') ~set_margin input
   in
   let fmt_parsed parsed =
     str (String.make begin_offset ' ')

lib/Fmt_odoc.mli

@@ -12,7 +12,11 @@
 (** [offset] is the column at which the content of the comment begins. It is
     used to adjust the margin. *)
 type fmt_code =
-  Conf.t -> offset:int -> string -> (string, [`Msg of string]) Result.t
+     Conf.t
+  -> offset:int
+  -> set_margin:bool
+  -> string
+  -> (Fmt.t, [`Msg of string]) Result.t
 
 val fmt_ast : Conf.t -> fmt_code:fmt_code -> Odoc_parser.Ast.t -> Fmt.t
 

lib/Normalize_extended_ast.ml

@@ -11,10 +11,6 @@
 
 open Extended_ast
 
-let start_column loc =
-  let pos = loc.Location.loc_start in
-  pos.pos_cnum - pos.pos_bol
-
 let dedup_cmts fragment ast comments =
   let of_ast ast =
     let docs = ref (Set.empty (module Cmt)) in
@@ -53,12 +49,7 @@ let normalize_parse_result ast_kind ast comments =
     (normalize_comments (dedup_cmts ast_kind ast))
     comments
 
-let normalize_code conf (m : Ast_mapper.mapper) ~offset txt =
-  let txt =
-    String.split_lines txt
-    |> Cmt.unindent_lines ~offset
-    |> String.concat ~sep:"\n"
-  in
+let normalize_code conf (m : Ast_mapper.mapper) txt =
   let input_name = "<output>" in
   match Parse_with_comments.parse_toplevel conf ~input_name ~source:txt with
   | First {ast; comments; _} ->
@@ -97,7 +88,7 @@ let make_mapper conf ~ignore_doc_comments =
       when Ast.Attr.is_doc attr ->
         let normalize_code =
           (* Indentation is already stripped by odoc-parser. *)
-          normalize_code conf m ~offset:0
+          normalize_code conf m
         in
         let doc' = docstring conf ~normalize_code doc in
         Ast_mapper.default_mapper.attribute m
@@ -182,8 +173,7 @@ let diff ~f ~cmt_kind x y =
 let diff_docstrings c x y =
   let mapper = make_mapper c ~ignore_doc_comments:false in
   let docstring cmt =
-    let offset = start_column (Cmt.loc cmt) + 3 in
-    let normalize_code = normalize_code c mapper ~offset in
+    let normalize_code = normalize_code c mapper in
     docstring c ~normalize_code (Cmt.txt cmt)
   in
   let norm z =
@@ -212,8 +202,7 @@ let diff_cmts (conf : Conf.t) x y =
             let len = String.length str - chars_removed in
             let source = String.sub ~pos:1 ~len str in
             let loc = Cmt.loc z in
-            let offset = start_column loc + 3 in
-            Cmt.create_comment (normalize_code ~offset source) loc
+            Cmt.create_comment (normalize_code source) loc
           else norm_non_code z
     in
     Set.of_list (module Cmt.Comparator_no_loc) (List.map ~f z)

test/passing/tests/cinaps.ml.err

@@ -0,0 +1 @@
+Warning: tests/cinaps.ml:24 exceeds the margin

test/passing/tests/cinaps.ml.ref

@@ -22,7 +22,7 @@ let y = 2
   #use "import.cinaps" ;;
 
   List.iter all_fields ~f:(fun (name, type_) ->
-      printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ name )
+      printf "\nexternal get_%s\n  : unit -> %s = \"get_%s\"" name type_ name )
 *)
 external get_name : unit -> string = "get_name"
 

test/passing/tests/js_source.ml.ocp

@@ -10325,15 +10325,13 @@ let _ =
 
 (*$
   [%string {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
-  zzzzzzzzzzzzzzzzzzzzzzzzzzzz
-      |}]
+zzzzzzzzzzzzzzzzzzzzzzzzzzzz
+    |}]
 *)
 (*$*)
 
-(*$
-  {|
-        f|}
-*)
+(*$ {|
+         f|} *)
 
 let () =
   match () with

test/passing/tests/js_source.ml.ref

@@ -10325,15 +10325,13 @@ let _ =
 
 (*$
   [%string {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
-  zzzzzzzzzzzzzzzzzzzzzzzzzzzz
-      |}]
+zzzzzzzzzzzzzzzzzzzzzzzzzzzz
+    |}]
 *)
 (*$*)
 
-(*$
-  {|
-        f|}
-*)
+(*$ {|
+         f|} *)
 
 let () =
   match () with