fun after let-in is now consistent (ocaml-ppx#2705)

* showcase issue

* fix issue

* changelog

Author: EmileTrotignon

CHANGES.md

@@ -67,6 +67,10 @@ profile. This started with version 0.26.0.
   keyword but `begin` `function`, and `fun` had attributes stuck to the keyword:
   `match[@a]`, but `fun [@a]`. Now its also `fun[@a]`. (#2676, @EmileTrotignon)
 
+- \* The formatting of`let a = b in fun ...` is now consistent with other
+  contexts like `a ; fun ...`. A check for the syntax `let a = fun ... in ...`
+  was made more precise. (#2705, @EmileTrotignon)
+
 ### Changed
 
 - `|> begin`, `~arg:begin`, `begin if`, `lazy begin`, `begin match`,

lib/Fmt_ast.ml

@@ -1664,7 +1664,7 @@ and fmt_function ?force_closing_paren ~ctx ~ctx0 ?pro ~wrap_intro
         ( pro_outer
         $ hvbox_if has_cmts_outer 0
             ( cmts_outer
-            $ Params.Exp.box_fun_decl ~ctx0 c.conf
+            $ Params.Exp.box_fun_decl ~ctx0 ~ctx c.conf
                 ( pro_inner $ cmts_inner
                 $ Params.Exp.box_fun_decl_after_pro ~ctx0
                     (opn_attr_paren $ opn_paren $ head) ) ) )

lib/Params.ml

@@ -329,16 +329,21 @@ module Exp = struct
         then Fn.id
         else hvbox indent
 
-  let box_fun_decl ~ctx0 c k =
-    match ctx0 with
-    | Exp {pexp_desc= Pexp_beginend _; _} -> hovbox 2 k
+  let box_fun_decl ~ctx0 ~ctx c k =
+    match (ctx0, ctx) with
+    | Exp {pexp_desc= Pexp_beginend _; _}, _ -> hovbox 2 k
     | _ when ocp c -> hvbox 2 k
     (* Avoid large indentation for [let _ = function]. *)
-    | Lb
-        { pvb_body= Pfunction_body {pexp_desc= Pexp_function ([], _, _, _); _}
-        ; _ } ->
+    | ( Lb
+          { pvb_body=
+              Pfunction_body {pexp_desc= Pexp_function ([], _, _, _); _}
+          ; _ }
+      , _ ) ->
         hovbox 2 k
-    | Str _ | Lb _ | Clf _ | Exp {pexp_desc= Pexp_let _; _} -> hovbox 4 k
+    | (Str _ | Lb _ | Clf _), _ -> hovbox 4 k
+    | Exp {pexp_desc= Pexp_let (_, e, _); _}, Exp e'
+      when not (phys_equal e e') ->
+        hovbox 4 k
     | _ -> hvbox 2 k
 
   let box_fun_decl_after_pro ~ctx0 =

lib/Params.mli

@@ -78,7 +78,7 @@ module Exp : sig
 
   val single_line_function : ctx:Ast.t -> ctx0:Ast.t -> args:'a list -> bool
 
-  val box_fun_decl : ctx0:Ast.t -> Conf.t -> Fmt.t -> Fmt.t
+  val box_fun_decl : ctx0:Ast.t -> ctx:Ast.t -> Conf.t -> Fmt.t -> Fmt.t
   (** Box a function decl from the label to the arrow. *)
 
   val box_fun_decl_after_pro : ctx0:Ast.t -> Fmt.t -> Fmt.t

test/passing/refs.ahrefs/fun_decl-no-wrap-fun-args.ml.ref

@@ -100,6 +100,14 @@ let _ =
     let _ = () in
     ()
 
+let _ =
+  print_endline "foo";
+  fun (context : Context.t)
+      ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t)
+    ->
+    let _ = () in
+    ()
+
 class traverse_labels h =
   object
     method statement =

test/passing/refs.ahrefs/fun_decl.ml.ref

@@ -83,7 +83,16 @@ let _ =
 let _ =
   let _ = () in
   fun (context : Context.t)
-    ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t) ->
+    ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t)
+  ->
+    let _ = () in
+    ()
+
+let _ =
+  print_endline "foo";
+  fun (context : Context.t)
+    ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t)
+  ->
     let _ = () in
     ()
 

test/passing/refs.ahrefs/js_source.ml.err

@@ -2,4 +2,4 @@ Warning: js_source.ml:136 exceeds the margin
 Warning: js_source.ml:170 exceeds the margin
 Warning: js_source.ml:243 exceeds the margin
 Warning: js_source.ml:255 exceeds the margin
-Warning: js_source.ml:857 exceeds the margin
+Warning: js_source.ml:862 exceeds the margin

test/passing/refs.ahrefs/js_source.ml.ref

@@ -587,8 +587,13 @@ let _ =
 
 let _ =
   let x = x in
-  fun foooooooooooooooooo foooooooooooooooooo foooooooooooooooooo
-    foooooooooooooooooo foooooooooooooooooo foooooooooooooooooo -> ()
+  fun foooooooooooooooooo
+    foooooooooooooooooo
+    foooooooooooooooooo
+    foooooooooooooooooo
+    foooooooooooooooooo
+    foooooooooooooooooo
+  -> ()
 
 module type For_let_syntax_local =
   For_let_syntax_gen

test/passing/refs.default/fun_decl-no-wrap-fun-args.ml.ref

@@ -100,6 +100,14 @@ let _ =
     let _ = () in
     ()
 
+let _ =
+  print_endline "foo";
+  fun (context : Context.t)
+      ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t)
+    ->
+    let _ = () in
+    ()
+
 class traverse_labels h =
   object
     method statement =

test/passing/refs.default/fun_decl.ml.ref

@@ -81,7 +81,16 @@ let _ =
 let _ =
   let _ = () in
   fun (context : Context.t)
-      ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t) ->
+    ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t)
+  ->
+    let _ = () in
+    ()
+
+let _ =
+  print_endline "foo";
+  fun (context : Context.t)
+    ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t)
+  ->
     let _ = () in
     ()