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
type name = string
type value = string
type t = (name * value) list
let empty : t = []
let of_rev_list t = t
let of_list t = of_rev_list (List.rev t)
let to_rev_list t = t
let to_list t = List.rev (to_rev_list t)
module CI = struct
let[@inline always] lower c =
if c >= 0x41 && c <= 0x5a then c + 32 else c
let equal x y =
let len = String.length x in
len = String.length y && (
let equal_so_far = ref true in
let i = ref 0 in
while !equal_so_far && !i < len do
let c1 = Char.code (String.unsafe_get x !i) in
let c2 = Char.code (String.unsafe_get y !i) in
equal_so_far := lower c1 = lower c2;
incr i
done;
!equal_so_far
)
end
let rec mem t name =
match t with
| (name', _)::t' -> CI.equal name name' || mem t' name
| _ -> false
let add t name value = (name,value)::t
let add_list t ls = ls @ t
let add_multi =
let rec loop_outer t lss =
match lss with
| [] -> t
| (n,vs)::lss' -> loop_inner t n vs lss'
and loop_inner t n vs lss =
match vs with
| [] -> loop_outer t lss
| v::vs' -> loop_inner ((n,v)::t) n vs' lss
in
loop_outer
let add_unless_exists t name value =
if mem t name then t else (name,value)::t
exception Local
let replace t name value =
let rec loop t needle nv seen =
match t with
| [] ->
if not seen then raise Local else []
| (name,_ as nv')::t ->
if CI.equal needle name
then (
if seen
then loop t needle nv true
else nv::loop t needle nv true)
else nv'::loop t needle nv seen
in
try loop t name (name,value) false
with Local -> t
let remove t name =
let rec loop s needle seen =
match s with
| [] ->
if not seen then raise Local else []
| (name,_ as nv')::s' ->
if CI.equal needle name
then loop s' needle true
else nv'::(loop s' needle seen)
in
try loop t name false
with Local -> t
let get t name =
let rec loop t n =
match t with
| [] -> None
| (n',v)::t' -> if CI.equal n n' then Some v else loop t' n
in
loop t name
let get_exn t name =
let rec loop t n =
match t with
| [] -> failwith (Printf.sprintf "Headers.get_exn: %S not found" name)
| (n',v)::t' -> if CI.equal n n' then v else loop t' n
in
loop t name
let get_multi t name =
let rec loop t n acc =
match t with
| [] -> acc
| (n',v)::t' ->
if CI.equal n n'
then loop t' n (v::acc)
else loop t' n acc
in
loop t name []
let iter ~f t =
List.iter (fun (name,value) -> f name value) t
let fold ~f ~init t =
List.fold_left (fun acc (name,value) -> f name value acc) init t
let to_string t =
let b = Buffer.create 128 in
iter (to_list t) ~f:(fun name value ->
Buffer.add_string b name;
Buffer.add_string b ": ";
Buffer.add_string b value;
Buffer.add_string b "\r\n");
Buffer.add_string b "\r\n";
Buffer.contents b
let pp_hum fmt t =
let pp_elem fmt (n,v) = Format.fprintf fmt "@[(%S %S)@]" n v in
Format.fprintf fmt "@[(";
Format.pp_print_list pp_elem fmt (to_list t);
Format.fprintf fmt ")@]";