Skip to content

Commit 3667723

Browse files
seliopouseliopou
authored
Merge pull request #99 from inhabitedtype/util-reorg
Reorg Util module
2 parents 889b037 + 7dae918 commit 3667723

File tree

10 files changed

+413
-171
lines changed

10 files changed

+413
-171
lines changed

‎lib/encoding.ml‎

Lines changed: 69 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,69 @@
1+
(*----------------------------------------------------------------------------
2+
Copyright (c) 2015, 2020 Inhabited Type LLC.
3+
4+
All rights reserved.
5+
6+
Redistribution and use in source and binary forms, with or without
7+
modification, are permitted provided that the following conditions
8+
are met:
9+
10+
1. Redistributions of source code must retain the above copyright
11+
notice, this list of conditions and the following disclaimer.
12+
13+
2. Redistributions in binary form must reproduce the above copyright
14+
notice, this list of conditions and the following disclaimer in the
15+
documentation and/or other materials provided with the distribution.
16+
17+
3. Neither the name of the author nor the names of his contributors
18+
may be used to endorse or promote products derived from this software
19+
without specific prior written permission.
20+
21+
THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
22+
OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
23+
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
24+
DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
25+
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26+
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
27+
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28+
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
29+
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30+
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31+
POSSIBILITY OF SUCH DAMAGE.
32+
----------------------------------------------------------------------------*)
33+
34+
let choose ~available ~acceptable ~default =
35+
let any_prio = List.filter (fun (_, c) -> c = "*" ) acceptable in
36+
let default_prio = List.filter (fun (_, c) -> c = default) acceptable in
37+
let default_ok =
38+
match default_prio with
39+
| [] ->
40+
begin match any_prio with
41+
| [0, _] -> false
42+
| _ -> true
43+
end
44+
| [0, _] -> false
45+
| _ -> true
46+
in
47+
let any_ok =
48+
match any_prio with
49+
| [] | [0, _] -> false
50+
| _ -> true
51+
in
52+
let rec loop available acceptable =
53+
match available, acceptable with
54+
| [], [] -> None
55+
| [], _ -> None
56+
| _ , [] ->
57+
if any_ok then
58+
Some (List.hd available)
59+
else if default_ok then
60+
try Some(default, List.assoc default available) with Not_found -> None
61+
else
62+
None
63+
| _, (0, x)::xs ->
64+
loop (List.filter (fun (y, _) -> x <> y) available) xs
65+
| _, (_, x)::xs ->
66+
try Some(x, List.assoc x available) with Not_found -> loop available xs
67+
in
68+
loop available acceptable
69+
;;

