From 2feaab1c33958830418f8fd7095c19d6879c787a Mon Sep 17 00:00:00 2001 From: Thomas Del Vecchio Date: Fri, 6 Oct 2023 11:54:13 -0400 Subject: [PATCH 1/3] Fix cinaps comment formatting to not change multiline string contents. --- lib/Cmts.ml | 18 ++---------------- lib/Fmt_ast.ml | 15 +++++++++------ lib/Fmt_odoc.ml | 14 +++++++++----- lib/Fmt_odoc.mli | 6 +++++- lib/Normalize_extended_ast.ml | 19 ++++--------------- test/passing/tests/cinaps.ml.err | 1 + test/passing/tests/cinaps.ml.ref | 2 +- test/passing/tests/js_source.ml.ocp | 10 ++++------ test/passing/tests/js_source.ml.ref | 10 ++++------ 9 files changed, 39 insertions(+), 56 deletions(-) diff --git a/lib/Cmts.ml b/lib/Cmts.ml index 1c104e2609..fce91b6465 100644 --- a/lib/Cmts.ml +++ b/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 diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 466d3cae99..2b77f9ab3f 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -4593,17 +4593,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 + (if set_margin_p then set_margin conf.Conf.fmt_opts.margin.v else noop) $ 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]. *) @@ -4617,9 +4618,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 -> diff --git a/lib/Fmt_odoc.ml b/lib/Fmt_odoc.ml index 79930b5d34..fba43892eb 100644 --- a/lib/Fmt_odoc.ml +++ b/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 ' ') diff --git a/lib/Fmt_odoc.mli b/lib/Fmt_odoc.mli index a5001e0cfc..e034afccc0 100644 --- a/lib/Fmt_odoc.mli +++ b/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 diff --git a/lib/Normalize_extended_ast.ml b/lib/Normalize_extended_ast.ml index 99f74d03a8..c7634794de 100644 --- a/lib/Normalize_extended_ast.ml +++ b/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 = "" 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) diff --git a/test/passing/tests/cinaps.ml.err b/test/passing/tests/cinaps.ml.err index e69de29bb2..6c128b0f94 100644 --- a/test/passing/tests/cinaps.ml.err +++ b/test/passing/tests/cinaps.ml.err @@ -0,0 +1 @@ +Warning: tests/cinaps.ml:24 exceeds the margin diff --git a/test/passing/tests/cinaps.ml.ref b/test/passing/tests/cinaps.ml.ref index 141ed76d1b..71fc3755f2 100644 --- a/test/passing/tests/cinaps.ml.ref +++ b/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" diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index 75df97a557..aff6550c56 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -10323,15 +10323,13 @@ let _ = (*$ [%string {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx - zzzzzzzzzzzzzzzzzzzzzzzzzzzz - |}] +zzzzzzzzzzzzzzzzzzzzzzzzzzzz + |}] *) (*$*) -(*$ - {| - f|} -*) +(*$ {| + f|} *) let () = match () with diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index 8ffad9be24..96ef370cd5 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -10323,15 +10323,13 @@ let _ = (*$ [%string {| xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx - zzzzzzzzzzzzzzzzzzzzzzzzzzzz - |}] +zzzzzzzzzzzzzzzzzzzzzzzzzzzz + |}] *) (*$*) -(*$ - {| - f|} -*) +(*$ {| + f|} *) let () = match () with From 1e3be04544085ddaff1168197751de4e8aa0961b Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Tue, 10 Oct 2023 13:52:03 +0800 Subject: [PATCH 2/3] simplify --- lib/Fmt_ast.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 2b77f9ab3f..3fe9c42d7f 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -4598,7 +4598,7 @@ let fmt_parse_result conf ~debug ast_kind ast source comments let cmts = Cmts.init ast_kind ~debug source ast comments in let ctx = Top in let code = - (if set_margin_p then set_margin conf.Conf.fmt_opts.margin.v else noop) + 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 code From c62f4eb1985241219c41b035afdc4920943d0749 Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Tue, 10 Oct 2023 13:57:58 +0800 Subject: [PATCH 3/3] changelog --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index 9e078cf01f..a0d9391dd2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -17,6 +17,7 @@ profile. This started with version 0.26.0. - Fix extension-point spacing in structures (#2450, @Julow) - \* Consistent break after string constant argument (#2453, @Julow) - Fix invalid syntax generated with `ocp-indent-compat` (#2445, @Julow) +- \* Fix cinaps comment formatting to not change multiline string contents (#2463, @tdelvecchio-jsc) ## 0.26.1 (2023-09-15)