Fix closing parenthesis exceeding the margin in function application

[Julow]

Fix #1072

This fix is very ad hoc and the bug may still be present in other places, potentially, every time there is a box directly inside a wrap.

[facebook-github-bot]

Hi Julow! Thank you for your pull request and welcome to our community. We require contributors to sign our Contributor License Agreement, and we don't seem to have you on file.In order for us to review and merge your code, please sign at https://code.facebook.com/cla. If you are contributing on behalf of someone else (eg your employer), the individual CLA may not be sufficient and your employer may need to sign the corporate CLA.

If you have received this in error or have any questions, please contact us at [email protected]. Thanks!

[facebook-github-bot]

Thank you for signing our Contributor License Agreement. We can now accept your code for this (and any) Facebook open source project. Thanks!

[Julow]

In the second commit, I try adding a ?box argument to wrap to more easily solve the same bug in other places. It doesn't feel right to me, what do other think ?

[emillon]

Re ?box, I tried to add an abstraction for that, I'll open the corresponding PR. Maybe it's possible to reuse it.

[emillon]

@Julow See #1099 for the abstraction around opening/closing.

[Julow]

#1099 does not really help with the ?box argument here, the closings are not in the right order.

[Julow]

My initial fix was not working when wrap-fun-args was true, fixed.
I also removed the ?box argument, it was not powerful enough.

[Julow]

The diffs with test_branch are fixes:

diff --git a/src/Fmt_ast.ml b/src/Fmt_ast.ml
index 2d3396c..264904a 100644
--- a/src/Fmt_ast.ml
+++ b/src/Fmt_ast.ml
@@ -678,7 +678,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)
@@ -786,7 +787,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
diff --git a/infer/src/IR/SourceFiles.ml b/infer/src/IR/SourceFiles.ml
index 2e748580d..38a7a8b50 100644
--- a/infer/src/IR/SourceFiles.ml
+++ b/infer/src/IR/SourceFiles.ml
@@ -163,7 +163,8 @@ let pp_all ~filter ~type_environment ~procedure_names ~freshly_captured fmt () =
     F.fprintf fmt "%a@,%a%a%a" SourceFile.pp source_file
       (pp_if stmt "type_environment" type_environment Tenv.SQLite.deserialize Tenv.pp_per_file)
       1
-      (pp_if stmt "procedure_names" procedure_names Typ.Procname.SQLiteList.deserialize pp_procnames)
+      (pp_if stmt "procedure_names" procedure_names Typ.Procname.SQLiteList.deserialize
+         pp_procnames)
       2
       (pp_if stmt "freshly_captured" freshly_captured deserialize_freshly_captured
          Format.pp_print_bool)
diff --git a/infer/src/bufferoverrun/bufferOverrunSemantics.ml b/infer/src/bufferoverrun/bufferOverrunSemantics.ml
index 21a7b0a9a..086140a07 100644
--- a/infer/src/bufferoverrun/bufferOverrunSemantics.ml
+++ b/infer/src/bufferoverrun/bufferOverrunSemantics.ml
@@ -808,7 +808,9 @@ let get_matching_pairs :
     Option.value_map (Val.get_sym_var v1) ~default:l ~f:(fun var ->
         let sym_exp_opt =
           Option.first_some
-            (Relation.SymExp.of_exp_opt ~get_sym_f:(get_sym_f integer_type_widths caller_mem) e2_opt)
+            (Relation.SymExp.of_exp_opt
+               ~get_sym_f:(get_sym_f integer_type_widths caller_mem)
+               e2_opt)
             (Relation.SymExp.of_sym (Val.get_sym v2))
         in
         (var, sym_exp_opt) :: l)
diff --git a/sledge/src/symbheap/sh_domain.ml b/sledge/src/symbheap/sh_domain.ml
index 9749b5d64..551187a4a 100644
--- a/sledge/src/symbheap/sh_domain.ml
+++ b/sledge/src/symbheap/sh_domain.ml
@@ -300,7 +300,8 @@ let%test_module _ =
 
     let%expect_test _ =
       pp
-        (garbage_collect (Sh.star seg_a seg_main) ~wrt:(Var.Set.of_list [a_])) ;
+        (garbage_collect (Sh.star seg_a seg_main)
+           ~wrt:(Var.Set.of_list [a_])) ;
       [%expect {| %a_2 -[ %b_4, %n_3 )-> ⟨%n_3,%end_5⟩ |}]
 
     let%expect_test _ =
diff --git a/examples/webgl/webgldemo.ml b/examples/webgl/webgldemo.ml
index a8f3f17cc..9e479b2be 100644
--- a/examples/webgl/webgldemo.ml
+++ b/examples/webgl/webgldemo.ml
@@ -235,7 +235,9 @@ let pi = 4. *. atan 1.
 let start (pos, norm) =
   let fps_text = Dom_html.document##createTextNode (Js.string "loading") in
   Opt.iter
-    (Opt.bind (Dom_html.document##getElementById (string "fps")) Dom_html.CoerceTo.element)
+    (Opt.bind
+       (Dom_html.document##getElementById (string "fps"))
+       Dom_html.CoerceTo.element)
     (fun span -> Dom.appendChild span fps_text);
   debug "init canvas";
   let _canvas, gl = init_canvas "canvas" in

[gpetiot]

Looks good to me, and indeed it fixes a lot of bugs with the janestreet profile.