Command-line and Emacs Calendar Client
ryan.freumh.org
1open Result
2
3let default_timezone =
4 ref (fun () ->
5 match Timedesc.Time_zone.local () with
6 | Some tz -> tz
7 | None -> Timedesc.Time_zone.utc)
8
9let timedesc_to_ptime dt =
10 match
11 Timedesc.to_timestamp_single dt |> Timedesc.Utils.ptime_of_timestamp
12 with
13 | Some t -> t
14 | None -> failwith "Invalid date conversion from Timedesc to Ptime"
15
16let ptime_to_timedesc ?(tz = !default_timezone ()) ptime =
17 let ts = Timedesc.Utils.timestamp_of_ptime ptime in
18 match Timedesc.of_timestamp ~tz_of_date_time:tz ts with
19 | Some dt -> dt
20 | None -> failwith "Invalid date conversion from Ptime to Timedesc"
21
22let get_today =
23 ref (fun ?(tz = !default_timezone ()) () ->
24 let now = Timedesc.now ~tz_of_date_time:tz () in
25 let date = Timedesc.date now in
26 let midnight = Timedesc.Time.make_exn ~hour:0 ~minute:0 ~second:0 () in
27 let dt = Timedesc.of_date_and_time_exn ~tz date midnight in
28 timedesc_to_ptime dt)
29
30(* Convert a midnight timestamp to end-of-day (23:59:59) *)
31let to_end_of_day date =
32 let dt = ptime_to_timedesc date in
33 let date = Timedesc.date dt in
34 let end_of_day_time =
35 Timedesc.Time.make_exn ~hour:23 ~minute:59 ~second:59 ()
36 in
37 let end_of_day = Timedesc.of_date_and_time_exn date end_of_day_time in
38 timedesc_to_ptime end_of_day
39
40let add_days date days =
41 let dt = ptime_to_timedesc date in
42 let date = Timedesc.date dt in
43 let new_date = Timedesc.Date.add ~days date in
44 let time = Timedesc.time dt in
45 let new_dt = Timedesc.of_date_and_time_exn new_date time in
46 timedesc_to_ptime new_dt
47
48let add_weeks date weeks = add_days date (weeks * 7)
49
50let add_months date months =
51 let dt = ptime_to_timedesc date in
52 let old_ym = Timedesc.ym dt in
53 let year = Timedesc.Ym.year old_ym in
54 let month = Timedesc.Ym.month old_ym in
55 let day = Timedesc.day dt in
56
57 (* Calculate new year and month *)
58 let total_month = (year * 12) + month - 1 + months in
59 let new_year = total_month / 12 in
60 let new_month = (total_month mod 12) + 1 in
61
62 (* Try to create new date, handling end of month cases properly *)
63 let rec adjust_day d =
64 match Timedesc.Date.Ymd.make ~year:new_year ~month:new_month ~day:d with
65 | Ok new_date ->
66 let time = Timedesc.time dt in
67 let new_dt = Timedesc.of_date_and_time_exn new_date time in
68 timedesc_to_ptime new_dt
69 | Error _ ->
70 if d > 1 then adjust_day (d - 1)
71 else failwith "Invalid date after adding months"
72 in
73 adjust_day day
74
75let add_years date years = add_months date (years * 12)
76
77let get_start_of_week date =
78 let dt = ptime_to_timedesc date in
79 let day_of_week = Timedesc.weekday dt in
80 let days_to_subtract =
81 match day_of_week with
82 | `Mon -> 0
83 | `Tue -> 1
84 | `Wed -> 2
85 | `Thu -> 3
86 | `Fri -> 4
87 | `Sat -> 5
88 | `Sun -> 6
89 in
90 let monday_date =
91 Timedesc.Date.sub ~days:days_to_subtract (Timedesc.date dt)
92 in
93 let midnight = Timedesc.Time.make_exn ~hour:0 ~minute:0 ~second:0 () in
94 let monday_with_midnight =
95 Timedesc.of_date_and_time_exn monday_date midnight
96 in
97 timedesc_to_ptime monday_with_midnight
98
99let get_start_of_current_week ?(tz = !default_timezone ()) () =
100 get_start_of_week (!get_today ~tz ())
101
102let get_start_of_next_week ?(tz = !default_timezone ()) () =
103 add_days (get_start_of_current_week ~tz ()) 7
104
105let get_end_of_week date = add_days (get_start_of_week date) 6
106
107let get_end_of_current_week ?(tz = !default_timezone ()) () =
108 get_end_of_week (!get_today ~tz ())
109
110let get_end_of_next_week ?(tz = !default_timezone ()) () =
111 get_end_of_week (get_start_of_next_week ~tz ())
112
113let get_start_of_month date =
114 let dt = ptime_to_timedesc date in
115 let year = Timedesc.year dt in
116 let month = Timedesc.month dt in
117
118 (* Create a date for the first of the month *)
119 match Timedesc.Date.Ymd.make ~year ~month ~day:1 with
120 | Ok first_day ->
121 let midnight = Timedesc.Time.make_exn ~hour:0 ~minute:0 ~second:0 () in
122 let first_of_month = Timedesc.of_date_and_time_exn first_day midnight in
123 timedesc_to_ptime first_of_month
124 | Error _ -> failwith "Invalid date for start of month"
125
126let get_start_of_current_month ?(tz = !default_timezone ()) () =
127 get_start_of_month (!get_today ~tz ())
128
129let get_start_of_next_month ?(tz = !default_timezone ()) () =
130 add_months (get_start_of_current_month ~tz ()) 1
131
132let get_end_of_month date =
133 let dt = ptime_to_timedesc date in
134 let year = Timedesc.year dt in
135 let month = Timedesc.month dt in
136
137 (* Determine next month and year *)
138 let next_month_int = if month == 12 then 1 else month + 1 in
139 let next_month_year = if month == 12 then year + 1 else year in
140
141 (* Create a date for the first of next month *)
142 match
143 Timedesc.Date.Ymd.make ~year:next_month_year ~month:next_month_int ~day:1
144 with
145 | Ok first_of_next_month -> (
146 (* Create the timestamp and subtract 1 second *)
147 let midnight = Timedesc.Time.make_exn ~hour:0 ~minute:0 ~second:0 () in
148 let first_of_next_month_dt =
149 Timedesc.of_date_and_time_exn first_of_next_month midnight
150 in
151 let one_second = Timedesc.Span.For_human.make_exn ~seconds:1 () in
152 let end_of_month_ts =
153 match Timedesc.to_timestamp first_of_next_month_dt with
154 | `Single ts -> Timedesc.Span.sub ts one_second
155 | `Ambiguous (ts, _) -> Timedesc.Span.sub ts one_second
156 in
157 match Timedesc.of_timestamp end_of_month_ts with
158 | Some end_of_month -> timedesc_to_ptime end_of_month
159 | None -> failwith "Invalid timestamp for end of month")
160 | Error _ -> failwith "Invalid date for end of month"
161
162let get_end_of_current_month ?(tz = !default_timezone ()) () =
163 get_end_of_month (!get_today ~tz ())
164
165let get_end_of_next_month ?(tz = !default_timezone ()) () =
166 get_end_of_month (get_start_of_next_month ~tz ())
167
168let convert_relative_date_formats ?(tz = !default_timezone ()) ~today ~tomorrow
169 ~week ~month () =
170 if today then
171 let today_date = !get_today ~tz () in
172 (* Set the end date to end-of-day to include all events on that day *)
173 let end_of_today = to_end_of_day today_date in
174 Some (today_date, end_of_today)
175 else if tomorrow then
176 let today = !get_today ~tz () in
177 let tomorrow_date = add_days today 1 in
178 (* Set the end date to end-of-day to include all events on that day *)
179 let end_of_tomorrow = to_end_of_day tomorrow_date in
180 Some (tomorrow_date, end_of_tomorrow)
181 else if week then
182 let week_start = get_start_of_current_week ~tz () in
183 let week_end_date = add_days week_start 6 in
184 (* Sunday is 6 days from Monday *)
185 (* Set the end date to end-of-day to include all events on Sunday *)
186 let end_of_week = to_end_of_day week_end_date in
187 Some (week_start, end_of_week)
188 else if month then
189 let month_start = get_start_of_current_month ~tz () in
190 let month_end = get_end_of_month month_start in
191 Some (month_start, month_end)
192 else None
193
194let ( let* ) = Result.bind
195
196(* Parse a date string that could be ISO format or a relative expression *)
197let parse_date ?(tz = !default_timezone ()) expr parameter =
198 let iso_date_regex = Re.Pcre.regexp "^(\\d{4})-(\\d{2})-(\\d{2})$" in
199 let relative_regex = Re.Pcre.regexp "^([+-])(\\d+)([dwm])$" in
200 match expr with
201 | "today" -> Ok (!get_today ~tz ())
202 | "tomorrow" -> Ok (add_days (!get_today ~tz ()) 1)
203 | "yesterday" -> Ok (add_days (!get_today ~tz ()) (-1))
204 | "this-week" -> (
205 match parameter with
206 | `From -> Ok (get_start_of_current_week ~tz ())
207 | `To -> Ok (get_end_of_current_week ~tz ()))
208 | "next-week" -> (
209 match parameter with
210 | `From -> Ok (get_start_of_next_week ~tz ())
211 | `To -> Ok (get_end_of_next_week ~tz ()))
212 | "this-month" -> (
213 match parameter with
214 | `From -> Ok (get_start_of_current_month ~tz ())
215 | `To -> Ok (get_end_of_current_month ~tz ()))
216 | "next-month" -> (
217 match parameter with
218 | `From -> Ok (get_start_of_next_month ~tz ())
219 | `To -> Ok (get_end_of_next_month ~tz ()))
220 | _ ->
221 (* Try to parse as ISO date *)
222 if Re.Pcre.pmatch ~rex:iso_date_regex expr then
223 let year =
224 int_of_string
225 (Re.Pcre.get_substring (Re.Pcre.exec ~rex:iso_date_regex expr) 1)
226 in
227 let month =
228 int_of_string
229 (Re.Pcre.get_substring (Re.Pcre.exec ~rex:iso_date_regex expr) 2)
230 in
231 let day =
232 int_of_string
233 (Re.Pcre.get_substring (Re.Pcre.exec ~rex:iso_date_regex expr) 3)
234 in
235 match Timedesc.Date.Ymd.make ~year ~month ~day with
236 | Ok date ->
237 let midnight =
238 Timedesc.Time.make_exn ~hour:0 ~minute:0 ~second:0 ()
239 in
240 let dt = Timedesc.of_date_and_time_exn ~tz date midnight in
241 Ok (timedesc_to_ptime dt)
242 | Error _ -> Error (`Msg (Printf.sprintf "Invalid date: %s" expr))
243 (* Try to parse as relative expression +Nd, -Nd, etc. *)
244 else if Re.Pcre.pmatch ~rex:relative_regex expr then
245 let sign =
246 Re.Pcre.get_substring (Re.Pcre.exec ~rex:relative_regex expr) 1
247 in
248 let num =
249 int_of_string
250 (Re.Pcre.get_substring (Re.Pcre.exec ~rex:relative_regex expr) 2)
251 in
252 let unit =
253 Re.Pcre.get_substring (Re.Pcre.exec ~rex:relative_regex expr) 3
254 in
255 let multiplier = if sign = "+" then 1 else -1 in
256 let value = num * multiplier in
257 let today = !get_today ~tz () in
258 match unit with
259 | "d" -> Ok (add_days today value)
260 | "w" -> (
261 let date = add_weeks today value in
262 match parameter with
263 | `From -> Ok (get_start_of_week date)
264 | `To -> Ok (get_end_of_week date))
265 | "m" -> (
266 let date = add_months today value in
267 match parameter with
268 | `From -> Ok (get_start_of_month date)
269 | `To -> Ok (get_end_of_month date))
270 | _ -> Error (`Msg (Printf.sprintf "Invalid date unit: %s" unit))
271 else Error (`Msg (Printf.sprintf "Invalid date format: %s" expr))
272
273let parse_time str =
274 try
275 let regex =
276 Re.Perl.compile_pat "^([0-9]{1,2}):([0-9]{1,2})(?::([0-9]{1,2}))?$"
277 in
278 match Re.exec_opt regex str with
279 | Some groups ->
280 let hour = int_of_string (Re.Group.get groups 1) in
281 let minute = int_of_string (Re.Group.get groups 2) in
282 let second =
283 try int_of_string (Re.Group.get groups 3) with Not_found -> 0
284 in
285 if hour < 0 || hour > 23 then
286 Error (`Msg (Printf.sprintf "Invalid hour: %d" hour))
287 else if minute < 0 || minute > 59 then
288 Error (`Msg (Printf.sprintf "Invalid minute: %d" minute))
289 else if second < 0 || second > 59 then
290 Error (`Msg (Printf.sprintf "Invalid second: %d" second))
291 else Ok (hour, minute, second)
292 | None -> Error (`Msg "Invalid time format. Expected HH:MM or HH:MM:SS")
293 with e ->
294 Error
295 (`Msg (Printf.sprintf "Error parsing time: %s" (Printexc.to_string e)))
296
297let parse_date_time ?(tz = !default_timezone ()) ~date ~time parameter =
298 let* date_ptime = parse_date date parameter ~tz in
299 let* h, min, s = parse_time time in
300
301 let dt = ptime_to_timedesc ~tz date_ptime in
302 let date_part = Timedesc.date dt in
303
304 (* Create time *)
305 match Timedesc.Time.make ~hour:h ~minute:min ~second:s () with
306 | Ok time_part -> (
307 (* Combine date and time *)
308 match Timedesc.of_date_and_time ~tz date_part time_part with
309 | Ok combined -> Ok (timedesc_to_ptime combined)
310 | Error _ -> Error (`Msg "Invalid date-time combination"))
311 | Error _ -> Error (`Msg "Invalid time for date-time combination")
312
313let ptime_of_ical = function
314 | `Datetime (`Utc t) -> t
315 | `Datetime (`Local t) ->
316 let system_tz =
317 match Timedesc.Time_zone.local () with
318 | Some tz -> tz
319 | None -> Timedesc.Time_zone.utc
320 in
321 let ts = Timedesc.Utils.timestamp_of_ptime t in
322 let dt =
323 match Timedesc.of_timestamp ~tz_of_date_time:system_tz ts with
324 | Some dt -> dt
325 | None -> failwith "Invalid local date conversion"
326 in
327 timedesc_to_ptime dt
328 | `Datetime (`With_tzid (t, (_, tzid))) ->
329 let tz =
330 match Timedesc.Time_zone.make tzid with
331 | Some tz -> tz
332 | None ->
333 failwith
334 (Printf.sprintf
335 "Warning: Unknown timezone %s, falling back to UTC\n" tzid)
336 in
337 let ts = Timedesc.Utils.timestamp_of_ptime t in
338 let dt =
339 match Timedesc.of_timestamp ~tz_of_date_time:tz ts with
340 | Some dt -> dt
341 | None -> failwith "Invalid timezone date conversion"
342 in
343 timedesc_to_ptime dt
344 | `Date date -> (
345 let y, m, d = date in
346 match Timedesc.Date.Ymd.make ~year:y ~month:m ~day:d with
347 | Ok new_date ->
348 let midnight =
349 Timedesc.Time.make_exn ~hour:0 ~minute:0 ~second:0 ()
350 in
351 let new_dt = Timedesc.of_date_and_time_exn new_date midnight in
352 timedesc_to_ptime new_dt
353 | Error _ -> failwith (Printf.sprintf "Invalid date %d-%d-%d" y m d))