‎lib/encoding.mli‎

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
(*----------------------------------------------------------------------------
2+
Copyright (c) 2020 Inhabited Type LLC.
3+
4+
All rights reserved.
5+
6+
Redistribution and use in source and binary forms, with or without
7+
modification, are permitted provided that the following conditions
8+
are met:
9+
10+
1. Redistributions of source code must retain the above copyright
11+
notice, this list of conditions and the following disclaimer.
12+
13+
2. Redistributions in binary form must reproduce the above copyright
14+
notice, this list of conditions and the following disclaimer in the
15+
documentation and/or other materials provided with the distribution.
16+
17+
3. Neither the name of the author nor the names of his contributors
18+
may be used to endorse or promote products derived from this software
19+
without specific prior written permission.
20+
21+
THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
22+
OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
23+
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
24+
DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
25+
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26+
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
27+
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28+
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
29+
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30+
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31+
POSSIBILITY OF SUCH DAMAGE.
32+
----------------------------------------------------------------------------*)
33+
34+
val choose
35+
: available:(string * 'a) list
36+
-> acceptable:(int * string) list
37+
-> default:string
38+
-> (string * 'a) option

‎lib/etag.ml‎

Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,53 @@
1+
(*----------------------------------------------------------------------------
2+
Copyright (c) 2015 Inhabited Type LLC.
3+
4+
All rights reserved.
5+
6+
Redistribution and use in source and binary forms, with or without
7+
modification, are permitted provided that the following conditions
8+
are met:
9+
10+
1. Redistributions of source code must retain the above copyright
11+
notice, this list of conditions and the following disclaimer.
12+
13+
2. Redistributions in binary form must reproduce the above copyright
14+
notice, this list of conditions and the following disclaimer in the
15+
documentation and/or other materials provided with the distribution.
16+
17+
3. Neither the name of the author nor the names of his contributors
18+
may be used to endorse or promote products derived from this software
19+
without specific prior written permission.
20+
21+
THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
22+
OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
23+
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
24+
DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
25+
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26+
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
27+
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28+
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
29+
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30+
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31+
POSSIBILITY OF SUCH DAMAGE.
32+
----------------------------------------------------------------------------*)
33+
34+
let escape etag =
35+
Printf.sprintf "%S" etag
36+
;;
37+
38+
let unescape s =
39+
let l = String.length s in
40+
if l > 0 && String.get s 0 = '"'
41+
then Scanf.sscanf s "%S" (fun u -> u)
42+
else s
43+
;;
44+
45+
let re_split_ws =
46+
let open Re in
47+
let space = greedy (rep space) in
48+
fun t -> split (compile (seq [space; t; space]))
49+
;;
50+
51+
let from_header s =
52+
List.map unescape (re_split_ws (Re.char ',') s)
53+
;;

‎lib/etag.mli‎

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
(*----------------------------------------------------------------------------
2+
Copyright (c) 2015 Inhabited Type LLC.
3+
4+
All rights reserved.
5+
6+
Redistribution and use in source and binary forms, with or without
7+
modification, are permitted provided that the following conditions
8+
are met:
9+
10+
1. Redistributions of source code must retain the above copyright
11+
notice, this list of conditions and the following disclaimer.
12+
13+
2. Redistributions in binary form must reproduce the above copyright
14+
notice, this list of conditions and the following disclaimer in the
15+
documentation and/or other materials provided with the distribution.
16+
17+
3. Neither the name of the author nor the names of his contributors
18+
may be used to endorse or promote products derived from this software
19+
without specific prior written permission.
20+
21+
THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
22+
OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
23+
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
24+
DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
25+
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26+
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
27+
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28+
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
29+
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30+
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31+
POSSIBILITY OF SUCH DAMAGE.
32+
----------------------------------------------------------------------------*)
33+
34+
val escape : string -> string
35+
val unescape : string -> string
36+
val from_header : string -> string list

‎lib/mediatype.ml‎

Lines changed: 61 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,61 @@
1+
(*----------------------------------------------------------------------------
2+
Copyright (c) 2015 Inhabited Type LLC.
3+
4+
All rights reserved.
5+
6+
Redistribution and use in source and binary forms, with or without
7+
modification, are permitted provided that the following conditions
8+
are met:
9+
10+
1. Redistributions of source code must retain the above copyright
11+
notice, this list of conditions and the following disclaimer.
12+
13+
2. Redistributions in binary form must reproduce the above copyright
14+
notice, this list of conditions and the following disclaimer in the
15+
documentation and/or other materials provided with the distribution.
16+
17+
3. Neither the name of the author nor the names of his contributors
18+
may be used to endorse or promote products derived from this software
19+
without specific prior written permission.
20+
21+
THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
22+
OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
23+
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
24+
DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
25+
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26+
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
27+
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28+
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
29+
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30+
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31+
POSSIBILITY OF SUCH DAMAGE.
32+
----------------------------------------------------------------------------*)
33+
34+
open Cohttp
35+
36+
let media_match (_, (range, _)) (type_, _) =
37+
let type_, subtype =
38+
match Re.Str.(split (regexp "/") type_) with
39+
| [x; y] -> x, y
40+
| _ -> assert false
41+
in
42+
let open Accept in
43+
match range with
44+
| AnyMedia -> true
45+
| AnyMediaSubtype type_' -> type_' = type_
46+
| MediaType (type_', subtype') -> type_' = type_ && subtype' = subtype
47+
;;
48+
49+
let match_header provided header =
50+
let ranges =
51+
try Accept.(media_ranges header |> qsort)
52+
with Parsing.Parse_error -> []
53+
in
54+
let rec loop = function
55+
| [] -> None
56+
| r::rs ->
57+
try Some(List.find (media_match r) provided)
58+
with Not_found -> loop rs
59+
in
60+
loop ranges
61+
;;

‎lib/mediatype.mli‎

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
(*----------------------------------------------------------------------------
2+
Copyright (c) 2015 Inhabited Type LLC.
3+
4+
All rights reserved.
5+
6+
Redistribution and use in source and binary forms, with or without
7+
modification, are permitted provided that the following conditions
8+
are met:
9+
10+
1. Redistributions of source code must retain the above copyright
11+
notice, this list of conditions and the following disclaimer.
12+
13+
2. Redistributions in binary form must reproduce the above copyright
14+
notice, this list of conditions and the following disclaimer in the
15+
documentation and/or other materials provided with the distribution.
16+
17+
3. Neither the name of the author nor the names of his contributors
18+
may be used to endorse or promote products derived from this software
19+
without specific prior written permission.
20+
21+
THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
22+
OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
23+
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
24+
DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
25+
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26+
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
27+
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28+
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
29+
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30+
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31+
POSSIBILITY OF SUCH DAMAGE.
32+
----------------------------------------------------------------------------*)
33+
34+
val match_header : (string * 'a) list -> string option -> (string * 'a) option

‎lib/rfc1123.ml‎

Lines changed: 73 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,73 @@
1+
(*----------------------------------------------------------------------------
2+
Copyright (c) 2015 Inhabited Type LLC.
3+
4+
All rights reserved.
5+
6+
Redistribution and use in source and binary forms, with or without
7+
modification, are permitted provided that the following conditions
8+
are met:
9+
10+
1. Redistributions of source code must retain the above copyright
11+
notice, this list of conditions and the following disclaimer.
12+
13+
2. Redistributions in binary form must reproduce the above copyright
14+
notice, this list of conditions and the following disclaimer in the
15+
documentation and/or other materials provided with the distribution.
16+
17+
3. Neither the name of the author nor the names of his contributors
18+
may be used to endorse or promote products derived from this software
19+
without specific prior written permission.
20+
21+
THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
22+
OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
23+
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
24+
DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
25+
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26+
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
27+
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28+
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
29+
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30+
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31+
POSSIBILITY OF SUCH DAMAGE.
32+
----------------------------------------------------------------------------*)
33+
34+
let parse_date_exn s =
35+
try Scanf.sscanf s "%3s, %d %s %4d %d:%d:%d %s" (
36+
fun _wday mday mon year hour min sec tz ->
37+
let months = [
38+
"Jan", 1; "Feb", 2; "Mar", 3; "Apr", 4; "May", 5; "Jun", 6;
39+
"Jul", 7; "Aug", 8; "Sep", 9; "Oct", 10; "Nov", 11; "Dec", 12
40+
] in
41+
let parse_tz = function
42+
| "" | "Z" | "GMT" | "UTC" | "UT" -> 0
43+
| "PST" -> -480
44+
| "MST" | "PDT" -> -420
45+
| "CST" | "MDT" -> -360
46+
| "EST" | "CDT" -> -300
47+
| "EDT" -> -240
48+
| s -> Scanf.sscanf s "%c%02d%_[:]%02d" (fun sign hour min ->
49+
min + hour * (if sign = '-' then -60 else 60))
50+
in
51+
let mon = List.assoc mon months in
52+
let year =
53+
if year < 50 then year + 2000
54+
else if year < 1000 then year + 1900
55+
else year
56+
in
57+
let date = (year, mon, mday) in
58+
let time = ((hour, min, sec), (parse_tz tz)*60) in
59+
let ptime = Ptime.of_date_time (date, time) in
60+
match ptime with
61+
| None -> raise (Invalid_argument "Invalid date string")
62+
| Some date ->
63+
match Ptime.(Span.to_int_s (to_span date)) with
64+
| None -> raise (Invalid_argument "Invalid date string")
65+
| Some t -> t
66+
)
67+
with
68+
| Scanf.Scan_failure e -> raise (Invalid_argument e)
69+
| Not_found -> raise (Invalid_argument "Invalid date string")
70+
71+
let parse_date s =
72+
try (Some (parse_date_exn s)) with
73+
| Invalid_argument _ -> None

0 commit comments

Comments
 (0)