diff --git a/lib/Cmts.ml b/lib/Cmts.ml index 5d6cb25d5e..f6d94b4e37 100644 --- a/lib/Cmts.ml +++ b/lib/Cmts.ml @@ -599,7 +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 - match fmt_code conf ~offset source with + match fmt_code conf ~offset source ~set_margin:false 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 c90736da3b..572fa7b726 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -4593,14 +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 = fmt_file ~ctx ~debug ast_kind source cmts conf ast ~fmt_code in + let code = + (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 code let fmt_code ~debug = - let rec fmt_code (conf : Conf.t) ~offset s = + let rec fmt_code (conf : Conf.t) ~offset s ~set_margin = let {Conf.fmt_opts; _} = conf in let conf = (* Adjust margin according to [offset]. *) @@ -4614,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 a7dbc73211..872585bc9f 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 -> (Fmt.t, [`Msg of string]) Result.t + Conf.t + -> offset:int + -> string + -> set_margin:bool + -> (Fmt.t, [`Msg of string]) Result.t type c = {fmt_code: fmt_code; conf: Conf.t} @@ -119,12 +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 -> - set_margin c.conf.fmt_opts.margin.v - $ formatted - |> Format_.asprintf "%a" Fmt.eval - |> fmt_code + match c.fmt_code c.conf ~offset:2 original ~set_margin:true with + | Ok formatted -> formatted |> Format_.asprintf "%a" Fmt.eval |> fmt_code | Error (`Msg message) -> ( match message with | "" -> () diff --git a/lib/Fmt_odoc.mli b/lib/Fmt_odoc.mli index c72c80d9d4..3c2df8443b 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 -> (Fmt.t, [`Msg of string]) Result.t + Conf.t + -> offset:int + -> string + -> set_margin:bool + -> (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/test/passing/tests/doc_comments-no-wrap.mli.err b/test/passing/tests/doc_comments-no-wrap.mli.err index f136799c7a..49df9d7f4b 100644 --- a/test/passing/tests/doc_comments-no-wrap.mli.err +++ b/test/passing/tests/doc_comments-no-wrap.mli.err @@ -10,13 +10,11 @@ Warning: tests/doc_comments.mli:124 exceeds the margin Warning: tests/doc_comments.mli:328 exceeds the margin Warning: tests/doc_comments.mli:377 exceeds the margin Warning: tests/doc_comments.mli:384 exceeds the margin -Warning: tests/doc_comments.mli:403 exceeds the margin -Warning: tests/doc_comments.mli:408 exceeds the margin -Warning: tests/doc_comments.mli:449 exceeds the margin -Warning: tests/doc_comments.mli:463 exceeds the margin -Warning: tests/doc_comments.mli:520 exceeds the margin -Warning: tests/doc_comments.mli:550 exceeds the margin -Warning: tests/doc_comments.mli:620 exceeds the margin +Warning: tests/doc_comments.mli:451 exceeds the margin +Warning: tests/doc_comments.mli:465 exceeds the margin +Warning: tests/doc_comments.mli:522 exceeds the margin +Warning: tests/doc_comments.mli:552 exceeds the margin Warning: tests/doc_comments.mli:622 exceeds the margin -Warning: tests/doc_comments.mli:643 exceeds the margin -Warning: tests/doc_comments.mli:656 exceeds the margin +Warning: tests/doc_comments.mli:624 exceeds the margin +Warning: tests/doc_comments.mli:645 exceeds the margin +Warning: tests/doc_comments.mli:658 exceeds the margin diff --git a/test/passing/tests/doc_comments-no-wrap.mli.ref b/test/passing/tests/doc_comments-no-wrap.mli.ref index e9a69f01dc..bf0cfed150 100644 --- a/test/passing/tests/doc_comments-no-wrap.mli.ref +++ b/test/passing/tests/doc_comments-no-wrap.mli.ref @@ -401,12 +401,14 @@ end #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 ) ]} *) (** {[ 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 ) ]} *) (** {[ diff --git a/test/passing/tests/doc_comments.mli.err b/test/passing/tests/doc_comments.mli.err index a7ea1f941b..db9ce31256 100644 --- a/test/passing/tests/doc_comments.mli.err +++ b/test/passing/tests/doc_comments.mli.err @@ -10,13 +10,11 @@ Warning: tests/doc_comments.mli:124 exceeds the margin Warning: tests/doc_comments.mli:328 exceeds the margin Warning: tests/doc_comments.mli:377 exceeds the margin Warning: tests/doc_comments.mli:384 exceeds the margin -Warning: tests/doc_comments.mli:403 exceeds the margin -Warning: tests/doc_comments.mli:408 exceeds the margin -Warning: tests/doc_comments.mli:449 exceeds the margin -Warning: tests/doc_comments.mli:463 exceeds the margin -Warning: tests/doc_comments.mli:520 exceeds the margin -Warning: tests/doc_comments.mli:550 exceeds the margin -Warning: tests/doc_comments.mli:614 exceeds the margin +Warning: tests/doc_comments.mli:451 exceeds the margin +Warning: tests/doc_comments.mli:465 exceeds the margin +Warning: tests/doc_comments.mli:522 exceeds the margin +Warning: tests/doc_comments.mli:552 exceeds the margin Warning: tests/doc_comments.mli:616 exceeds the margin -Warning: tests/doc_comments.mli:637 exceeds the margin -Warning: tests/doc_comments.mli:650 exceeds the margin +Warning: tests/doc_comments.mli:618 exceeds the margin +Warning: tests/doc_comments.mli:639 exceeds the margin +Warning: tests/doc_comments.mli:652 exceeds the margin diff --git a/test/passing/tests/doc_comments.mli.ref b/test/passing/tests/doc_comments.mli.ref index 2072d07ef8..04cdb10d17 100644 --- a/test/passing/tests/doc_comments.mli.ref +++ b/test/passing/tests/doc_comments.mli.ref @@ -401,12 +401,14 @@ end #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 ) ]} *) (** {[ 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 ) ]} *) (** {[