From 2a071f8b8cc8ad74e59f154c1212bf855f353d4e Mon Sep 17 00:00:00 2001
From: Emile Trotignon <emile.trotignon@gmail.com>
Date: Mon, 3 Feb 2025 17:44:30 +0100
Subject: [PATCH] nest-match=align now works with match%ext. (#2648)

---
 CHANGES.md                                 |  2 +
 lib/Params.ml                              | 14 ++++-
 test/passing/refs.default/match.ml.ref     | 48 +++++++++++++++
 test/passing/refs.janestreet/match.ml.ref  | 53 +++++++++++++++++
 test/passing/refs.ocamlformat/match.ml.ref | 68 ++++++++++++++++++++++
 test/passing/tests/match.ml                | 49 ++++++++++++++++
 6 files changed, 233 insertions(+), 1 deletion(-)

diff --git a/CHANGES.md b/CHANGES.md
index 924fe1a5ed..98b64d5dcb 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -12,6 +12,8 @@ profile. This started with version 0.26.0.
   Asterisk-prefixed comments are also now formatted the same way as with the
   default profile.
 
+- Fixed `nested-match=align` not working with `match%ext` (#2648, @EmileTrotignon)
+
 ## 0.27.0
 
 ### Highlight
diff --git a/lib/Params.ml b/lib/Params.ml
index fd5fd4b605..45d5ebce3b 100644
--- a/lib/Params.ml
+++ b/lib/Params.ml
@@ -432,6 +432,17 @@ let get_cases (c : Conf.t) ~ctx ~first ~last ~cmts_before
   let align_nested_match =
     match (ast.pexp_desc, c.fmt_opts.nested_match.v) with
     | (Pexp_match _ | Pexp_try _), `Align -> last
+    | ( Pexp_extension
+          ( ext
+          , PStr
+              [ { pstr_loc= _
+                ; pstr_desc=
+                    Pstr_eval
+                      ({pexp_desc= Pexp_match _ | Pexp_try _; pexp_loc; _}, _)
+                } ] )
+      , `Align )
+      when Source.extension_using_sugar ~name:ext ~payload:pexp_loc ->
+        last
     | _ -> false
   in
   let body_has_parens =
@@ -930,7 +941,8 @@ module Align = struct
 
   let module_pack (c : Conf.t) ~me =
     if not c.fmt_opts.ocp_indent_compat.v then false
-    else (* Align when the constraint is not desugared. *)
+    else
+      (* Align when the constraint is not desugared. *)
       match me.pmod_desc with
       | Pmod_structure _ | Pmod_ident _ -> false
       | _ -> true
diff --git a/test/passing/refs.default/match.ml.ref b/test/passing/refs.default/match.ml.ref
index e39deb4cad..355629a5a9 100644
--- a/test/passing/refs.default/match.ml.ref
+++ b/test/passing/refs.default/match.ml.ref
@@ -71,3 +71,51 @@ let x =
 
 let _ = match x with _ -> b >>= fun () -> c
 let () = match () with _ -> ( fun _ : _ -> match () with _ -> ()) | _ -> ()
+
+[@@@ocamlformat "nested-match=align"]
+
+let () =
+  match f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+  match g y with
+  | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+  | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+  | [] -> ff dda asa
+
+let () =
+  match%ext1 f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+  match g y with
+  | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+  | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+  | [] -> ff dda asa
+
+let () =
+  match f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+  match%ext2 g y with
+  | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+  | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+  | [] -> ff dda asa
+
+let () =
+  match f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+      [%ext2
+        match g y with
+        | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+        | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+        | [] -> ff dda asa]
+
+let () =
+  match%ext1 f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+  match%ext2 g y with
+  | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+  | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+  | [] -> ff dda asa
diff --git a/test/passing/refs.janestreet/match.ml.ref b/test/passing/refs.janestreet/match.ml.ref
index 43ba805479..1ffdfa2c1c 100644
--- a/test/passing/refs.janestreet/match.ml.ref
+++ b/test/passing/refs.janestreet/match.ml.ref
@@ -115,3 +115,56 @@ let () =
        | _ -> ()))
   | _ -> ()
 ;;
