Janestreet profile: Fix indentation of functions passed as labelled a…

…rgument (#2259)

* Remove break after label when 'wrap_fun_args' is false

The body of the function is intended until the first '|' is aligned with
the 'function' keyword.

* Remove function indentation passed as labelled argument

This affect only the Janestreet profile. The alignment of the function
body with the 'function' keyword is unwanted when the function is passed
as a labelled argument.

* Implement 'align_symbol_open_paren' in Params

CHANGES.md

@@ -1,3 +1,9 @@
+## unreleased
+
+### Bug fixes
+
+- Janestreet: Fix indentation of functions passed as labelled argument (#2259, @Julow)
+
 ## 0.25.0 (2023-02-24)
 
 ### Library

lib/Fmt_ast.ml

@@ -1358,7 +1358,11 @@ and fmt_label_arg ?(box = true) ?epi ?parens ?eol c
                ~pro:(fmt_label lbl ":@;<0 2>")
                ~box ?epi ?parens xarg )
         $ cmts_after )
-  | _ -> fmt_label lbl ":@," $ fmt_expression c ~box ?epi ?parens xarg
+  | _ ->
+      let label_sep : s =
+        if box || c.conf.fmt_opts.wrap_fun_args.v then ":@," else ":"
+      in
+      fmt_label lbl label_sep $ fmt_expression c ~box ?epi ?parens xarg
 
 and expression_width c xe =
   String.length
@@ -1529,10 +1533,9 @@ and fmt_infix_op_args c ~parens xexp op_args =
            $ fmt_if_k (not last) (break 1 0) ) )
     $ fmt_if_k (not last_grp) (break 1 0)
   in
-  let align = not c.conf.fmt_opts.align_symbol_open_paren.v in
   Params.Exp.Infix_op_arg.wrap c.conf ~parens
     ~parens_nested:(Ast.parenze_nested_exp xexp)
-    (hvbox_if align 0 (list_fl groups fmt_op_arg_group))
+    (Params.Align.infix_op c.conf (list_fl groups fmt_op_arg_group))
 
 and fmt_pat_cons c ~parens args =
   let groups =
@@ -1562,10 +1565,9 @@ and fmt_pat_cons c ~parens args =
 
 and fmt_match c ~parens ?ext ctx xexp cs e0 keyword =
   let indent = Params.match_indent c.conf ~ctx:xexp.ctx in
