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
module Routes_private = struct
module Util = Util
end
module Method = struct
type t =
[ `GET
| `HEAD
| `POST
| `PUT
| `DELETE
| `CONNECT
| `OPTIONS
| `TRACE
]
let to_int = function
| `GET -> 1
| `HEAD -> 2
| `POST -> 3
| `PUT -> 4
| `DELETE -> 5
| `CONNECT -> 6
| `OPTIONS -> 7
| `TRACE -> 8
;;
end
type 'a t = 'a Parser.t
module R = struct
type 'a t =
{ routes : 'a Parser.t Router.t array
; url_split : string -> string list
}
let create url_split routes = { routes; url_split }
end
type 'a router = 'a R.t
let empty = Parser.empty
let str = Parser.str
let int = Parser.int
let int32 = Parser.int32
let int64 = Parser.int64
let bool = Parser.bool
let s = Parser.s
let apply = Parser.apply
let return = Parser.return
module Infix = struct
include Parser.Infix
end
let with_method ?(ignore_trailing_slash = true) routes =
let routes = List.rev routes in
let a = Array.make 9 Router.empty in
List.iter
(fun (m, r) ->
let idx = Method.to_int m in
let current_routes = a.(idx) in
let patterns = Parser.get_patterns r in
a.(idx) <- Router.add patterns (Parser.strip_route r) current_routes)
routes;
R.create (Util.split_path ignore_trailing_slash) a
;;
let one_of ?(ignore_trailing_slash = true) routes =
let routes = List.rev routes in
let a = Array.make 9 Router.empty in
let r =
List.fold_left
(fun acc r ->
let patterns = Parser.get_patterns r in
Router.add patterns (Parser.strip_route r) acc)
Router.empty
routes
in
a.(0) <- r;
R.create (Util.split_path ignore_trailing_slash) a
;;
let run_route routes params =
let rec aux routes =
match routes with
| [] -> None
| r :: rs ->
(match Parser.parse r params with
| Some (res, []) -> Some res
| _ -> aux rs)
in
aux routes
;;
let run_router t params =
let routes, params' = Router.feed_params t params in
run_route routes params'
;;
let match' { R.routes; url_split } target = run_router routes.(0) (url_split target)
let match_with_method { R.routes; url_split } ~target ~meth =
let idx = Method.to_int meth in
run_router routes.(idx) (url_split target)
;;