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
type error = Iri_types.error
exception Error = Iri_types.Error
open Iri_types
let string_of_error = function
| Parse_error (str,e) ->
let msg =
match e with
Iri_lexer.Error e -> Iri_lexer.string_of_error e
| _ -> Printexc.to_string e
in
Printf.sprintf "Parse error in %s\n%s" str msg
let parse_error str e = raise (Error (Parse_error (str, e)))
type iri = t
module Ord = struct
type t = iri
let compare = Iri_types.compare ~normalize:true
end
module Set = Set.Make(Ord)
module Map = Map.Make(Ord)
let of_lexbuf ?pctdecode ?pos ?normalize lexbuf =
let iri = Iri_lexer.iri ?pctdecode ?pos lexbuf in
match normalize, is_relative iri with
Some true, _
| None, false -> Iri_types.normalize iri
| _ -> iri
let of_string ?pctdecode ?pos ?normalize str =
let lexbuf = Sedlexing.Utf8.from_string str in
try of_lexbuf ?pctdecode ?pos ?normalize lexbuf
with (Iri_lexer.Error _ ) as e -> parse_error str e
let resolve ?(normalize=true) ~base iri =
let resolved =
match is_relative iri with
false -> iri
| true ->
let str = to_string iri in
let len = String.length str in
if len <= 0 then
base
else
match String.get str 0 with
| '#' -> with_fragment base (fragment iri)
| '?' ->
let base = with_fragment base None in
with_query base (query iri)
| _ ->
let base = with_query base None in
let base = with_fragment base None in
let base =
match host iri with
None -> base
| Some host ->
let base = with_host base (Some host) in
let base = with_port base (port iri) in
with_user base (user iri)
in
let path =
match path iri with
| Absolute p -> Absolute p
| Relative iri_path ->
let path_base = path base in
let path =
let l = match path_base with
| Absolute l -> l
| Relative l -> l
in
let rl = List.rev l in
let rip = List.rev iri_path in
let p = match rl, rip with
| [], _ -> List.rev rip
| "" :: ql, [] -> l
| "" :: ql, _ -> List.rev (rip @ ql)
| _ :: ql, _ -> List.rev (rip @ ql)
in
match path_base with
| Absolute _ -> Absolute p
| Relative _ -> Relative p
in
path
in
let i = with_path base path in
let i = with_fragment i (fragment iri) in
let i = with_query i (query iri) in
i
in
if normalize then Iri_types.normalize resolved else resolved
let parse_http_link str =
let lexbuf =
try Sedlexing.Utf8.from_string str
with Sedlexing.MalFormed as e ->
raise (Error (Parse_error ("Malformed character in http link: "^str, e)))
in
Iri_lexer.http_link lexbuf
let to_uri = Iri_types.to_uri
let normalize = Iri_types.normalize
let with_fragment = Iri_types.with_fragment
let fragment = Iri_types.fragment
let query_set = Iri_types.query_set
let query_opt = Iri_types.query_opt
let query_get = Iri_types.query_get
let with_query_kv = Iri_types.with_query_kv
let with_query = Iri_types.with_query
let query_kv = Iri_types.query_kv
let query = Iri_types.query
let append_path = Iri_types.append_path
let path_string = Iri_types.path_string
let with_path = Iri_types.with_path
let path = Iri_types.path
let with_port = Iri_types.with_port
let port = Iri_types.port
let with_host = Iri_types.with_host
let host = Iri_types.host
let with_user = Iri_types.with_user
let user = Iri_types.user
let with_scheme = Iri_types.with_scheme
let scheme = Iri_types.scheme
let to_string = Iri_types.to_string
let to_string_details = Iri_types.to_string_details
let pp = Iri_types.pp
let pp_details = Iri_types.pp_details
let equal = Iri_types.equal
let compare = Iri_types.compare
let is_relative = Iri_types.is_relative
let is_absolute = Iri_types.is_absolute
let iri = Iri_types.iri
type t = Iri_types.t
type path = Iri_types.path = Absolute of string list | Relative of string list
type query_kv = Iri_types.query_kv
module KV = Iri_types.KV