top level alternations work

Author: zazedd

ppx_regexp/transformations.ml

@@ -679,22 +679,17 @@ let transform_type ~mode ~loc rec_flag type_name pattern_str _td =
 
   let pp_func_name = "pp_" ^ type_name in
 
-  let rec build_pp_expr ~top_lvl (node : _ Location.loc) =
+  let rec build_pp_expr (node : _ Location.loc) =
     match node.txt with
     | Regexp_types.Code s -> [%expr Format.pp_print_string ppf [%e estring ~loc @@ unescape_literal s]]
     | Seq es ->
-      let exprs = List.map (build_pp_expr ~top_lvl:false) es in
+      let exprs = List.map build_pp_expr es in
       List.fold_left
         (fun acc e ->
           [%expr
             [%e acc];
             [%e e]])
         [%expr ()] exprs
-    | Alt _ when top_lvl ->
-      Util.error ~loc
-        "Top-level alternations in type definitions are problematic. Consider wrapping the entire alternation in a capture group, though \
-         note that the pretty-printer will only be able to reconstruct one branch."
-        re
     | Alt branches ->
       (* branch selection based on populated fields *)
       build_alt_pp_expr branches
@@ -724,8 +719,8 @@ let transform_type ~mode ~loc rec_flag type_name pattern_str _td =
         match find_capture e with
         | Some name ->
           let field_access = pexp_field ~loc [%expr v] { txt = Lident name; loc } in
-          [%expr match [%e field_access] with None -> () | Some _ -> [%e build_pp_expr ~top_lvl:false e]]
-        | None -> build_pp_expr ~top_lvl:false e
+          [%expr match [%e field_access] with None -> () | Some _ -> [%e build_pp_expr e]]
+        | None -> build_pp_expr e
       end
     | Repeat (range, e) ->
       let min_reps, max_reps_opt = range.txt in
@@ -736,7 +731,7 @@ let transform_type ~mode ~loc rec_flag type_name pattern_str _td =
           [%expr
             let count = [%e eint ~loc min_reps] in
             for _ = 1 to count do
-              [%e build_pp_expr ~top_lvl:false e]
+              [%e build_pp_expr e]
             done]
         | _ ->
           let rec repeat_n n expr =
@@ -747,7 +742,7 @@ let transform_type ~mode ~loc rec_flag type_name pattern_str _td =
                 [%e expr];
                 [%e repeat_n (n - 1) expr]]
           in
-          repeat_n min_reps (build_pp_expr ~top_lvl:false e)
+          repeat_n min_reps (build_pp_expr e)
       end
     | _ -> [%expr ()]
   (* determine branch based on populated fields *)
@@ -778,7 +773,7 @@ let transform_type ~mode ~loc rec_flag type_name pattern_str _td =
               | [ cond ] -> cond
               | conds -> List.fold_left (fun acc cond -> [%expr [%e acc] || [%e cond]]) (List.hd conds) (List.tl conds) )
           in
-          condition, build_pp_expr ~top_lvl:false branch)
+          condition, build_pp_expr branch)
         branches
     in
 
@@ -791,7 +786,7 @@ let transform_type ~mode ~loc rec_flag type_name pattern_str _td =
     build_cascade branch_conditions
   in
 
-  let pp_body = build_pp_expr ~top_lvl:true r in
+  let pp_body = build_pp_expr r in
 
   [
     pstr_type ~loc rec_flag [ type_decl ];

tests/test_ppx_regexp.ml

@@ -662,6 +662,47 @@ let test_parse_http_request _ =
     assert_bool "Should have POST" (String.starts_with ~prefix:"POST" output);
     assert_bool "Should not have query" (not (String.contains output '?'))
 
+(* top-level alternation *)
+type ip_address =
+  {%mikmatch|
+  (digit{1-3} as o1 : int) '.'
+  (digit{1-3} as o2 : int) '.'
+  (digit{1-3} as o3 : int) '.'
+  (digit{1-3} as o4 : int)
+
+  |
+
+  ((['0'-'9' 'a'-'f' 'A'-'F']{0-4} ':')+ ['0'-'9' 'a'-'f' 'A'-'F']{0-4} as ipv6)
+|}
+
+let test_parse_ip1 _ =
+  let ip1 = "192.168.1.1" in
+  match parse_ip_address ip1 with
+  | None -> assert_failure "Should parse ipv4"
+  | Some t ->
+    assert_equal t.o1 (Some 192);
+    assert_equal t.o2 (Some 168);
+    assert_equal t.o3 (Some 1);
+    assert_equal t.o4 (Some 1);
+    assert_equal t.ipv6 None;
+    assert_equal (Format.asprintf "%a" pp_ip_address t) ip1;
+    let t' = { o1 = None; o2 = None; o3 = None; o4 = None; ipv6 = Some "2001:db8::8a2e:370:7334" } in
+    assert_equal (Format.asprintf "%a" pp_ip_address t') "2001:db8::8a2e:370:7334"
+
+let test_parse_ip2 _ =
+  let ip2 = "2001:db8::8a2e:370:7334" in
+  match parse_ip_address ip2 with
+  | None -> assert_failure "Should parse ipv6"
+  | Some t ->
+    assert_equal t.o1 None;
+    assert_equal t.o2 None;
+    assert_equal t.o3 None;
+    assert_equal t.o4 None;
+    assert_equal t.ipv6 (Some "2001:db8::8a2e:370:7334");
+    assert_equal (Format.asprintf "%a" pp_ip_address t) ip2;
+    let t' = { o1 = Some 127; o2 = Some 0; o3 = Some 0; o4 = Some 1; ipv6 = None } in
+    assert_equal (Format.asprintf "%a" pp_ip_address t') "127.0.0.1"
+
 let suite =
   "mikmatch_tests"
   >::: [
@@ -688,6 +729,8 @@ let suite =
          "test_parse_with_neither" >:: test_parse_with_neither;
          "test_parse_url" >:: test_parse_url;
          "test_parse_http_request" >:: test_parse_http_request;
+         "test_parse_ip1" >:: test_parse_ip1;
+         "test_parse_ip2" >:: test_parse_ip2;
        ]
 
 let () = run_test_tt_main suite