Skip to content

Commit b7ef600

Browse files
Julowgpetiot
Julow
authored and
gpetiot
committed
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.
1 parent 93d5049 commit b7ef600

20 files changed

+60
-82
lines changed

‎lib/Ast.ml

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1530,7 +1530,8 @@ end = struct
15301530
| Pexp_constant {pconst_desc= Pconst_string (_, _, Some _); _} -> false
15311531
(* Only strings fitting on the line are simple. *)
15321532
| Pexp_constant {pconst_desc= Pconst_string (_, loc, None); _} ->
1533-
Exp.is_trivial exp || (Location.height loc = 1 && fit_margin c (width xexp))
1533+
Exp.is_trivial exp
1534+
|| (Location.height loc = 1 && fit_margin c (width xexp))
15341535
| Pexp_constant _ -> true
15351536
| Pexp_field _ | Pexp_ident _ | Pexp_send _
15361537
|Pexp_construct (_, None)

‎lib/Cmt.ml

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -60,8 +60,7 @@ let pp_error fs {kind; cmt_kind} =
6060
in
6161
match kind with
6262
| `Added x ->
63-
Format.fprintf fs
64-
"%!@{<loc>%a@}:@,@{<error>Error@}: %s %a added.\n%!"
63+
Format.fprintf fs "%!@{<loc>%a@}:@,@{<error>Error@}: %s %a added.\n%!"
6564
Location.print_loc (loc x) s_kind pp_cmt x
6665
| `Dropped x ->
6766
Format.fprintf fs

‎lib/Cmts.ml

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -303,8 +303,7 @@ let rec place t loc_tree ?prev_loc ?deep_loc locs cmts =
303303
(** Relocate comments, for Ast transformations such as sugaring. *)
304304
let relocate (t : t) ~src ~before ~after =
305305
if t.debug then
306-
Format.eprintf
307-
"relocate %a to %a and %a@\n%!"
306+
Format.eprintf "relocate %a to %a and %a@\n%!"
308307
Location.fmt src Location.fmt before Location.fmt after ;
309308
let merge_and_sort x y =
310309
List.rev_append x y

‎lib/Conf.ml

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -39,8 +39,7 @@ let warn ~loc fmt =
3939
Format.kasprintf
4040
(fun s ->
4141
warn_raw
42-
(Format.asprintf
43-
"%!@{<loc>%a@}:@,@{<warning>Warning@}: %s\n%!"
42+
(Format.asprintf "%!@{<loc>%a@}:@,@{<warning>Warning@}: %s\n%!"
4443
Location.print_loc loc s ) )
4544
fmt
4645

@@ -867,8 +866,7 @@ module Formatting = struct
867866
; Decl.Value.make ~name:"space" `Space
868867
"$(b,space) prints a space inside the delimiter to indicate the \
869868
matching one is on a different line."
870-
; Decl.Value.make
871-
~name:"closing-on-separate-line"
869+
; Decl.Value.make ~name:"closing-on-separate-line"
872870
`Closing_on_separate_line
873871
"$(b, closing-on-separate-line) makes sure that the closing \
874872
delimiter is on its own line." ]

‎lib/Conf_decl.ml

Lines changed: 6 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -163,13 +163,11 @@ let in_attributes cond = function
163163
let maybe_empty = function "" -> "" | x -> " " ^ x
164164

165165
let pp_deprecated ppf {dmsg; dversion= v} =
166-
Format.fprintf ppf
167-
"This option is deprecated since version %a.%s"
166+
Format.fprintf ppf "This option is deprecated since version %a.%s"
168167
Version.pp v (maybe_empty dmsg)
169168

170169
let pp_removed ppf {rmsg; rversion= v} =
171-
Format.fprintf ppf
172-
"This option has been removed in version %a.%s"
170+
Format.fprintf ppf "This option has been removed in version %a.%s"
173171
Version.pp v (maybe_empty rmsg)
174172

175173
let pp_from_src fs = function
@@ -189,8 +187,7 @@ let rec pp_from fs = function
189187
| `Profile (s, p) -> Format.fprintf fs " (profile %s%a)" s pp_from_src p
190188
| `Updated (x, None) -> pp_from_src fs x
191189
| `Updated (x, Some r) ->
192-
Format.fprintf fs
193-
"%a -- Warning (redundant): %a"
190+
Format.fprintf fs "%a -- Warning (redundant): %a"
194191
pp_from_src x pp_from r
195192

196193
let loc_udapted_from = function
@@ -211,8 +208,7 @@ let status_doc ppf = function
211208

212209
let generated_flag_doc ~allow_inline ~doc ~kind ~default ~status =
213210
let default = if default then "set" else "unset" in
214-
Format.asprintf
215-
"%s The flag is $(b,%s) by default.%s%a"
211+
Format.asprintf "%s The flag is $(b,%s) by default.%s%a"
216212
doc default
217213
(in_attributes allow_inline kind)
218214
status_doc status
@@ -222,8 +218,7 @@ let generated_doc conv ~allow_inline ~doc ~kind ~default ~status =
222218
let default =
223219
if String.is_empty default_doc then "none" else default_doc
224220
in
225-
Format.asprintf
226-
"%s The default value is $(b,%s).%s%a"
221+
Format.asprintf "%s The default value is $(b,%s).%s%a"
227222
doc default
228223
(in_attributes allow_inline kind)
229224
status_doc status
@@ -332,8 +327,7 @@ module Value = struct
332327
| Some x -> (name, value, doc, `Deprecated x)
333328

