Fix closing parenthesis exceeding the margin in function application

CHANGES.md

@@ -1,5 +1,6 @@
 ### (master)
 
+  + Fix closing parenthesis exceeding the margin in function application #1098 (Jules Aguillon)
   + Improve: add a message when a config value is removed (#1089) (Etienne Millon)
   + API: optional names for formatting boxes (#1083) (Guillaume Petiot)
   + Build: check ocamlformat error codes (#1084) (Etienne Millon)

src/Fmt.ml

@@ -116,13 +116,14 @@ let fits_breaks_if ?force_fit_if ?force_break_if ?hint ?level cnd fits breaks
 
 (** Wrapping ------------------------------------------------------------*)
 
-let wrap_if_k cnd pre suf k = fmt_if_k cnd pre $ k $ fmt_if_k cnd suf
+let wrap_if_k ?(box = fun k -> k) cnd pre suf k =
+  fmt_if_k cnd pre $ box (k $ fmt_if_k cnd suf)
 
-let wrap_k x = wrap_if_k true x
+let wrap_k ?box x = wrap_if_k ?box true x
 
-let wrap_if cnd pre suf = wrap_if_k cnd (fmt pre) (fmt suf)
+let wrap_if ?box cnd pre suf = wrap_if_k ?box cnd (fmt pre) (fmt suf)
 
-and wrap pre suf = wrap_k (fmt pre) (fmt suf)
+and wrap ?box pre suf = wrap_k ?box (fmt pre) (fmt suf)
 
 let wrap_if_fits_and cnd pre suf k =
   fits_breaks_if cnd pre "" $ k $ fits_breaks_if cnd suf ""

src/Fmt.mli

@@ -126,17 +126,17 @@ val fits_breaks_if :
 
 (** Wrapping ------------------------------------------------------------*)
 
-val wrap : s -> s -> t -> t
+val wrap : ?box:(t -> t) -> s -> s -> t -> t
 (** [wrap prologue epilogue body] formats [prologue] then [body] then
     [epilogue]. *)
 
-val wrap_k : t -> t -> t -> t
+val wrap_k : ?box:(t -> t) -> t -> t -> t -> t
 (** As [wrap], but prologue and epilogue may be arbitrary format thunks. *)
 
-val wrap_if : bool -> s -> s -> t -> t
+val wrap_if : ?box:(t -> t) -> bool -> s -> s -> t -> t
 (** As [wrap], but prologue and epilogue are only formatted conditionally. *)
 
-val wrap_if_k : bool -> t -> t -> t -> t
+val wrap_if_k : ?box:(t -> t) -> bool -> t -> t -> t -> t
 (** As [wrap_if], but prologue and epilogue may be arbitrary format thunks. *)
 
 val wrap_if_fits_and : bool -> string -> string -> t -> t

src/Fmt_ast.ml

@@ -669,7 +669,8 @@ and fmt_core_type c ?(box = true) ?(in_type_declaration = false) ?pro
       fmt_core_type c (sub_typ ~ctx t1) $ fmt "@ " $ fmt_longident_loc c lid
   | Ptyp_constr (lid, t1N) ->
       wrap_fits_breaks c.conf "(" ")"
-        (list t1N (Params.comma_sep c.conf) (sub_typ ~ctx >> fmt_core_type c))
+        (list t1N (Params.comma_sep c.conf)
+           (sub_typ ~ctx >> fmt_core_type c))
       $ fmt "@ " $ fmt_longident_loc c lid
   | Ptyp_extension ext ->
       hvbox c.conf.extension_indent (fmt_extension c ctx "%" ext)
@@ -777,7 +778,8 @@ and fmt_core_type c ?(box = true) ?(in_type_declaration = false) ?pro
       $ fmt_longident_loc c ~pre:(str "#") lid
   | Ptyp_class (lid, t1N) ->
       wrap_fits_breaks c.conf "(" ")"
-        (list t1N (Params.comma_sep c.conf) (sub_typ ~ctx >> fmt_core_type c))
+        (list t1N (Params.comma_sep c.conf)
+           (sub_typ ~ctx >> fmt_core_type c))
       $ fmt "@ "
       $ fmt_longident_loc c ~pre:(str "#") lid )
   $ fmt_docstring c ~pro:(fmt "@ ") doc
@@ -1704,8 +1706,8 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
                $ fmt "@ " $ fmt_cases c ctx'' cs $ str ")"
                $ Cmts.fmt_after c pexp_loc $ fmt_atrs ))
       | _ ->
-          wrap_if parens "(" ")"
-            (hvbox 2 (fmt_args_grouped e0 e1N1) $ fmt_atrs) )
+          wrap_if ~box:(hvbox 2) parens "(" ")"
+            (fmt_args_grouped e0 e1N1 $ fmt_atrs) )
   | Pexp_array [] ->
       hvbox 0
         ( wrap_fits_breaks c.conf "[|" "|]" (Cmts.fmt_within c pexp_loc)

test/passing/js_source.ml.ref

@@ -9802,7 +9802,9 @@ end
 (* FIX: exceed 90 columns *)
 let _ =
   aa
-    (bbbbbbbbb cccccccccccc dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd)
+    (bbbbbbbbb
+       cccccccccccc
+       dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd)
 ;;
 
 (* FIX: exceed 90 columns *)