+
+[@@@ocamlformat "nested-match=align"]
+
+let () =
+  match f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+  match g y with
+  | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+  | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+  | [] -> ff dda asa
+;;
+
+let () =
+  match%ext1 f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+  match g y with
+  | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+  | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+  | [] -> ff dda asa
+;;
+
+let () =
+  match f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+  match%ext2 g y with
+  | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+  | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+  | [] -> ff dda asa
+;;
+
+let () =
+  match f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+    [%ext2
+      match g y with
+      | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+      | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+      | [] -> ff dda asa]
+;;
+
+let () =
+  match%ext1 f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+  match%ext2 g y with
+  | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+  | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+  | [] -> ff dda asa
+;;
diff --git a/test/passing/refs.ocamlformat/match.ml.ref b/test/passing/refs.ocamlformat/match.ml.ref
index 807f904550..8b74e33275 100644
--- a/test/passing/refs.ocamlformat/match.ml.ref
+++ b/test/passing/refs.ocamlformat/match.ml.ref
@@ -77,3 +77,71 @@ let x =
 let _ = match x with _ -> b >>= fun () -> c
 
 let () = match () with _ -> ( fun _ : _ -> match () with _ -> () ) | _ -> ()
+
+[@@@ocamlformat "nested-match=align"]
+
+let () =
+  match f x with
+  | _ :: _ ->
+      aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+    match g y with
+    | _ :: _ :: _ :: _ ->
+        bbb bbbbb bbbbbbb bbbb bbbb
+    | _ :: _ :: _ ->
+        cc cccc cccc cccc cccc ccc cccccc cccc
+    | [] ->
+        ff dda asa
+
+let () =
+  match%ext1 f x with
+  | _ :: _ ->
+      aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+    match g y with
+    | _ :: _ :: _ :: _ ->
+        bbb bbbbb bbbbbbb bbbb bbbb
+    | _ :: _ :: _ ->
+        cc cccc cccc cccc cccc ccc cccccc cccc
+    | [] ->
+        ff dda asa
+
+let () =
+  match f x with
+  | _ :: _ ->
+      aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+    match%ext2 g y with
+    | _ :: _ :: _ :: _ ->
+        bbb bbbbb bbbbbbb bbbb bbbb
+    | _ :: _ :: _ ->
+        cc cccc cccc cccc cccc ccc cccccc cccc
+    | [] ->
+        ff dda asa
+
+let () =
+  match f x with
+  | _ :: _ ->
+      aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+      [%ext2
+        match g y with
+        | _ :: _ :: _ :: _ ->
+            bbb bbbbb bbbbbbb bbbb bbbb
+        | _ :: _ :: _ ->
+            cc cccc cccc cccc cccc ccc cccccc cccc
+        | [] ->
+            ff dda asa]
+
+let () =
+  match%ext1 f x with
+  | _ :: _ ->
+      aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+    match%ext2 g y with
+    | _ :: _ :: _ :: _ ->
+        bbb bbbbb bbbbbbb bbbb bbbb
+    | _ :: _ :: _ ->
+        cc cccc cccc cccc cccc ccc cccccc cccc
+    | [] ->
+        ff dda asa
diff --git a/test/passing/tests/match.ml b/test/passing/tests/match.ml
index a8e93606ad..f886874a98 100644
--- a/test/passing/tests/match.ml
+++ b/test/passing/tests/match.ml
@@ -69,3 +69,52 @@ let () =
      | _ -> ())
   | _ -> ()
 ;;
+
+[@@@ocamlformat "nested-match=align"]
+
+let () =
+  match f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+  match g y with
+  | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+  | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+  | [] -> ff dda asa
+
+let () =
+  match%ext1 f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+  match g y with
+  | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+  | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+  | [] -> ff dda asa
+
+let () =
+  match f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+  match%ext2 g y with
+  | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+  | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+  | [] -> ff dda asa
+
+let () =
+  match f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+      [%ext2
+        match g y with
+        | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+        | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+        | [] -> ff dda asa]
+
+let () =
+  match%ext1 f x with
+  | _ :: _ -> aaaaa aaaa a aa aaaaaa aaaa
+  | _ ->
+  match%ext2 g y with
+  | _ :: _ :: _ :: _ -> bbb bbbbb bbbbbbb bbbb bbbb
+  | _ :: _ :: _ -> cc cccc cccc cccc cccc ccc cccccc cccc
+  | [] -> ff dda asa
+