-  let align = not c.conf.fmt_opts.align_symbol_open_paren.v in
   hvbox indent
     ( Params.Exp.wrap c.conf ~parens ~disambiguate:true
-    @@ hvbox_if align 0
+    @@ Params.Align.match_ c.conf
     @@ ( hvbox 0
            ( str keyword
            $ fmt_extension_suffix c ext
@@ -2070,16 +2072,8 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
            $ fmt "@ " $ body ) )
   | Pexp_function cs ->
       let indent = Params.function_indent c.conf ~ctx in
-      let align =
-        match ctx0 with
-        | Exp
-            {pexp_desc= Pexp_infix (_, _, {pexp_desc= Pexp_function _; _}); _}
-          ->
-            false
-        | _ -> parens && not c.conf.fmt_opts.align_symbol_open_paren.v
-      in
       Params.Exp.wrap c.conf ~parens ~disambiguate:true ~fits_breaks:false
-      @@ hvbox_if align 0
+      @@ Params.Align.function_ c.conf ~parens ~ctx0 ~self:exp
       @@ ( hvbox 2
              ( str "function"
              $ fmt_extension_suffix c ext

lib/Params.ml

@@ -12,6 +12,7 @@
 module Format = Format_
 module Location = Migrate_ast.Location
 open Extended_ast
+open Asttypes
 open Fmt
 
 let parens_if parens (c : Conf.t) ?(disambiguate = false) k =
@@ -500,3 +501,33 @@ let semi_sep (c : Conf.t) : Fmt.s =
   match c.fmt_opts.break_separators.v with
   | `Before -> "@,; "
   | `After -> ";@;<1 2>"
+
+module Align = struct
+  (** Whether [exp] occurs in [args] as a labelled argument. *)
+  let is_labelled_arg args exp =
+    List.exists
+      ~f:(function
+        | Nolabel, _ -> false
+        | Labelled _, x | Optional _, x -> phys_equal x exp )
+      args
+
+  let general (c : Conf.t) t =
+    hvbox_if (not c.fmt_opts.align_symbol_open_paren.v) 0 t
+
+  let infix_op = general
+
+  let match_ = general
+
+  let function_ (c : Conf.t) ~parens ~(ctx0 : Ast.t) ~self t =
+    let align =
+      match ctx0 with
+      | Exp {pexp_desc= Pexp_infix (_, _, {pexp_desc= Pexp_function _; _}); _}
+        ->
+          false
+      | Exp {pexp_desc= Pexp_apply (_, args); _}
+        when is_labelled_arg args self ->
+          false
+      | _ -> parens && not c.fmt_opts.align_symbol_open_paren.v
+    in
+    hvbox_if align 0 t
+end

lib/Params.mli

@@ -139,3 +139,14 @@ val comma_sep : Conf.t -> Fmt.s
 
 val semi_sep : Conf.t -> Fmt.s
 (** Like [comma_sep] but use a semicolon as separator. *)
+
+module Align : sig
+  (** Implement the [align_symbol_open_paren] option. *)
+
+  val infix_op : Conf.t -> Fmt.t -> Fmt.t
+
+  val match_ : Conf.t -> Fmt.t -> Fmt.t
+
+  val function_ :
+    Conf.t -> parens:bool -> ctx0:Ast.t -> self:expression -> Fmt.t -> Fmt.t
+end

test/passing/tests/js_source.ml

@@ -7624,3 +7624,21 @@ let x =
     ^ "Another string _____________"
     ^ "Yet another string _________")
 ;;
+
+let bind t ~f =
+  unfold_step
+    ~f:(function
+      | Sequence { state = seed; next }, rest ->
+        (match next seed with
+         | Done ->
+           (match rest with
+            | Sequence { state = seed; next } ->
+              (match next seed with
+               | Done -> Done
+               | Skip { state = s } -> Skip { state = empty, Sequence { state = s; next } }
+               | Yield { value = a; state = s } ->
+                 Skip { state = f a, Sequence { state = s; next } }))
+         | Skip { state = s } -> Skip { state = Sequence { state = s; next }, rest }
+         | Yield { value = a; state = s } ->
+           Yield { value = a; state = Sequence { state = s; next }, rest }))
+    ~init:(empty, t)

test/passing/tests/js_source.ml.ocp

@@ -9799,23 +9799,20 @@ let[@a
   with
   | _
     when f
-           ~f:
-             (function[@ocaml.warning (* ....................................... *) "-4"]
-               | _ -> .)
-           ~f:
-             (function[@ocaml.warning
-                (* ....................................... *)
-               (* ....................................... *)
-               "foooooooooooooooooooooooooooo \
-                fooooooooooooooooooooooooooooooooooooo"]
-               | _ -> .)
-           ~f:
-             (function[@ocaml.warning
-                (* ....................................... *)
-               let x = a
-               and y = b in
-               x + y]
-               | _ -> .) ->
+           ~f:(function[@ocaml.warning (* ....................................... *) "-4"]
+             | _ -> .)
+           ~f:(function[@ocaml.warning
+              (* ....................................... *)
+             (* ....................................... *)
+             "foooooooooooooooooooooooooooo \
+              fooooooooooooooooooooooooooooooooooooo"]
+             | _ -> .)
+           ~f:(function[@ocaml.warning
+              (* ....................................... *)
+             let x = a
+             and y = b in
+             x + y]
+             | _ -> .) ->
     y [@attr
        (* ... *)
       (* ... *)
@@ -9848,3 +9845,23 @@ let x =
      ^ "Another string _____________"
      ^ "Yet another string _________")
 ;;
+
+let bind t ~f =
+  unfold_step
+    ~f:(function
+      | Sequence { state = seed; next }, rest ->
+        (match next seed with
+         | Done ->
+           (match rest with
+            | Sequence { state = seed; next } ->
+              (match next seed with
+               | Done -> Done
+               | Skip { state = s } ->
+                 Skip { state = empty, Sequence { state = s; next } }
+               | Yield { value = a; state = s } ->
+                 Skip { state = f a, Sequence { state = s; next } }))
+         | Skip { state = s } -> Skip { state = Sequence { state = s; next }, rest }
+         | Yield { value = a; state = s } ->
+           Yield { value = a; state = Sequence { state = s; next }, rest }))
+    ~init:(empty, t)
+;;

test/passing/tests/js_source.ml.ref

@@ -9799,23 +9799,20 @@ let[@a
   with
   | _
     when f
-           ~f:
-             (function[@ocaml.warning (* ....................................... *) "-4"]
-              | _ -> .)
-           ~f:
-             (function[@ocaml.warning
-                        (* ....................................... *)
-                        (* ....................................... *)
-                        "foooooooooooooooooooooooooooo \
-                         fooooooooooooooooooooooooooooooooooooo"]
-              | _ -> .)
-           ~f:
-             (function[@ocaml.warning
-                        (* ....................................... *)
-                        let x = a
-                        and y = b in
-                        x + y]
-              | _ -> .) ->
+           ~f:(function[@ocaml.warning (* ....................................... *) "-4"]
+             | _ -> .)
+           ~f:(function[@ocaml.warning
+                         (* ....................................... *)
+                         (* ....................................... *)
+                         "foooooooooooooooooooooooooooo \
+                          fooooooooooooooooooooooooooooooooooooo"]
+             | _ -> .)
+           ~f:(function[@ocaml.warning
+                         (* ....................................... *)
+                         let x = a
+                         and y = b in
+                         x + y]
+             | _ -> .) ->
     y [@attr
         (* ... *)
         (* ... *)
@@ -9848,3 +9845,23 @@ let x =
      ^ "Another string _____________"
      ^ "Yet another string _________")
 ;;
+
+let bind t ~f =
+  unfold_step
+    ~f:(function
+      | Sequence { state = seed; next }, rest ->
+        (match next seed with
+         | Done ->
+           (match rest with
+            | Sequence { state = seed; next } ->
+              (match next seed with
+               | Done -> Done
+               | Skip { state = s } ->
+                 Skip { state = empty, Sequence { state = s; next } }
+               | Yield { value = a; state = s } ->
+                 Skip { state = f a, Sequence { state = s; next } }))
+         | Skip { state = s } -> Skip { state = Sequence { state = s; next }, rest }
+         | Yield { value = a; state = s } ->
+           Yield { value = a; state = Sequence { state = s; next }, rest }))
+    ~init:(empty, t)
+;;