Restore indentation of -> (#2398)

* Restore indentation of fun arrow

This is the formatting of 0.25.1.

* Improve indent of fun args preceded by a label

The arguments must be indented more to avoid them aligning with the
`fun` and `->` in case of a break:

    let () =
      very_long_function_name
        ~very_long_argument_label:(* foo *)
          (fun
          very_long_argument_name_one
          very_long_argument_name_two
          very_long_argument_name_three
          -> () )

CHANGES.md

@@ -18,7 +18,7 @@
 - Consistent indentation of `@@ let+ x = ...` (#2315, #2396, @Julow)
 - Remove double parenthesis around tuple in a match (#2308, @Julow)
 - Consistent indentation of `fun (type a) ->` that follow `fun x ->` (#2294, @Julow)
-- Avoid adding breaks inside `~label:(fun` and base the indentation on the label. (#2271, #2291, #2293, #2298, @Julow)
+- Improve indentation of `~label:(fun` (#2271, #2291, #2293, #2298, #2398, @Julow)
 - Fix non-stabilizing comments attached to private/virtual/mutable keywords (#2272, #2307, @gpetiot, @Julow)
 - Fix formatting of comments in "disable" chunks (#2279, @gpetiot)
 - Fix indentation of trailing double-semicolons (#2295, @gpetiot)

lib/Conf_decl.ml

@@ -436,7 +436,8 @@ let removed_option ~names ~since ~msg =
 let update store ~config ~from:new_from ~name ~value ~inline =
   List.find_map store
     ~f:(fun
-      (Pack {names; parse; update; allow_inline; get_value; to_string; _}) ->
+        (Pack {names; parse; update; allow_inline; get_value; to_string; _})
+      ->
       if List.exists names ~f:(String.equal name) then
         if inline && not allow_inline then
           Some (Error (Error.Misplaced (name, value)))

lib/Fmt_ast.ml

@@ -1352,10 +1352,11 @@ and fmt_fun ?force_closing_paren
     else noop
   in
   let (label_sep : s), break_fun =
-    (* Break between the label and the fun to avoid ocp-indent's
-       alignment. *)
+    (* Break between the label and the fun to avoid ocp-indent's alignment.
+       If a label is present, arguments should be indented more than the
+       arrow and the eventually breaking [fun] keyword. *)
     if c.conf.fmt_opts.ocp_indent_compat.v then (":@,", fmt "@;<1 2>")
-    else (":", fmt "@ ")
+    else (":", if has_label then fmt "@;<1 2>" else fmt "@ ")
   in
   hovbox_if box 2
     ( wrap_intro
@@ -1366,8 +1367,8 @@ and fmt_fun ?force_closing_paren
                $ fmt "fun" $ break_fun
                $ hvbox 0
                    ( fmt_attributes c ast.pexp_attributes ~suf:" "
-                   $ fmt_fun_args c xargs $ fmt_opt fmt_cstr $ fmt "@ ->" )
-               ) ) )
+                   $ fmt_fun_args c xargs $ fmt_opt fmt_cstr
+                   $ fmt "@;<1 -2>->" ) ) ) )
     $ body $ closing
     $ Cmts.fmt_after c ast.pexp_loc )
 

test/passing/tests/break_fun_decl-fit_or_vertical.ml.ref

@@ -116,3 +116,20 @@ class type ffffffffffffffffffff = object
     -> cccccccccccccccccccccc
     -> dddddddddddddddddddddd
 end
+
+let _ =
+ fun (module Store : Irmin.Generic_key.S with type repo = repo)
+     (module Store : Irmin.Generic_key.S with type repo = repo) ->
+  body
+
+let _ =
+  f
+    (fun
+      (module Store : Irmin.Generic_key.S with type repo = repo)
+      (module Store : Irmin.Generic_key.S with type repo = repo)
+    -> body )
+
+let f
+    (module Store : Irmin.Generic_key.S with type repo = repo)
+    (module Store : Irmin.Generic_key.S with type repo = repo) =
+  body

test/passing/tests/break_fun_decl-smart.ml.ref

@@ -110,3 +110,20 @@ class type ffffffffffffffffffff = object
     -> cccccccccccccccccccccc
     -> dddddddddddddddddddddd
 end
+
+let _ =
+ fun (module Store : Irmin.Generic_key.S with type repo = repo)
+     (module Store : Irmin.Generic_key.S with type repo = repo) ->
+  body
+
+let _ =
+  f
+    (fun
+      (module Store : Irmin.Generic_key.S with type repo = repo)
+      (module Store : Irmin.Generic_key.S with type repo = repo)
+    -> body )
+
+let f
+    (module Store : Irmin.Generic_key.S with type repo = repo)
+    (module Store : Irmin.Generic_key.S with type repo = repo) =
+  body

test/passing/tests/break_fun_decl-wrap.ml.ref

@@ -92,3 +92,19 @@ class type ffffffffffffffffffff = object
     -> cccccccccccccccccccccc
     -> dddddddddddddddddddddd
 end
+
+let _ =
+ fun (module Store : Irmin.Generic_key.S with type repo = repo)
+     (module Store : Irmin.Generic_key.S with type repo = repo) ->
+  body
+
+let _ =
+  f
+    (fun
+      (module Store : Irmin.Generic_key.S with type repo = repo)
+      (module Store : Irmin.Generic_key.S with type repo = repo)
+    -> body )
+
+let f (module Store : Irmin.Generic_key.S with type repo = repo)
+    (module Store : Irmin.Generic_key.S with type repo = repo) =
+  body

test/passing/tests/break_fun_decl.ml

@@ -92,3 +92,19 @@ class type ffffffffffffffffffff = object
     -> cccccccccccccccccccccc
     -> dddddddddddddddddddddd
 end
+
+let _ =
+ fun (module Store : Irmin.Generic_key.S with type repo = repo)
+     (module Store : Irmin.Generic_key.S with type repo = repo) ->
+  body
+
+let _ =
+  f
+    (fun
+      (module Store : Irmin.Generic_key.S with type repo = repo)
+      (module Store : Irmin.Generic_key.S with type repo = repo)
+    -> body )
+
+let f (module Store : Irmin.Generic_key.S with type repo = repo)
+    (module Store : Irmin.Generic_key.S with type repo = repo) =
+  body

test/passing/tests/js_source.ml.ref

@@ -9883,7 +9883,7 @@ let () =
         very_long_argument_name_one
         very_long_argument_name_two
         very_long_argument_name_three
-        -> ())
+      -> ())
 ;;
 
 let () =

test/passing/tests/labelled_args-414.ml.ref

@@ -5,16 +5,16 @@ let _ =
 let () =
   very_long_function_name
     ~very_long_argument_label:(fun
-      very_long_argument_name_one
-      very_long_argument_name_two
-      very_long_argument_name_three
+        very_long_argument_name_one
+        very_long_argument_name_two
+        very_long_argument_name_three
       -> () )
 
 let () =
   very_long_function_name
     ~very_long_argument_label:(* foo *)
       (fun
-      very_long_argument_name_one
-      very_long_argument_name_two
-      very_long_argument_name_three
+        very_long_argument_name_one
+        very_long_argument_name_two
+        very_long_argument_name_three
       -> () )

test/passing/tests/labelled_args.ml

@@ -5,16 +5,16 @@ let _ =
 let () =
   very_long_function_name
     ~very_long_argument_label:(fun
-      very_long_argument_name_one
-      very_long_argument_name_two
-      very_long_argument_name_three
+        very_long_argument_name_one
+        very_long_argument_name_two
+        very_long_argument_name_three
       -> () )
 
 let () =
   very_long_function_name
     ~very_long_argument_label:(* foo *)
       (fun
-      very_long_argument_name_one
-      very_long_argument_name_two
-      very_long_argument_name_three
+        very_long_argument_name_one
+        very_long_argument_name_two
+        very_long_argument_name_three
       -> () )