From 55ebbe5e063fe7cdd13e32dbd7676fdd69fa1c75 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Mon, 2 Oct 2023 17:01:31 +0200 Subject: [PATCH] Strings of length < 80 are trivial and simple --- lib/Ast.ml | 10 ++-------- lib/Conf_decl.ml | 18 ++++++++---------- lib/Translation_unit.ml | 10 ++++------ lib/box_debug.ml | 3 +-- .../passing/tests/doc_comments-no-wrap.mli.ref | 8 ++++---- test/passing/tests/doc_comments.mli.ref | 8 ++++---- test/passing/tests/infix_arg_grouping.ml | 4 ++-- test/rpc/rpc_test.ml | 3 +-- test/rpc/rpc_test_fail.ml | 3 +-- 9 files changed, 27 insertions(+), 40 deletions(-) diff --git a/lib/Ast.ml b/lib/Ast.ml index a1c0f7ed86..829595482c 100644 --- a/lib/Ast.ml +++ b/lib/Ast.ml @@ -146,7 +146,7 @@ module Exp = struct | Pexp_constant {pconst_desc= Pconst_string (_, _, Some _); _} -> false (* Short strings are trivial. *) | Pexp_constant {pconst_desc= Pconst_string (str, _, None); _} -> - String.length str < 30 + String.length str < 80 | Pexp_constant _ | Pexp_field _ | Pexp_ident _ | Pexp_send _ -> true | Pexp_construct (_, exp) -> Option.for_all exp ~f:is_trivial | Pexp_prefix (_, e) -> is_trivial e @@ -1474,13 +1474,7 @@ end = struct let rec is_simple (c : Conf.t) width ({ast= exp; _} as xexp) = let ctx = Exp exp in match exp.pexp_desc with - (* String literals using the heavy syntax are not simple. *) - | 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)) - | Pexp_constant _ -> true + | Pexp_constant _ -> Exp.is_trivial exp | Pexp_field _ | Pexp_ident _ | Pexp_send _ |Pexp_construct (_, None) |Pexp_variant (_, None) -> diff --git a/lib/Conf_decl.ml b/lib/Conf_decl.ml index 4b1050689f..75d93ab1e4 100644 --- a/lib/Conf_decl.ml +++ b/lib/Conf_decl.ml @@ -208,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" - doc default + Format.asprintf "%s The flag is $(b,%s) by default.%s%a" doc default (in_attributes allow_inline kind) status_doc status @@ -218,8 +217,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" - doc default + Format.asprintf "%s The default value is $(b,%s).%s%a" doc default (in_attributes allow_inline kind) status_doc status @@ -327,13 +325,13 @@ 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" - s Version.pp v msg + 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} = Format.fprintf ppf - "option `%s`: value `%s` is deprecated since version %a. %s" - opt val_ Version.pp v msg + "option `%s`: value `%s` is deprecated since version %a. %s" opt val_ + Version.pp v msg let status_doc s ppf = function | `Valid -> () @@ -362,8 +360,8 @@ module Value_removed = struct | Some {name; version; msg} -> Format.kasprintf (fun s -> Error (`Msg s)) - "value `%s` has been removed in version %a.%s" - name Version.pp version (maybe_empty msg) + "value `%s` has been removed in version %a.%s" name Version.pp + version (maybe_empty msg) | None -> Arg.conv_parser conv s in Arg.conv (parse, Arg.conv_printer conv) diff --git a/lib/Translation_unit.ml b/lib/Translation_unit.ml index 842bd5fde0..cc7281e4bf 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" - p n ) ) ; + (Printf.sprintf "git diff --no-index -u %S %S | sed '1,4d' 1>&2" p n) ) ; Stdlib.Sys.remove p ; Stdlib.Sys.remove n @@ -114,8 +113,8 @@ module Error = struct if debug then print_diff input_name ~prev ~next ; if iteration <= 1 then Format.fprintf fmt - "%s: %S was not already formatted. ([max-iters = 1])\n%!" - exe input_name + "%s: %S was not already formatted. ([max-iters = 1])\n%!" exe + input_name else ( Format.fprintf fmt "%s: Cannot process %S.\n\ @@ -180,8 +179,7 @@ let check_margin (conf : Conf.t) ~filename ~fmted = List.iteri (String.split_lines fmted) ~f:(fun i line -> if String.length line > conf.fmt_opts.margin.v then Format.fprintf Format.err_formatter - "Warning: %s:%i exceeds the margin\n%!" - filename i ) + "Warning: %s:%i exceeds the margin\n%!" filename i ) let with_optional_box_debug ~box_debug k = if box_debug then Fmt.with_box_debug k else k diff --git a/lib/box_debug.ml b/lib/box_debug.ml index f4db9027ff..29247b39b9 100644 --- a/lib/box_debug.ml +++ b/lib/box_debug.ml @@ -101,8 +101,7 @@ let break fs n o = if !debug then fprintf fs "
(%i,%i)break %i \ - %i
" - n o n o + %i" n o n o let pp_keyword fs s = fprintf fs "%s" s diff --git a/test/passing/tests/doc_comments-no-wrap.mli.ref b/test/passing/tests/doc_comments-no-wrap.mli.ref index f00e96efab..bf0cfed150 100644 --- a/test/passing/tests/doc_comments-no-wrap.mli.ref +++ b/test/passing/tests/doc_comments-no-wrap.mli.ref @@ -401,14 +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.ref b/test/passing/tests/doc_comments.mli.ref index 941f850838..04cdb10d17 100644 --- a/test/passing/tests/doc_comments.mli.ref +++ b/test/passing/tests/doc_comments.mli.ref @@ -401,14 +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/infix_arg_grouping.ml b/test/passing/tests/infix_arg_grouping.ml index a083ab05d7..896dd2b781 100644 --- a/test/passing/tests/infix_arg_grouping.ml +++ b/test/passing/tests/infix_arg_grouping.ml @@ -5,8 +5,8 @@ vbox 1 ;; user_error - ( "version mismatch: .ocamlformat requested " - ^ value ^ " but version is " ^ Version.version ) + ( "version mismatch: .ocamlformat requested " ^ value ^ " but version is " + ^ Version.version ) ;; hvbox 1 diff --git a/test/rpc/rpc_test.ml b/test/rpc/rpc_test.ml index c91a73be3c..17de0ab390 100644 --- a/test/rpc/rpc_test.ml +++ b/test/rpc/rpc_test.ml @@ -79,8 +79,7 @@ let start ?versions () = log "An error occured while initializing and configuring ocamlformat:\n\ %s\n\ - %!" - msg ; + %!" msg ; `No_process ) let get_client ?versions () = diff --git a/test/rpc/rpc_test_fail.ml b/test/rpc/rpc_test_fail.ml index 683446e7dc..2a9fbda9fe 100644 --- a/test/rpc/rpc_test_fail.ml +++ b/test/rpc/rpc_test_fail.ml @@ -77,8 +77,7 @@ let start () = log "An error occured while initializing and configuring ocamlformat:\n\ %s\n\ - %!" - msg ; + %!" msg ; `No_process ) let get_client () =