334329
let pp_deprecated s ppf {dmsg= msg; dversion= v} =
335-
Format.fprintf ppf
336-
"Value `%s` is deprecated since version %a. %s"
330+
Format.fprintf ppf "Value `%s` is deprecated since version %a. %s"
337331
s Version.pp v msg
338332

339333
let pp_deprecated_with_name ~opt ~val_ ppf {dmsg= msg; dversion= v} =

‎lib/Docstring.ml

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,8 +26,7 @@ let parse_file location text =
2626
Odoc_parser.ast (Odoc_parser.parse_comment ~location ~text)
2727

2828
let warn fmt warning =
29-
Format.fprintf fmt
30-
"Warning: Invalid documentation comment:@,%s\n%!"
29+
Format.fprintf fmt "Warning: Invalid documentation comment:@,%s\n%!"
3130
(Odoc_parser.Warning.to_string warning)
3231

3332
let is_tag_only =

‎lib/Fmt_ast.ml

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1520,8 +1520,18 @@ and fmt_args_grouped ?epi:(global_epi = noop) c ctx args =
15201520
let xexp = sub_exp ~ctx x in
15211521
is_simple c.conf (expression_width c) xexp
15221522
in
1523+
let should_break_after x = not (is_simple x)
1524+
and should_break_before ((_lbl, exp) as y) =
1525+
match exp.pexp_desc with
1526+
(* Heavy syntax strings are not grouped. *)
1527+
| Pexp_constant {pconst_desc= Pconst_string (_, _, Some _); _} -> true
1528+
(* Non-simple strings are grouped but end a group. *)
1529+
| Pexp_constant {pconst_desc= Pconst_string (_, _, None); _} -> false
1530+
| _ -> not (is_simple y)
1531+
in
15231532
let break x y =
1524-
Cmts.has_after c.cmts (snd x).pexp_loc || not (is_simple x && is_simple y)
1533+
Cmts.has_after c.cmts (snd x).pexp_loc
1534+
|| should_break_after x || should_break_before y
15251535
in
15261536
let groups =
15271537
if c.conf.fmt_opts.wrap_fun_args.v then List.group args ~break

‎lib/Source.ml

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -105,8 +105,7 @@ let extend_loc_to_include_attributes (loc : Location.t) (l : attributes) =
105105
{loc with loc_end= {loc.loc_end with pos_cnum= loc_end.loc_end.pos_cnum}}
106106

107107
let string_literal t mode loc =
108-
Option.value_exn
109-
~message:"Parse error while reading string literal"
108+
Option.value_exn ~message:"Parse error while reading string literal"
110109
(Literal_lexer.string mode (string_at t loc))
111110

112111
let begins_line ?(ignore_spaces = true) t (l : Location.t) =

‎lib/Translation_unit.ml

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -59,8 +59,7 @@ module Error = struct
5959
Out_channel.write_all n ~data:next ;
6060
ignore
6161
(Stdlib.Sys.command
62-
(Printf.sprintf
63-
"git diff --no-index -u %S %S | sed '1,4d' 1>&2"
62+
(Printf.sprintf "git diff --no-index -u %S %S | sed '1,4d' 1>&2"
6463
p n ) ) ;
6564
Stdlib.Sys.remove p ;
6665
Stdlib.Sys.remove n

‎test/passing/tests/args_grouped.ml

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -43,8 +43,7 @@ let bottom_up fooooooooooo =
4343
let empty = Int.equal 0 !scheduled && Queue.is_empty pending in
4444
if empty then (
4545
remaining := 0 ;
46-
L.progress
47-
"Finished call graph scheduling, %d procs remaining (in, or reaching, cycles).@."
46+
L.progress "Finished call graph scheduling, %d procs remaining (in, or reaching, cycles).@."
4847
(CallGraph.n_procs syntactic_call_graph) ;
4948
if Config.debug_level_analysis > 0 then CallGraph.to_dotty syntactic_call_graph "cycles.dot" ;
5049
foooooooooooooooooo )
@@ -81,16 +80,14 @@ let f =
8180
~y
8281

8382
let eradicate_meta_class_is_nullsafe =
84-
register
85-
~id:"ERADICATE_META_CLASS_IS_NULLSAFE"
83+
register ~id:"ERADICATE_META_CLASS_IS_NULLSAFE"
8684
~hum:"Class is marked @Nullsafe and has 0 issues"
8785
(* Should be enabled for special integrations *)
8886
~enabled:false Info Eradicate (* TODO *)
8987
~user_documentation:""
9088

9189
let eradicate_meta_class_is_nullsafe =
92-
register
93-
~id:"ERADICATE_META_CLASS_IS_NULLSAFE" (* Should be enabled for special integrations *)
90+
register ~id:"ERADICATE_META_CLASS_IS_NULLSAFE" (* Should be enabled for special integrations *)
9491
~hum:"Class is marked @Nullsafe and has 0 issues"
9592
(* Should be enabled for special integrations *)
9693
~enabled:false Info

0 commit comments

Comments
 (0)