Consistent docking of argument functions

CHANGES.md

@@ -6,7 +6,7 @@
 
 ### Bug fixes
 
-- Avoid adding breaks inside `~label:(fun` and base the indentation on the label. (#2271, @Julow)
+- Avoid adding breaks inside `~label:(fun` and base the indentation on the label. (#2271, #2291, @Julow)
 - Fix non-stabilizing comments attached to private/virtual/mutable keywords (#2272, @gpetiot)
 - Fix formatting of comments in "disable" chunks (#2279, @gpetiot)
 

lib/Fmt_ast.ml

@@ -1358,6 +1358,30 @@ and fmt_label_arg ?(box = true) ?epi ?parens ?eol c
                ~pro:(fmt_label lbl ":@;<0 2>")
                ~box ?epi ?parens xarg )
         $ cmts_after )
+  | (Labelled _ | Optional _), Pexp_fun _ ->
+      (* Side effects of Cmts.fmt c.cmts before Sugar.fun_ is important. *)
+      let cmt_before = Cmts.fmt_before c arg.pexp_loc in
+      let xargs, xbody = Sugar.fun_ c.cmts xarg in
+      let fmt_cstr, xbody = type_constr_and_body c xbody in
+      let body =
+        let box =
+          match xbody.ast.pexp_desc with
+          | Pexp_fun _ | Pexp_function _ -> Some false
+          | _ -> None
+        in
+        fmt "@ " $ fmt_expression c ?box xbody
+      in
+      hovbox_if box 2
+        ( hvbox 0
+            ( hvbox 2
+                ( hvbox 2 (fmt_label lbl ":" $ cmt_before $ fmt "(fun")
+                $ fmt "@ "
+                $ fmt_attributes c arg.pexp_attributes ~suf:" "
+                $ fmt_fun_args c xargs $ fmt_opt fmt_cstr )
+            $ fmt "@ ->" )
+        $ body
+        $ closing_paren c ~offset:(-2)
+        $ Cmts.fmt_after c arg.pexp_loc )
   | _ ->
       let label_sep : s =
         if box || c.conf.fmt_opts.wrap_fun_args.v then ":@," else ":"

test/passing/tests/eliom_ext.eliom

@@ -9,6 +9,20 @@ let%client () =
     (fun () ->
       Lwt.async (fun () -> log "Hello from the client to the server!") )
 
+let%client () =
+  Eliom_client.onload
+  (* NB The service underlying the server_function isn't available on the
+     client before loading the page. *) ~foo:(fun () ->
+      Lwt.async (fun () -> log "Hello from the client to the server!") )
+
+let%client () =
+  Eliom_client.onload
+  (* NB The service underlying the server_function isn't available on the
+     client before loading the page. *)
+    ~foo:(fun () ->
+      Lwt.async (fun () -> log "Hello from the client to the server!") )
+    bar
+
 [%%shared
 type some_type = int * string list [@@deriving json]
 

test/passing/tests/js_source.ml

@@ -7655,3 +7655,11 @@ let () = ((one_mississippi, two_mississippi, three_mississippi, four_mississippi
 
 let _ = ((match foo with | Bar -> bar | Baz -> baz) : string)
 let _ = ((match foo with | Bar -> bar | Baz -> baz) :> string)
+
+let _ =
+  aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+    ~bbbbbbbbbbbbbbbbbbbbbbbbbbbb:(fun (_ :
+                                         (ccccccccccccc * ddddddddddddddddddddddddddddd)
+                                         eeee) -> FFFFFFFFF gg)
+    ~h
+;;

test/passing/tests/js_source.ml.ocp

@@ -9889,3 +9889,11 @@ let _ =
      | Baz -> baz)
    :> string)
 ;;
+
+let _ =
+  aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+    ~bbbbbbbbbbbbbbbbbbbbbbbbbbbb:(fun
+                                    (_ : (ccccccccccccc * ddddddddddddddddddddddddddddd) eeee)
+                                    -> FFFFFFFFF gg)
+    ~h
+;;

test/passing/tests/js_source.ml.ref

@@ -9889,3 +9889,11 @@ let _ =
     | Baz -> baz)
     :> string)
 ;;
+
+let _ =
+  aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+    ~bbbbbbbbbbbbbbbbbbbbbbbbbbbb:(fun
+      (_ : (ccccccccccccc * ddddddddddddddddddddddddddddd) eeee)
+    -> FFFFFFFFF gg)
+    ~h
+;;