-
Notifications
You must be signed in to change notification settings - Fork 11
/
routing_test.ml
353 lines (334 loc) · 12.4 KB
/
routing_test.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
open! Base
open! Stdio
let ensure_empty ~target ~msg router =
let open Routes in
match match' ~target router with
| Routes.NoMatch -> printf "%s\n" msg
| _ -> assert false
;;
let ensure_string_match ~target router =
let open Routes in
match match' ~target router with
| Routes.NoMatch -> printf "%s\n" "No route matched"
| FullMatch r -> printf "Exact match with result = %s\n" r
| MatchWithTrailingSlash r ->
printf
"Not exact match, but found a matching route with a trailing slash with result = %s\n"
r
;;
let ensure_string_match' ~target router =
let open Routes in
match match' ~target router with
| Routes.NoMatch -> None
| FullMatch r -> Some (Printf.sprintf "Exact match with result = %s" r)
| MatchWithTrailingSlash r ->
Some
(Printf.sprintf
"Not exact match, but found a matching route with a trailing slash with result \
= %s"
r)
;;
let%expect_test "test no match" =
let open Routes in
let router = one_of [] in
ensure_empty ~target:"/foo/bar" ~msg:"No route matched" router;
[%expect {| No route matched |}];
ensure_empty ~target:"" ~msg:"Empty router has no match for empty target" router;
[%expect {| Empty router has no match for empty target |}]
;;
let%expect_test "test add route" =
let open Routes in
let router = one_of [] in
ensure_empty ~target:"/foo/bar" ~msg:"Empty router has no match" router;
[%expect {| Empty router has no match |}];
let router = add_route ((s "foo" / str /? nil) @--> fun a -> a) router in
ensure_string_match ~target:"/foo/bar" router;
[%expect {| Exact match with result = bar |}];
let router =
List.fold_left
~f:(fun acc r -> add_route r acc)
~init:(one_of [])
[ ((s "user" / str / int /? nil)
@--> fun name age -> Printf.sprintf "%s %d" name age)
; ((int / int /? nil) @--> fun a b -> Printf.sprintf "%d" (a + b))
]
in
ensure_string_match ~target:"/2/3" router;
[%expect {| Exact match with result = 5 |}];
ensure_string_match ~target:"/user/john/12" router;
[%expect {| Exact match with result = john 12 |}]
;;
let%expect_test "test union of routers" =
let open Routes in
let union_law nb rs1 rs2 targets =
let router_of_list routers = List.fold_right ~f:add_route routers ~init:(one_of []) in
let router1 = router_of_list (rs1 @ rs2) in
let router2 = union (router_of_list rs1) (router_of_list rs2) in
let left = List.map targets ~f:(fun target -> ensure_string_match' router1 ~target) in
let right =
List.map targets ~f:(fun target -> ensure_string_match' router2 ~target)
in
let equal = List.equal (Option.equal String.equal) left right in
printf
"%s\n"
(if equal
then Printf.sprintf "Union law %d - %b" nb equal
else Printf.sprintf "Union law %d - %b" nb equal)
in
let r1 = (s "foo" / int /? nil) @--> fun i -> Int.to_string i in
let r2 = (s "bar" / int /? nil) @--> fun i -> Int.to_string i in
let r3 = (s "foo" / int / s "bar" / int /? nil) @--> fun i j -> Int.to_string (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 [ r1 ] [] targets;
union_law 2 [] [ r1 ] targets;
union_law 3 [ r1 ] [ r2 ] targets;
union_law 4 [ r1; r2 ] [ r3; r4 ] targets;
union_law 5 [ r3; r4 ] [ r1; r2 ] targets;
[%expect
{|
Union law 1 - true
Union law 2 - true
Union law 3 - true
Union law 4 - true
Union law 5 - true |}]
;;
let%expect_test "test left biased union" =
let open Routes in
let r1 = one_of [ ((s "foo" / int /? nil) @--> fun i -> Int.to_string i) ] in
let r2 = one_of [ ((s "foo" / int /? nil) @--> fun i -> Int.to_string (-i)) ] in
let router = union r1 r2 in
ensure_string_match ~target:"foo/10" router;
[%expect {| Exact match with result = 10 |}]
;;
let%expect_test "test map" =
let open Routes in
let route = (s "foo" / int /? nil) @--> fun i -> i in
let option_map_with_int_result =
Option.map
~f:Int.to_string
(match match' (one_of [ route ]) ~target:"foo/5" with
| FullMatch x -> Some x
| MatchWithTrailingSlash r -> Some r
| NoMatch -> None)
in
let route_map =
match match' (one_of [ map Int.to_string route ]) ~target:"foo/5" with
| Routes.FullMatch x -> Some x
| MatchWithTrailingSlash r -> Some r
| NoMatch -> None
in
printf
"Routes.map f === Monad.map on the result of the route match = %b\n"
(Option.equal String.equal option_map_with_int_result route_map);
[%expect {| Routes.map f === Monad.map on the result of the route match = true |}]
;;
let%expect_test "test extractors" =
let open Routes in
let router =
one_of
[ ((s "foo" / str /? nil) @--> fun a -> a)
; ((s "numbers" / int / int64 / int32 /? nil)
@--> fun a b c -> Printf.sprintf "%d-%Ld-%ld" a b c)
; ((s "bar" /? wildcard) @--> fun a -> Routes.Parts.wildcard_match a)
; ((s "baz" / int / s "and" /? wildcard)
@--> fun a b -> Printf.sprintf "%d-%s" a (Routes.Parts.wildcard_match b))
]
in
ensure_string_match ~target:"foo/Movie" router;
[%expect {| Exact match with result = Movie |}];
ensure_string_match ~target:"/numbers/1/2/3" router;
[%expect {| Exact match with result = 1-2-3 |}];
ensure_string_match ~target:"/bar" router;
[%expect {| Exact match with result = |}];
ensure_string_match ~target:"/bar/a" router;
[%expect {| Exact match with result = /a |}];
ensure_string_match ~target:"/bar/a/" router;
[%expect {| Exact match with result = /a/ |}];
ensure_string_match ~target:"/bar/a/b" router;
[%expect {| Exact match with result = /a/b |}];
ensure_string_match ~target:"/baz/42/and/x/y/z/" router;
[%expect {| Exact match with result = 42-/x/y/z/ |}]
;;
let%expect_test "test leading slash is discarded" =
let open Routes in
let router = one_of [ (s "foo" /? nil) @--> "foo"; nil @--> "empty" ] in
let results =
[ ensure_string_match' ~target:"foo" router
; ensure_string_match' ~target:"/foo" router
; ensure_string_match' ~target:"/" router
; ensure_string_match' ~target:"" router
]
in
printf !"%{sexp: string option list}" results;
[%expect
{|
(("Exact match with result = foo") ("Exact match with result = foo")
("Exact match with result = empty") ("Exact match with result = empty")) |}]
;;
let%expect_test "verify that first parsed route matches" =
let open Routes in
let routes =
one_of
[ nil @--> "empty"
; (s "foo" / int /? nil) @--> Int.to_string_hum
; (s "foo" / str /? nil) @--> String.uppercase
; (s "foo" / bool /? nil) @--> Bool.to_string
]
in
let routes' =
one_of
[ nil @--> "empty"
; ((s "foo" / str /? nil) @--> fun s -> Int.to_string_hum (String.length s))
; (s "foo" / int /? nil) @--> Int.to_string_hum
; (s "foo" / bool /? nil) @--> Bool.to_string
]
in
let results =
[ ( "Matches the first route that parses successfully"
, ensure_string_match' ~target:"/foo/121" routes )
; ( "Matches the string route since int match failed"
, ensure_string_match' ~target:"/foo/ocaml" routes )
; ( "Matches the first string route and does not go to the int matcher"
, ensure_string_match' ~target:"/foo/451" routes' )
]
in
printf !"%{sexp: (string * string option) list}\n" results;
[%expect
{|
(("Matches the first route that parses successfully"
("Exact match with result = 121"))
("Matches the string route since int match failed"
("Exact match with result = OCAML"))
("Matches the first string route and does not go to the int matcher"
("Exact match with result = 3"))) |}]
;;
let%expect_test "match routes with a common prefix" =
let open Routes in
let routes =
one_of
[ nil @--> "root"
; (s "foo" / s "bar" /? nil) @--> "one"
; (s "foo" /? nil) @--> "two"
]
in
let results =
[ "Matches empty route", ensure_string_match' ~target:"/" routes
; "Matches first overlapping path param", ensure_string_match' ~target:"/foo" routes
; ( "Matches first overlapping path param"
, ensure_string_match' ~target:"/foo/bar/" routes )
; ( "Matches first overlapping path param"
, ensure_string_match' ~target:"/foo/bar" routes )
]
in
printf !"%{sexp: (string * string option) list}\n" results;
[%expect
{|
(("Matches empty route" ("Exact match with result = root"))
("Matches first overlapping path param" ("Exact match with result = two"))
("Matches first overlapping path param"
("Not exact match, but found a matching route with a trailing slash with result = one"))
("Matches first overlapping path param" ("Exact match with result = one"))) |}]
;;
let%expect_test "test route patterns" =
let open Routes in
let r1 = s "foo" / s "bar" /? nil in
let r2 = s "foo" / int / bool /? nil in
let r3 = s "foo" / str / bool /? nil in
let r4 = s "baz" /? wildcard in
let r5 = (s "hello" / s "world" /? nil) @--> "Route" in
let results =
[ "empty", string_of_path nil
; "foo_bar", string_of_path r1
; "foo_int_bool", string_of_path r2
; "sprintf foo_int_bool", sprintf r2 12 true
; "foo_string_bool", string_of_path r3
; "sprintf_string_bool", sprintf r3 "hello" false
; "wildcard", string_of_path r4
; "pretty_print_route", string_of_route r5
]
in
printf !"%{sexp: (string * string) list}\n" results;
[%expect
{|
((empty /) (foo_bar /foo/bar) (foo_int_bool /foo/:int/:bool)
("sprintf foo_int_bool" /foo/12/true) (foo_string_bool /foo/:string/:bool)
(sprintf_string_bool /foo/hello/false) (wildcard /baz/:wildcard)
(pretty_print_route /hello/world)) |}]
;;
type shape =
| Circle
| Square
let shape_of_string = function
| "Circle" | "circle" -> Some Circle
| "Square" | "square" -> Some Square
| _ -> None
;;
let shape_to_string = function
| Circle -> "circle"
| Square -> "square"
;;
let%expect_test "test custom pattern" =
let open Routes in
let shape = pattern shape_to_string shape_of_string ":shape" in
let shape' = custom ~serialize:shape_to_string ~parse:shape_of_string ~label:":shape" in
let r1 () =
(s "foo" / int / s "shape" / shape' /? nil)
@--> fun c shape -> Printf.sprintf "%d - %s" c (shape_to_string shape)
in
let r2 () = s "shape" / shape / s "create" /? nil in
let router = one_of [ r1 () ] in
let results =
[ ( "can match a custom pattern"
, ensure_string_match' ~target:"/foo/12/shape/Circle" router )
; ( "Invalid shape does not match"
, ensure_string_match' ~target:"/foo/12/shape/rectangle" router )
; "pretty print custom pattern", Some (string_of_route (r1 ()))
; "serialize route with custom pattern", Some (sprintf (r2 ()) Square)
]
in
printf !"%{sexp: (string * string option) list}\n" results;
[%expect
{|
(("can match a custom pattern" ("Exact match with result = 12 - circle"))
("Invalid shape does not match" ())
("pretty print custom pattern" (/foo/:int/shape/:shape))
("serialize route with custom pattern" (/shape/square/create))) |}]
;;
let%expect_test "route matcher discards query params" =
let open Routes in
let routes = one_of [ ((s "foo" / str /? nil) @--> fun x -> x); nil @--> "root" ] in
ensure_string_match ~target:"/foo/hello?baz=bar" routes;
ensure_string_match ~target:"?baz=bar" routes;
[%expect {|
Exact match with result = hello
Exact match with result = root |}]
;;
let%expect_test "test prefixing targets" =
let open Routes in
let add_route path1 path2 handler (routes1, routes2) =
let routes1 = routes1 |> add_route ((path1 / path2 /? nil) @--> handler) in
let routes2 = routes2 |> add_route ((path1 /~ (path2 /? nil)) @--> handler) in
routes1, routes2
in
let check_target (routes1, routes2) target =
let left = ensure_string_match' ~target routes1 in
let right = ensure_string_match' ~target routes2 in
printf
"Router1 and Router2 provide the same result = %b\n"
(Option.equal String.equal left right)
in
let routes =
(one_of [], one_of [])
|> add_route (s "foo") (s "bar") "10"
|> add_route (s "foo") int (fun n -> Int.to_string_hum n)
in
check_target routes "foo/bar";
check_target routes "foo/bar/10";
check_target routes "foo/10";
[%expect
{|
Router1 and Router2 provide the same result = true
Router1 and Router2 provide the same result = true
Router1 and Router2 provide the same result = true |}]
;;