nest-match=align now works with match%ext. (#2648)

ocaml-ppx · Feb 3, 2025 · 2a071f8 · 2a071f8
1 parent d1a3dc8
commit 2a071f8
Show file tree

Hide file tree

Showing 6 changed files with 233 additions and 1 deletion.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
+