Add union. (#115)

* Add union.

* Add union tests.

src/routes.ml

@@ -76,6 +76,28 @@ module PatternTrie = struct
     in
     aux k t
   ;;
+
+  let rec union t1 t2 =
+    let parsers = t1.parsers @ t2.parsers in
+    let children =
+      KeyMap.merge
+        (fun _ l r ->
+          match l, r with
+          | None, None -> assert false
+          | None, Some r -> Some r
+          | Some l, None -> Some l
+          | Some l, Some r -> Some (union l r))
+        t1.children t2.children
+    in
+    let capture =
+      match t1.capture, t2.capture with
+      | None, None -> None
+      | Some l, None -> Some l
+      | None, Some r -> Some r
+      | Some l, Some r -> Some (union l r)
+    in
+    { parsers; children; capture }
+  ;;
 end
 
 type 'a conv =
@@ -202,6 +224,9 @@ let one_of routes =
     routes
 ;;
 
+let union = PatternTrie.union
+;;
+
 let add_route route routes =
   let (Route ({ path; _ }, _)) = route in
   let patterns = route_pattern path in

src/routes.mli

@@ -203,3 +203,6 @@ val pp_route : Format.formatter -> 'a route -> unit
 
     @since 0.7.3 *)
 val add_route : 'b route -> 'b router -> 'b router
+
+(** [union] performs a left-biased merge of two routers. *)
+val union : 'a router -> 'a router -> 'a router

test/routing_test.ml

@@ -42,6 +42,43 @@ let test_add_route () =
     (match' router ~target:"/user/john/12")
 ;;
 
+let test_union_routes () =
+  let open Routes in
+
+  let union_law nb t rs1 rs2 targets =
+    let router_of_list routers =
+      List.fold_right add_route routers (one_of []) in
+    let router1 = router_of_list (rs1 @ rs2) in
+    let router2 = union (router_of_list rs1) (router_of_list rs2) in
+    Alcotest.(check (list (option t)))
+      (Printf.sprintf "union law %d" nb)
+      (List.map (fun target -> match' router1 ~target) targets)
+      (List.map (fun target -> match' router2 ~target) targets)
+  in
+
+  let r1 = ((s "foo" / int /? nil) @--> fun i -> i) in
+  let r2 = ((s "bar" / int /? nil) @--> fun i -> i) in
+  let r3 = ((s "foo" / int / s "bar" / int /? nil) @--> fun i j -> i + j) in
+  let r4 = ((s "bar" / s "baz" /? nil) @--> 0) in
+
+  let targets = ["foo/10"; "bar/20"; "foo/10/bar/20"; "bar/baz"; "baz"] in
+  union_law 1 Alcotest.int [r1] [] targets;
+  union_law 2 Alcotest.int [] [r1] targets;
+  union_law 3 Alcotest.int [r1] [r2] targets;
+  union_law 4 Alcotest.int [r1;r2] [r3;r4] targets;
+  union_law 5 Alcotest.int [r3;r4] [r1;r2] targets;
+;;
+
+let test_left_bias_union () =
+  let open Routes in
+  let r1 = one_of [ ((s "foo" / int /? nil) @--> fun i -> i) ] in
+  let r2 = one_of [ ((s "foo" / int /? nil) @--> fun i -> -i) ] in
+  Alcotest.(check (option int))
+    "A union matches the left routes in preference to the right"
+    (Some 10)
+    (match' (union r1 r2) ~target:"foo/10")
+;;
+
 let test_extractors () =
   let open Routes in
   let router =
@@ -248,6 +285,8 @@ let () =
     ; "Can work with custom patterns", `Quick, test_custom_pattern
     ; "Discards query params", `Quick, test_matcher_discards_query_params
     ; "Can add a route", `Quick, test_add_route
+    ; "Union of routers is lawful", `Quick, test_union_routes
+    ; "Unions are left-biased", `Quick, test_left_bias_union
     ]
   in
   Alcotest.run "Tests" [ "Routes tests", tests ]