From 6547720290dd17e63b3e605d709b68fdd8422e57 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Fri, 22 Sep 2023 14:58:46 +0200 Subject: [PATCH] Do not break before non-simple strings Allow non-simple string to be at the end of a group. This formats printf-style functions in a nicer way. --- lib/Ast.ml | 3 ++- lib/Cmt.ml | 3 +-- lib/Cmts.ml | 3 +-- lib/Conf.ml | 9 +++------ lib/Conf_decl.ml | 18 ++++++------------ lib/Docstring.ml | 3 +-- lib/Fmt_ast.ml | 12 +++++++++++- lib/Source.ml | 3 +-- lib/Translation_unit.ml | 3 +-- test/passing/tests/args_grouped.ml | 9 +++------ .../tests/break_infix-fit-or-vertical.ml.ref | 6 ++---- test/passing/tests/break_infix-wrap.ml.ref | 6 ++---- test/passing/tests/break_infix.ml.ref | 6 ++---- .../passing/tests/doc_comments-no-wrap.mli.err | 14 +++++++------- .../passing/tests/doc_comments-no-wrap.mli.ref | 6 ++---- test/passing/tests/doc_comments.mli.err | 14 +++++++------- test/passing/tests/doc_comments.mli.ref | 6 ++---- test/passing/tests/source.ml.ref | 3 +-- test/unit/test_eol_compat.ml | 12 ++++-------- test/unit/test_translation_unit.ml | 6 ++---- 20 files changed, 61 insertions(+), 84 deletions(-) diff --git a/lib/Ast.ml b/lib/Ast.ml index d5699c8d89..d4a06c9e4e 100644 --- a/lib/Ast.ml +++ b/lib/Ast.ml @@ -1486,7 +1486,8 @@ end = struct | Pexp_constant {pconst_desc= Pconst_string (_, _, Some _); _} -> false (* Only strings fitting on the line are simple. *) | Pexp_constant {pconst_desc= Pconst_string (_, loc, None); _} -> - Exp.is_trivial exp || (Location.height loc = 1 && fit_margin c (width xexp)) + Exp.is_trivial exp + || (Location.height loc = 1 && fit_margin c (width xexp)) | Pexp_constant _ -> true | Pexp_field _ | Pexp_ident _ | Pexp_send _ |Pexp_construct (_, None) diff --git a/lib/Cmt.ml b/lib/Cmt.ml index 2c221d3f20..ad66026736 100644 --- a/lib/Cmt.ml +++ b/lib/Cmt.ml @@ -60,8 +60,7 @@ let pp_error fs {kind; cmt_kind} = in match kind with | `Added x -> - Format.fprintf fs - "%!@{%a@}:@,@{Error@}: %s %a added.\n%!" + Format.fprintf fs "%!@{%a@}:@,@{Error@}: %s %a added.\n%!" Location.print_loc (loc x) s_kind pp_cmt x | `Dropped x -> Format.fprintf fs diff --git a/lib/Cmts.ml b/lib/Cmts.ml index 3de86caba4..25b7353e81 100644 --- a/lib/Cmts.ml +++ b/lib/Cmts.ml @@ -303,8 +303,7 @@ let rec place t loc_tree ?prev_loc ?deep_loc locs cmts = (** Relocate comments, for Ast transformations such as sugaring. *) let relocate (t : t) ~src ~before ~after = if t.debug then - Format.eprintf - "relocate %a to %a and %a@\n%!" + Format.eprintf "relocate %a to %a and %a@\n%!" Location.fmt src Location.fmt before Location.fmt after ; let merge_and_sort x y = List.rev_append x y diff --git a/lib/Conf.ml b/lib/Conf.ml index d686c9b5cb..bfd5fabe05 100644 --- a/lib/Conf.ml +++ b/lib/Conf.ml @@ -39,8 +39,7 @@ let warn ~loc fmt = Format.kasprintf (fun s -> warn_raw - (Format.asprintf - "%!@{%a@}:@,@{Warning@}: %s\n%!" + (Format.asprintf "%!@{%a@}:@,@{Warning@}: %s\n%!" Location.print_loc loc s ) ) fmt @@ -872,8 +871,7 @@ module Formatting = struct ; Decl.Value.make ~name:"space" `Space "$(b,space) prints a space inside the delimiter to indicate the \ matching one is on a different line." - ; Decl.Value.make - ~name:"closing-on-separate-line" + ; Decl.Value.make ~name:"closing-on-separate-line" `Closing_on_separate_line "$(b, closing-on-separate-line) makes sure that the closing \ delimiter is on its own line." ] @@ -1536,8 +1534,7 @@ let parse_attr {attr_name= {txt; loc= _}; attr_payload; _} = | _ when String.is_prefix ~prefix:"ocamlformat." txt -> Error (`Msg - (Format.sprintf - "Invalid format: Unknown suffix %S" + (Format.sprintf "Invalid format: Unknown suffix %S" (String.chop_prefix_exn ~prefix:"ocamlformat." txt) ) ) | _ -> Error `Ignore diff --git a/lib/Conf_decl.ml b/lib/Conf_decl.ml index 39cfeff219..a4d6a12e1c 100644 --- a/lib/Conf_decl.ml +++ b/lib/Conf_decl.ml @@ -163,13 +163,11 @@ let in_attributes cond = function let maybe_empty = function "" -> "" | x -> " " ^ x let pp_deprecated ppf {dmsg; dversion= v} = - Format.fprintf ppf - "This option is deprecated since version %a.%s" + Format.fprintf ppf "This option is deprecated since version %a.%s" Version.pp v (maybe_empty dmsg) let pp_removed ppf {rmsg; rversion= v} = - Format.fprintf ppf - "This option has been removed in version %a.%s" + Format.fprintf ppf "This option has been removed in version %a.%s" Version.pp v (maybe_empty rmsg) let pp_from_src fs = function @@ -189,8 +187,7 @@ let rec pp_from fs = function | `Profile (s, p) -> Format.fprintf fs " (profile %s%a)" s pp_from_src p | `Updated (x, None) -> pp_from_src fs x | `Updated (x, Some r) -> - Format.fprintf fs - "%a -- Warning (redundant): %a" + Format.fprintf fs "%a -- Warning (redundant): %a" pp_from_src x pp_from r let loc_udapted_from = function @@ -211,8 +208,7 @@ let status_doc ppf = function let generated_flag_doc ~allow_inline ~doc ~kind ~default ~status = let default = if default then "set" else "unset" in - Format.asprintf - "%s The flag is $(b,%s) by default.%s%a" + Format.asprintf "%s The flag is $(b,%s) by default.%s%a" doc default (in_attributes allow_inline kind) status_doc status @@ -222,8 +218,7 @@ let generated_doc conv ~allow_inline ~doc ~kind ~default ~status = let default = if String.is_empty default_doc then "none" else default_doc in - Format.asprintf - "%s The default value is $(b,%s).%s%a" + Format.asprintf "%s The default value is $(b,%s).%s%a" doc default (in_attributes allow_inline kind) status_doc status @@ -332,8 +327,7 @@ module Value = struct | Some x -> (name, value, doc, `Deprecated x) let pp_deprecated s ppf {dmsg= msg; dversion= v} = - Format.fprintf ppf - "Value `%s` is deprecated since version %a. %s" + Format.fprintf ppf "Value `%s` is deprecated since version %a. %s" s Version.pp v msg let pp_deprecated_with_name ~opt ~val_ ppf {dmsg= msg; dversion= v} = diff --git a/lib/Docstring.ml b/lib/Docstring.ml index 747b6b57d8..0acd0f9f65 100644 --- a/lib/Docstring.ml +++ b/lib/Docstring.ml @@ -24,8 +24,7 @@ let parse_file location text = Odoc_parser.ast (Odoc_parser.parse_comment ~location ~text) let warn fmt warning = - Format.fprintf fmt - "Warning: Invalid documentation comment:@,%s\n%!" + Format.fprintf fmt "Warning: Invalid documentation comment:@,%s\n%!" (Odoc_parser.Warning.to_string warning) let is_tag_only = diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 26ee389b70..b6418f3b5a 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -1471,8 +1471,18 @@ and fmt_args_grouped ?epi:(global_epi = noop) c ctx args = let xexp = sub_exp ~ctx x in is_simple c.conf (expression_width c) xexp in + let should_break_after x = not (is_simple x) + and should_break_before ((_lbl, exp) as y) = + match exp.pexp_desc with + (* Heavy syntax strings are not grouped. *) + | Pexp_constant {pconst_desc= Pconst_string (_, _, Some _); _} -> true + (* Non-simple strings are grouped but end a group. *) + | Pexp_constant {pconst_desc= Pconst_string (_, _, None); _} -> false + | _ -> not (is_simple y) + in let break x y = - Cmts.has_after c.cmts (snd x).pexp_loc || not (is_simple x && is_simple y) + Cmts.has_after c.cmts (snd x).pexp_loc + || should_break_after x || should_break_before y in let groups = if c.conf.fmt_opts.wrap_fun_args.v then List.group args ~break diff --git a/lib/Source.ml b/lib/Source.ml index 3b610d71f0..bb234a292d 100644 --- a/lib/Source.ml +++ b/lib/Source.ml @@ -105,8 +105,7 @@ let extend_loc_to_include_attributes (loc : Location.t) (l : attributes) = {loc with loc_end= {loc.loc_end with pos_cnum= loc_end.loc_end.pos_cnum}} let string_literal t mode loc = - Option.value_exn - ~message:"Parse error while reading string literal" + Option.value_exn ~message:"Parse error while reading string literal" (Literal_lexer.string mode (string_at t loc)) let begins_line ?(ignore_spaces = true) t (l : Location.t) = diff --git a/lib/Translation_unit.ml b/lib/Translation_unit.ml index 072b7ac47f..842bd5fde0 100644 --- a/lib/Translation_unit.ml +++ b/lib/Translation_unit.ml @@ -55,8 +55,7 @@ module Error = struct Out_channel.write_all n ~data:next ; ignore (Stdlib.Sys.command - (Printf.sprintf - "git diff --no-index -u %S %S | sed '1,4d' 1>&2" + (Printf.sprintf "git diff --no-index -u %S %S | sed '1,4d' 1>&2" p n ) ) ; Stdlib.Sys.remove p ; Stdlib.Sys.remove n diff --git a/test/passing/tests/args_grouped.ml b/test/passing/tests/args_grouped.ml index f702fdd993..557710a46a 100644 --- a/test/passing/tests/args_grouped.ml +++ b/test/passing/tests/args_grouped.ml @@ -43,8 +43,7 @@ let bottom_up fooooooooooo = let empty = Int.equal 0 !scheduled && Queue.is_empty pending in if empty then ( remaining := 0 ; - L.progress - "Finished call graph scheduling, %d procs remaining (in, or reaching, cycles).@." + L.progress "Finished call graph scheduling, %d procs remaining (in, or reaching, cycles).@." (CallGraph.n_procs syntactic_call_graph) ; if Config.debug_level_analysis > 0 then CallGraph.to_dotty syntactic_call_graph "cycles.dot" ; foooooooooooooooooo ) @@ -81,16 +80,14 @@ let f = ~y let eradicate_meta_class_is_nullsafe = - register - ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" + register ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" ~hum:"Class is marked @Nullsafe and has 0 issues" (* Should be enabled for special integrations *) ~enabled:false Info Eradicate (* TODO *) ~user_documentation:"" let eradicate_meta_class_is_nullsafe = - register - ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" (* Should be enabled for special integrations *) + register ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" (* Should be enabled for special integrations *) ~hum:"Class is marked @Nullsafe and has 0 issues" (* Should be enabled for special integrations *) ~enabled:false Info diff --git a/test/passing/tests/break_infix-fit-or-vertical.ml.ref b/test/passing/tests/break_infix-fit-or-vertical.ml.ref index 7ffc4959e0..7aa7824b43 100644 --- a/test/passing/tests/break_infix-fit-or-vertical.ml.ref +++ b/test/passing/tests/break_infix-fit-or-vertical.ml.ref @@ -108,8 +108,7 @@ let term = & pos 0 (some (enum modes)) None & info [] ~docv:"ACTION" ~doc: - (Printf.sprintf - "The cache-daemon action to perform (%s)" + (Printf.sprintf "The cache-daemon action to perform (%s)" (Arg.doc_alts_enum modes) ) ) in (config, mode) @@ -124,8 +123,7 @@ let term = & pos 0 (some (enum modes)) None & info [] ~docv:"ACTION" ~doc: - (Printf.sprintf - "The cache-daemon action to perform (%s)" + (Printf.sprintf "The cache-daemon action to perform (%s)" (Arg.doc_alts_enum modes) ) ) in (config, mode) diff --git a/test/passing/tests/break_infix-wrap.ml.ref b/test/passing/tests/break_infix-wrap.ml.ref index 7ece143509..3b2545994f 100644 --- a/test/passing/tests/break_infix-wrap.ml.ref +++ b/test/passing/tests/break_infix-wrap.ml.ref @@ -65,8 +65,7 @@ let term = & pos 0 (some (enum modes)) None & info [] ~docv:"ACTION" ~doc: - (Printf.sprintf - "The cache-daemon action to perform (%s)" + (Printf.sprintf "The cache-daemon action to perform (%s)" (Arg.doc_alts_enum modes) ) ) in (config, mode) @@ -81,8 +80,7 @@ let term = & pos 0 (some (enum modes)) None & info [] ~docv:"ACTION" ~doc: - (Printf.sprintf - "The cache-daemon action to perform (%s)" + (Printf.sprintf "The cache-daemon action to perform (%s)" (Arg.doc_alts_enum modes) ) ) in (config, mode) diff --git a/test/passing/tests/break_infix.ml.ref b/test/passing/tests/break_infix.ml.ref index f81a90c656..71a79f5806 100644 --- a/test/passing/tests/break_infix.ml.ref +++ b/test/passing/tests/break_infix.ml.ref @@ -97,8 +97,7 @@ let term = & pos 0 (some (enum modes)) None & info [] ~docv:"ACTION" ~doc: - (Printf.sprintf - "The cache-daemon action to perform (%s)" + (Printf.sprintf "The cache-daemon action to perform (%s)" (Arg.doc_alts_enum modes) ) ) in (config, mode) @@ -113,8 +112,7 @@ let term = & pos 0 (some (enum modes)) None & info [] ~docv:"ACTION" ~doc: - (Printf.sprintf - "The cache-daemon action to perform (%s)" + (Printf.sprintf "The cache-daemon action to perform (%s)" (Arg.doc_alts_enum modes) ) ) in (config, mode) diff --git a/test/passing/tests/doc_comments-no-wrap.mli.err b/test/passing/tests/doc_comments-no-wrap.mli.err index f54d9f48f1..49df9d7f4b 100644 --- a/test/passing/tests/doc_comments-no-wrap.mli.err +++ b/test/passing/tests/doc_comments-no-wrap.mli.err @@ -10,11 +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:453 exceeds the margin -Warning: tests/doc_comments.mli:467 exceeds the margin -Warning: tests/doc_comments.mli:524 exceeds the margin -Warning: tests/doc_comments.mli:554 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:624 exceeds the margin -Warning: tests/doc_comments.mli:626 exceeds the margin -Warning: tests/doc_comments.mli:647 exceeds the margin -Warning: tests/doc_comments.mli:660 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 05d512e406..f00e96efab 100644 --- a/test/passing/tests/doc_comments-no-wrap.mli.ref +++ b/test/passing/tests/doc_comments-no-wrap.mli.ref @@ -401,15 +401,13 @@ end #use "import.cinaps" ;; List.iter all_fields ~f:(fun (name, type_) -> - printf - "\nexternal get_%s\n: unit -> %s = \"get_%s\"" + 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\"" + 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 78e33d3ae2..db9ce31256 100644 --- a/test/passing/tests/doc_comments.mli.err +++ b/test/passing/tests/doc_comments.mli.err @@ -10,11 +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:453 exceeds the margin -Warning: tests/doc_comments.mli:467 exceeds the margin -Warning: tests/doc_comments.mli:524 exceeds the margin -Warning: tests/doc_comments.mli:554 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:618 exceeds the margin -Warning: tests/doc_comments.mli:620 exceeds the margin -Warning: tests/doc_comments.mli:641 exceeds the margin -Warning: tests/doc_comments.mli:654 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 de10b2803a..941f850838 100644 --- a/test/passing/tests/doc_comments.mli.ref +++ b/test/passing/tests/doc_comments.mli.ref @@ -401,15 +401,13 @@ end #use "import.cinaps" ;; List.iter all_fields ~f:(fun (name, type_) -> - printf - "\nexternal get_%s\n: unit -> %s = \"get_%s\"" + 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\"" + printf "\nexternal get_%s\n: unit -> %s = \"get_%s\"" name type_ name ) ]} *) diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index c814f2caff..d3d4dc618e 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -9173,8 +9173,7 @@ let xxxxxx = let _ = fun (x : int as 'a) : (int as 'a) -> x let eradicate_meta_class_is_nullsafe = - register - ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" + register ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" ~hum:"Class is marked @Nullsafe and has 0 issues" (* Should be enabled for special integrations *) ~enabled:false Info Eradicate (* TODO *) diff --git a/test/unit/test_eol_compat.ml b/test/unit/test_eol_compat.ml index 7190554147..159ca16626 100644 --- a/test/unit/test_eol_compat.ml +++ b/test/unit/test_eol_compat.ml @@ -34,26 +34,22 @@ let _ = "\nlet _ = \"aaa\\n\n e\"\n" ~lf:"\nlet _ = \"aaa\\n\n e\"\n" ~crlf:"\r\nlet _ = \"aaa\\n\r\n e\"\r\n" - ; test - "lf in string with exclude_locs (lf)" + ; test "lf in string with exclude_locs (lf)" ~exclude_locs:[(9, 26)] "\nlet _ = \"aaa\\n\n e\"\n" ~lf:"\nlet _ = \"aaa\\n\n e\"\n" ~crlf:"\r\nlet _ = \"aaa\\n\n e\"\r\n" - ; test - "crlf in string with exclude_locs (lf)" + ; test "crlf in string with exclude_locs (lf)" ~exclude_locs:[(9, 27)] "\nlet _ = \"aaa\\n\r\n e\"\n" ~lf:"\nlet _ = \"aaa\\n\r\n e\"\n" ~crlf:"\r\nlet _ = \"aaa\\n\r\n e\"\r\n" - ; test - "lf in string with exclude_locs (crlf)" + ; test "lf in string with exclude_locs (crlf)" ~exclude_locs:[(10, 27)] "\r\nlet _ = \"aaa\\n\n e\"\r\n" ~lf:"\nlet _ = \"aaa\\n\n e\"\n" ~crlf:"\r\nlet _ = \"aaa\\n\n e\"\r\n" - ; test - "crlf in string with exclude_locs (crlf)" + ; test "crlf in string with exclude_locs (crlf)" ~exclude_locs:[(10, 28)] "\r\nlet _ = \"aaa\\n\r\n e\"\r\n" ~lf:"\nlet _ = \"aaa\\n\r\n e\"\n" diff --git a/test/unit/test_translation_unit.ml b/test/unit/test_translation_unit.ml index a235d56495..cd087b5bf8 100644 --- a/test/unit/test_translation_unit.ml +++ b/test/unit/test_translation_unit.ml @@ -33,8 +33,7 @@ let test_parse_and_format_core_type = [ make_test "string" ~input:"string" ~expected:(Ok "string\n") ; make_test "int" ~input:"int" ~expected:(Ok "int\n") ; make_test "arrow" ~input:"int -> int" ~expected:(Ok "int -> int\n") - ; make_test "arrow2" - ~input:" int (* foo *) \n\n -> int (* bar *)" + ; make_test "arrow2" ~input:" int (* foo *) \n\n -> int (* bar *)" ~expected:(Ok "int (* foo *) -> int (* bar *)\n") ; make_test ";;" ~input:";;" ~expected: @@ -116,8 +115,7 @@ File "", line 1, characters 0-3: let test_parse_and_format_expression = let make_test = test_parse_and_format "expression" ~fg:Expression in - [ make_test "List.map" - ~input:"List.map (fun x->\nx*x) [(1 + 9); 2;3] " + [ make_test "List.map" ~input:"List.map (fun x->\nx*x) [(1 + 9); 2;3] " ~expected:(Ok "List.map (fun x -> x * x) [ 1 + 9; 2; 3 ]\n") ] let tests =