diff --git a/lib/Conf.ml b/lib/Conf.ml index be35cd1e53..a4512c6a74 100644 --- a/lib/Conf.ml +++ b/lib/Conf.ml @@ -50,6 +50,7 @@ let conventional_profile from = let elt content = Elt.make content from in { align_symbol_open_paren= elt true ; assignment_operator= elt `End_line + ; break_around_multiline_strings= elt false ; break_before_in= elt `Fit_or_vertical ; break_cases= elt `Fit ; break_collection_expressions= elt `Fit_or_vertical @@ -118,6 +119,7 @@ let ocamlformat_profile from = let elt content = Elt.make content from in { align_symbol_open_paren= elt true ; assignment_operator= elt `End_line + ; break_around_multiline_strings= elt false ; break_before_in= elt `Fit_or_vertical ; break_cases= elt `Nested ; break_collection_expressions= elt `Fit_or_vertical @@ -184,6 +186,7 @@ let janestreet_profile from = let elt content = Elt.make content from in { align_symbol_open_paren= elt false ; assignment_operator= elt `Begin_line + ; break_around_multiline_strings= elt true ; break_before_in= elt `Fit_or_vertical ; break_cases= elt `Fit_or_vertical ; break_collection_expressions= diff --git a/lib/Conf_t.ml b/lib/Conf_t.ml index 59f0c6b458..0958eb2ad2 100644 --- a/lib/Conf_t.ml +++ b/lib/Conf_t.ml @@ -55,6 +55,7 @@ type 'a elt = 'a Elt.t type fmt_opts = { align_symbol_open_paren: bool elt ; assignment_operator: [`Begin_line | `End_line] elt + ; break_around_multiline_strings: bool elt ; break_before_in: [`Fit_or_vertical | `Auto] elt ; break_cases: [`Fit | `Nested | `Toplevel | `Fit_or_vertical | `All | `Vertical] elt diff --git a/lib/Conf_t.mli b/lib/Conf_t.mli index 853e321d8e..a8a8bf87da 100644 --- a/lib/Conf_t.mli +++ b/lib/Conf_t.mli @@ -51,6 +51,7 @@ type 'a elt = 'a Elt.t type fmt_opts = { align_symbol_open_paren: bool elt ; assignment_operator: [`Begin_line | `End_line] elt + ; break_around_multiline_strings: bool elt ; break_before_in: [`Fit_or_vertical | `Auto] elt ; break_cases: [`Fit | `Nested | `Toplevel | `Fit_or_vertical | `Vertical | `All] elt diff --git a/lib/Fmt.mli b/lib/Fmt.mli index af6e2040a6..e996b01789 100644 --- a/lib/Fmt.mli +++ b/lib/Fmt.mli @@ -76,6 +76,9 @@ val char : char -> t val str : string -> t (** Format a string. *) +val str_as : int -> string -> t +(** [str_as a len] formats a string as if it were of length [len]. *) + (** Primitive containers ------------------------------------------------*) val opt : 'a option -> ('a -> t) -> t diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 6028010f44..20c3626fab 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -262,7 +262,15 @@ let fmt_constant c ?epi {pconst_desc; pconst_loc= loc} = | Pconst_char (_, s) -> wrap "'" "'" @@ str s | Pconst_string (s, loc', Some delim) -> Cmts.fmt c loc' - @@ wrap_k (str ("{" ^ delim ^ "|")) (str ("|" ^ delim ^ "}")) (str s) + @@ (* If a multiline string has newlines in it, the configuration might + specify it should get treated as a "long" box element. To do so, + we pretend it is 1000 characters long. *) + ( if + c.conf.fmt_opts.break_around_multiline_strings.v + && String.mem s '\n' + then str_as 1000 + else str ) + (Format_.sprintf "{%s|%s|%s}" delim s delim) | Pconst_string (_, loc', None) -> ( let delim = ["@,"; "@;"] in let contains_pp_commands s = @@ -513,18 +521,19 @@ let sequence_blank_line c (l1 : Location.t) (l2 : Location.t) = loop l1.loc_end (Cmts.remaining_before c.cmts l2) | `Compact -> false -let fmt_quoted_string key ext s = function - | None -> - wrap_k (str (Format_.sprintf "{%s%s|" key ext)) (str "|}") (str s) +let fmt_quoted_string c key ext s maybe_delim = + ( if c.conf.fmt_opts.break_around_multiline_strings.v && String.mem s '\n' + then str_as 1000 + else str ) + @@ + match maybe_delim with + | None -> Format_.sprintf "{%s%s|%s|}" key ext s | Some delim -> let ext_and_delim = if String.is_empty delim then ext else Format_.sprintf "%s %s" ext delim in - wrap_k - (str (Format_.sprintf "{%s%s|" key ext_and_delim)) - (str (Format_.sprintf "|%s}" delim)) - (str s) + Format_.sprintf "{%s%s|%s|%s}" key ext_and_delim s delim let fmt_type_var s = str "'" @@ -557,7 +566,7 @@ let rec fmt_extension_aux c ctx ~key (ext, pld) = assert (not (Cmts.has_after c.cmts pexp_loc)) ; assert (not (Cmts.has_before c.cmts pstr_loc)) ; assert (not (Cmts.has_after c.cmts pstr_loc)) ; - hvbox 0 (fmt_quoted_string (Ext.Key.to_string key) ext str delim) + hvbox 0 (fmt_quoted_string c (Ext.Key.to_string key) ext str delim) | _, PStr [({pstr_loc; _} as si)], (Pld _ | Str _ | Top) when Source.extension_using_sugar ~name:ext ~payload:pstr_loc -> fmt_structure_item c ~last:true ~ext ~semisemi:false (sub_str ~ctx si) diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err index 95f7fb8536..1d9cfa32c9 100644 --- a/test/passing/tests/js_source.ml.err +++ b/test/passing/tests/js_source.ml.err @@ -1,5 +1,5 @@ Warning: tests/js_source.ml:155 exceeds the margin -Warning: tests/js_source.ml:9531 exceeds the margin -Warning: tests/js_source.ml:9634 exceeds the margin -Warning: tests/js_source.ml:9693 exceeds the margin -Warning: tests/js_source.ml:9775 exceeds the margin +Warning: tests/js_source.ml:9537 exceeds the margin +Warning: tests/js_source.ml:9640 exceeds the margin +Warning: tests/js_source.ml:9699 exceeds the margin +Warning: tests/js_source.ml:9781 exceeds the margin diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index 889cce31c5..aefdfbbbaa 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -3154,7 +3154,8 @@ module FM_valid = F (struct type t = int end) -[%%expect {| +[%%expect + {| module M_valid : S module FM_valid : S |}] @@ -3170,7 +3171,8 @@ end = struct let x = ref 0 end -[%%expect {| +[%%expect + {| module Foo : sig type t val x : t ref end |}] @@ -3184,7 +3186,8 @@ end = struct let x = ref 0 end -[%%expect {| +[%%expect + {| module Bar : sig type t [@@immediate] val x : t ref end |}] @@ -3194,7 +3197,8 @@ let test f = Sys.time () -. start ;; -[%%expect {| +[%%expect + {| val test : (unit -> 'a) -> float = |}] @@ -3204,7 +3208,8 @@ let test_foo () = done ;; -[%%expect {| +[%%expect + {| val test_foo : unit -> unit = |}] @@ -3214,7 +3219,8 @@ let test_bar () = done ;; -[%%expect {| +[%%expect + {| val test_bar : unit -> unit = |}] @@ -10330,8 +10336,10 @@ 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 a60e340e05..8178dac048 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -3154,7 +3154,8 @@ module FM_valid = F (struct type t = int end) -[%%expect {| +[%%expect + {| module M_valid : S module FM_valid : S |}] @@ -3170,7 +3171,8 @@ end = struct let x = ref 0 end -[%%expect {| +[%%expect + {| module Foo : sig type t val x : t ref end |}] @@ -3184,7 +3186,8 @@ end = struct let x = ref 0 end -[%%expect {| +[%%expect + {| module Bar : sig type t [@@immediate] val x : t ref end |}] @@ -3194,7 +3197,8 @@ let test f = Sys.time () -. start ;; -[%%expect {| +[%%expect + {| val test : (unit -> 'a) -> float = |}] @@ -3204,7 +3208,8 @@ let test_foo () = done ;; -[%%expect {| +[%%expect + {| val test_foo : unit -> unit = |}] @@ -3214,7 +3219,8 @@ let test_bar () = done ;; -[%%expect {| +[%%expect + {| val test_bar : unit -> unit = |}] @@ -10330,8 +10336,10 @@ zzzzzzzzzzzzzzzzzzzzzzzzzzzz *) (*$*) -(*$ {| - f|} *) +(*$ + {| + f|} +*) let () = match () with