My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1open Printf
2open Scanf
3
4type t = Ptime.t
5
6let epoch = Ptime.epoch
7let compare = Ptime.compare
8let max d1 d2 = if compare d1 d2 < 0 then d2 else d1
9let min d1 d2 = if compare d1 d2 < 0 then d1 else d2
10let month_to_int = Hashtbl.create 12
11
12let () =
13 let add m i = Hashtbl.add month_to_int m i in
14 add "Jan" 1 ;
15 add "Feb" 2 ;
16 add "Mar" 3 ;
17 add "Apr" 4 ;
18 add "May" 5 ;
19 add "Jun" 6 ;
20 add "Jul" 7 ;
21 add "Aug" 8 ;
22 add "Sep" 9 ;
23 add "Oct" 10 ;
24 add "Nov" 11 ;
25 add "Dec" 12
26
27let map f = function Some x -> f x | None -> None
28let map2 f a b = match (a, b) with Some a, Some b -> f a b | _ -> None
29
30(* RFC3339 date *)
31let of_rfc3339 s =
32 match Ptime.of_rfc3339 ~strict:false s with
33 | Result.Error _ ->
34 invalid_arg (sprintf "Syndic.Date.of_string: cannot parse %S" s)
35 | Result.Ok (t, tz_offset_s, _) -> (
36 match Ptime.of_date_time @@ Ptime.to_date_time ?tz_offset_s t with
37 | Some x -> x
38 | None -> invalid_arg (sprintf "Syndic.Data.of_string: cannot part %S" s) )
39
40(* Format:
41 http://www.rssboard.org/rss-specification#ltpubdategtSubelementOfLtitemgt
42 Examples: Sun, 19 May 2002 15:21:36 GMT Sat, 25 Sep 2010 08:01:00 -0700 20
43 Mar 2013 03:47:14 +0000 *)
44let of_rfc822 s =
45 let make_date day month year h m maybe_s z =
46 let month =
47 if String.length month <= 3 then month else String.sub month 0 3
48 in
49 let month = Hashtbl.find month_to_int month in
50 let date = Ptime.of_date (year, month, day) in
51 let s =
52 if maybe_s <> "" && maybe_s.[0] = ':' then
53 float_of_string (String.sub maybe_s 1 (String.length maybe_s - 1))
54 else 0.
55 in
56 let span = Ptime.Span.of_int_s ((h * 3600) + (m * 60)) in
57 let span =
58 map (fun x -> Some (Ptime.Span.add span x)) (Ptime.Span.of_float_s s)
59 in
60 let date_and_time =
61 if z = "" || z = "GMT" || z = "UT" || z = "Z" then
62 map2 (fun date span -> Ptime.add_span date span) date span
63 |> map (fun x -> Some (Ptime.to_date_time x))
64 else
65 (* FIXME: this should be made more robust. *)
66 let tz_offset_s =
67 match z with
68 | "EST" -> -5 * 3600
69 | "EDT" -> -4 * 3600
70 | "CST" -> -6 * 3600
71 | "CDT" -> -5 * 3600
72 | "MST" -> -7 * 3600
73 | "MDT" -> -6 * 3600
74 | "PST" -> -8 * 3600
75 | "PDT" -> -7 * 3600
76 | "A" -> -1 * 3600
77 | "M" -> -12 * 3600
78 | "N" -> 1 * 3600
79 | "Y" -> 12 * 3600
80 | _ ->
81 let zh = sscanf (String.sub z 0 3) "%i" (fun i -> i) in
82 let zm = sscanf (String.sub z 3 2) "%i" (fun i -> i) in
83 let tz_sign = if zh < 0 then -1 else 1 in
84 if zh < 0 then tz_sign * ((-zh * 3600) + (zm * 60))
85 else tz_sign * ((zh * 3600) + (zm * 60))
86 in
87 let rt = map2 (fun date span -> Ptime.add_span date span) date span in
88 (* XXX: We lose minutes with this conversion, but Calendar does not
89 propose to handle minutes. *)
90 map (fun x -> Some (Ptime.to_date_time ~tz_offset_s x)) rt
91 in
92 match map Ptime.of_date_time date_and_time with
93 | Some x -> x
94 | None -> invalid_arg (sprintf "Syndic.Date.of_rfc822: cannot parse")
95 in
96 try
97 if 'A' <= s.[0] && s.[0] <= 'Z' then
98 try sscanf s "%_s %i %s %i %i:%i%s %s" make_date with _ ->
99 try sscanf s "%_s %ist %s %i %i:%i%s %s" make_date with _ ->
100 (* For e.g. "May 15th, 2019" — even though it is not standard *)
101 sscanf s "%s %i%_s %i" (fun m d y -> make_date d m y 0 0 "" "UT")
102 else
103 try sscanf s "%i %s %i %i:%i%s %s" make_date with _ ->
104 sscanf s "%i %s %i" (fun d m y -> make_date d m y 0 0 "" "UT")
105 with _ ->
106 (* Fallback: Some RSS feeds use RFC3339 dates instead of RFC822 *)
107 try of_rfc3339 s
108 with _ -> invalid_arg (sprintf "Syndic.Date.of_string+: cannot parse %S" s)
109
110type month =
111 | Jan
112 | Feb
113 | Mar
114 | Apr
115 | May
116 | Jun
117 | Jul
118 | Aug
119 | Sep
120 | Oct
121 | Nov
122 | Dec
123
124type day = Thu | Fri | Sat | Sun | Mon | Tue | Wed
125
126let string_of_month = function
127 | Jan -> "Jan"
128 | Feb -> "Feb"
129 | Mar -> "Mar"
130 | Apr -> "Apr"
131 | May -> "May"
132 | Jun -> "Jun"
133 | Jul -> "Jul"
134 | Aug -> "Aug"
135 | Sep -> "Sep"
136 | Oct -> "Oct"
137 | Nov -> "Nov"
138 | Dec -> "Dec"
139
140let month_of_date =
141 let months =
142 [|Jan; Feb; Mar; Apr; May; Jun; Jul; Aug; Sep; Oct; Nov; Dec|]
143 in
144 fun t ->
145 let _, i, _ = Ptime.to_date t in
146 months.(i - 1)
147
148let to_rfc3339 d =
149 (* Example: 2014-03-19T15:51:25.050-07:00 *)
150 Ptime.to_rfc3339 d
151
152(* Convenience functions *)
153
154let day_of_week =
155 let wday = [|Thu; Fri; Sat; Sun; Mon; Tue; Wed|] in
156 fun t ->
157 let i = fst Ptime.(Span.to_d_ps @@ to_span t) mod 7 in
158 wday.((if i < 0 then 7 + i else i))
159
160let string_of_day = function
161 | Thu -> "Thu"
162 | Fri -> "Fri"
163 | Sat -> "Sat"
164 | Sun -> "Sun"
165 | Mon -> "Mon"
166 | Tue -> "Tue"
167 | Wed -> "Wed"
168
169let year t =
170 let year, _, _ = Ptime.to_date t in
171 year
172
173let month = month_of_date
174
175let day t =
176 let (_, _, day), _ = Ptime.to_date_time t in
177 day
178
179let hour t =
180 let _, ((hh, _, _), _) = Ptime.to_date_time t in
181 hh
182
183let minute t =
184 let _, ((_, mm, _), _) = Ptime.to_date_time t in
185 mm
186
187let second t =
188 let _, ((_, _, ss), _) = Ptime.to_date_time t in
189 float_of_int ss
190
191let to_rfc822 t =
192 (* Example: Sat, 25 Sep 2010 08:01:00 -0700 *)
193 let ds = day_of_week t |> string_of_day in
194 let ms = month_of_date t |> string_of_month in
195 let (y, _m, d), ((hh, mm, ss), t) = Ptime.to_date_time t in
196 Printf.sprintf "%s, %d %s %d %02d:%02d:%02d %04d" ds d ms y hh mm ss t