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
open Import
type path_segment =
| Match of string
| Param of string
| Splat
| FullSplat
| Slash
type matches =
{ params : (string * string) list
; splat : string list
}
let sexp_of_matches { params; splat } =
let splat' = Sexp_conv.sexp_of_list Sexp_conv.sexp_of_string splat in
let sexp_of_param (a, b) = Sexp_conv.sexp_of_list Sexp_conv.sexp_of_string [ a; b ] in
Sexp.List
[ List [ Atom "params"; Sexp_conv.sexp_of_list sexp_of_param params ]
; List [ Atom "splat"; splat' ]
]
;;
type t = path_segment list
let parse_param s =
if s = "/"
then Slash
else if s = "*"
then Splat
else if s = "**"
then FullSplat
else (
try Scanf.sscanf s ":%s" (fun s -> Param s) with
| Scanf.Scan_failure _ -> Match s)
;;
let of_list l =
let last_i = List.length l - 1 in
l
|> List.mapi ~f:(fun i s ->
match parse_param s with
| FullSplat when i <> last_i -> invalid_arg "** is only allowed at the end"
| x -> x)
;;
let split_slash_delim =
let re = '/' |> Re.char |> Re.compile in
fun path ->
path
|> Re.split_full re
|> List.map ~f:(function
| `Text s -> `Text s
| `Delim _ -> `Delim)
;;
let split_slash path =
path
|> split_slash_delim
|> List.map ~f:(function
| `Text s -> s
| `Delim -> "/")
;;
let of_string path = path |> split_slash |> of_list
let to_string l =
let r =
l
|> List.filter_map ~f:(function
| Match s -> Some s
| Param s -> Some (":" ^ s)
| Splat -> Some "*"
| FullSplat -> Some "**"
| Slash -> None)
|> String.concat ~sep:"/"
in
"/" ^ r
;;
let rec match_url t url ({ params; splat } as matches) =
match t, url with
| [], [] | [ FullSplat ], _ -> Some matches
| FullSplat :: _, _ -> assert false
| Match x :: t, `Text y :: url when x = y -> match_url t url matches
| Slash :: t, `Delim :: url -> match_url t url matches
| Splat :: t, `Text s :: url ->
match_url t url { matches with splat = Uri.pct_decode s :: splat }
| Param name :: t, `Text p :: url ->
match_url t url { matches with params = (name, Uri.pct_decode p) :: params }
| Splat :: _, `Delim :: _
| Param _ :: _, `Delim :: _
| Match _ :: _, _
| Slash :: _, _
| _ :: _, []
| [], _ :: _ -> None
;;
let match_url t url =
let path =
match String.index_opt url '?' with
| None -> url
| Some i -> String.sub url ~pos:0 ~len:i
in
let path = path |> split_slash_delim in
match_url t path { params = []; splat = [] }
;;