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
(** *)
type t =
{ stamp : Ptime.t ;
tz: Ptime.tz_offset_s option ;
}
let of_string ?loc str =
match Ptime.of_rfc3339 str with
Ok (stamp, tz, _) -> { stamp ; tz }
| Error (`RFC3339 ((p1,p2), e)) ->
let b = Buffer.create 256 in
let fmt = Format.formatter_of_buffer b in
if p2 > p1 then
Format.fprintf fmt "Characters %d-%d: " p1 p2
else
Format.fprintf fmt "Character %d: " p1;
Ptime.pp_rfc3339_error fmt e;
Format.pp_print_flush fmt () ;
let err = Buffer.contents b in
Error.invalid_date ?loc str err
let of_string_date ?loc str =
try of_string ?loc (str^"T00:00:00Z")
with e ->
try Scanf.sscanf str "%d/%d/%d"
(fun y m d -> of_string ?loc (Printf.sprintf "%04d-%02d-%02dT00:00:00Z" y m d))
with _ -> raise e
let to_string t = Ptime.to_rfc3339 ?tz_offset_s: t.tz t.stamp
let of_float t =
match Ptime.of_float_s t with
| Some stamp -> { stamp ; tz = None }
| None -> failwith (Printf.sprintf "Could not create date from %f" t)
let now () = of_float (Unix.time())
let to_date_time t =
Ptime.to_date_time ?tz_offset_s: t.tz t.stamp
let weekday t = Ptime.weekday ?tz_offset_s: t.tz t.stamp
let to_rfc_822 t =
let wd =
match weekday t with
| `Sun -> "Sun"
| `Mon -> "Mon"
| `Tue -> "Tue"
| `Wed -> "Wed"
| `Thu -> "Thu"
| `Fri -> "Fri"
| `Sat -> "Sat"
in
let ((y,m,d),((h,mi,s),tz)) = to_date_time t in
let mon =
match m with
1 -> "Jan"
| 2 -> "Feb"
| 3 -> "Mar"
| 4 -> "Apr"
| 5 -> "May"
| 6 -> "Jun"
| 7 -> "Jul"
| 8 -> "Aug"
| 9 -> "Sep"
| 10 -> "Oct"
| 11 -> "Nov"
| _ -> "Dec"
in
let abs_tz = abs tz in
Printf.sprintf "%s, %02d %s %04d %02d:%02d:%02d %c%02d%02d"
wd d mon y h mi s
(if tz < 0 then '-' else '+')
(abs_tz mod 3600) (abs_tz mod 60)
let cp_percent = Uchar.of_char '%'
let format t fmt =
match fmt with
"rfc3339" -> to_string t
| "rfc822" -> to_rfc_822 t
| _ ->
let b = Buffer.create 256 in
let ((y,m,d),((h,mi,s),tz)) = to_date_time t in
let f prev_cp i = function
`Malformed str ->
begin
match prev_cp with
None -> ()
| Some prev_cp -> Uutf.Buffer.add_utf_8 b prev_cp
end;
Buffer.add_string b str ;
None
| `Uchar cp ->
match prev_cp with
| Some prev_cp when Uchar.equal prev_cp cp_percent ->
let () =
match Uchar.to_int cp with
| 89 -> Buffer.add_string b (string_of_int y)
| 77 -> Printf.bprintf b "%02d" m
| 68 -> Printf.bprintf b "%02d" d
| 104 -> Printf.bprintf b "%02d" h
| 109 -> Printf.bprintf b "%02d" mi
| 115 -> Printf.bprintf b "%02d" s
| _ when Uchar.equal cp cp_percent -> Buffer.add_char b '%'
| _ ->
Uutf.Buffer.add_utf_8 b prev_cp ;
Uutf.Buffer.add_utf_8 b cp
in
None
| Some prev_cp ->
Uutf.Buffer.add_utf_8 b prev_cp ;
Some cp
| None ->
Some cp
in
(match Uutf.String.fold_utf_8 f None fmt with
None -> ()
| Some remain -> Uutf.Buffer.add_utf_8 b remain
);
Buffer.contents b