Command-line and Emacs Calendar Client
ryan.freumh.org
1open Cmdliner
2open Caledonia_lib
3
4let calendar_name_arg =
5 let doc = "Calendar to add the event to" in
6 Arg.(
7 required
8 & opt (some string) None
9 & info [ "calendar"; "c" ] ~docv:"CALENDAR" ~doc)
10
11let required_summary_arg =
12 let doc = "Event summary/title" in
13 Arg.(required & pos 0 (some string) None & info [] ~docv:"SUMMARY" ~doc)
14
15let optional_summary_arg =
16 let doc = "Event summary/title" in
17 Arg.(
18 value
19 & opt (some string) None
20 & info [ "summary"; "s" ] ~docv:"SUMMARY" ~doc)
21
22let start_date_arg =
23 let doc = "Event start date (YYYY-MM-DD)" in
24 Arg.(value & opt (some string) None & info [ "date"; "d" ] ~docv:"DATE" ~doc)
25
26let start_time_arg =
27 let doc = "Event start time (HH:MM)" in
28 Arg.(value & opt (some string) None & info [ "time"; "t" ] ~docv:"TIME" ~doc)
29
30let end_date_arg =
31 let doc = "Event end date (YYYY-MM-DD). Defaults to DATE." in
32 Arg.(
33 value
34 & opt (some string) None
35 & info [ "end-date"; "e" ] ~docv:"END_DATE" ~doc)
36
37let end_time_arg =
38 let doc = "Event end time (HH:MM)" in
39 Arg.(
40 value
41 & opt (some string) None
42 & info [ "end-time"; "T" ] ~docv:"END_TIME" ~doc)
43
44let timezone_arg =
45 let doc =
46 "Timezone to add events to (e.g., 'America/New_York', 'UTC', \
47 'Europe/London'). If not specified, will use the local timezone. For a \
48 floating time (always at whatever the sytem time is), use 'FLOATING'."
49 in
50 Arg.(
51 value
52 & opt (some string) None
53 & info [ "timezone"; "z" ] ~docv:"TIMEZONE" ~doc)
54
55let end_timezone_arg =
56 let doc = "The timezone of the end of the event. Defaults to TIMEZONE." in
57 Arg.(
58 value
59 & opt (some string) None
60 & info [ "end-timezone"; "Z" ] ~docv:"END_TIMEZONE" ~doc)
61
62let location_arg =
63 let doc = "Event location" in
64 Arg.(
65 value
66 & opt (some string) None
67 & info [ "location"; "l" ] ~docv:"LOCATION" ~doc)
68
69let description_arg =
70 let doc = "Event description" in
71 Arg.(
72 value
73 & opt (some string) None
74 & info [ "description"; "D" ] ~docv:"DESCRIPTION" ~doc)
75
76let recur_arg =
77 let doc = "See RECURRENCE section" in
78 Arg.(
79 value & opt (some string) None & info [ "recur"; "r" ] ~docv:"RECUR" ~doc)
80
81let date_format_manpage_entries =
82 [
83 `S "DATE FORMATS";
84 `P
85 "The following are the possible date formats for the --date and \
86 --end-date command line parameters. Note the value is dependent on \
87 --date / --end-date, so --date 2025-03 --end-date 2025-03 will span the \
88 month of March.";
89 `I ("YYYY-MM-DD", "Specific date (e.g., 2025-3-27, zero-padding optional)");
90 `I ("YYYY-MM", "Start/end of specific month (e.g., 2025-3 for March 2025)");
91 `I ("YYYY", "Start/end of specific year (e.g., 2025)");
92 `I ("today", "Current day");
93 `I ("tomorrow", "Next day");
94 `I ("yesterday", "Previous day");
95 `I ("this-week", "Start/end of current week");
96 `I ("next-week", "Start/end of next week");
97 `I ("this-month", "Start/end of current month");
98 `I ("next-month", "Start/end of next month");
99 `I ("+Nd", "N days from today (e.g., +7d for a week from today)");
100 `I ("-Nd", "N days before today (e.g., -7d for a week ago)");
101 `I ("+Nw", "N weeks from today (e.g., +4w for 4 weeks from today)");
102 `I ("+Nm", "N months from today (e.g., +2m for 2 months from today)");
103 ]
104
105let parse_start ~start_date ~start_time ~timezone =
106 let ( let* ) = Result.bind in
107 let* _ =
108 match timezone with
109 | None -> Ok ()
110 | Some tzid -> (
111 match Timedesc.Time_zone.make tzid with
112 | Some _ -> Ok ()
113 | None ->
114 Error (`Msg (Printf.sprintf "Warning: Unknown timezone %s" tzid)))
115 in
116 match start_date with
117 | None ->
118 let* _ =
119 match start_time with
120 | None -> Ok ()
121 | Some _ ->
122 Error (`Msg "Can't specify an start time without a start date")
123 in
124 let* _ =
125 match timezone with
126 | None -> Ok ()
127 | _ -> Error (`Msg "Can't specify a timezone without a start date")
128 in
129 Ok None
130 | Some start_date -> (
131 match start_time with
132 | None ->
133 let* _ =
134 match timezone with
135 | None -> Ok ()
136 | _ -> Error (`Msg "Can't specify a timezone without a start time")
137 in
138 let* ptime =
139 Date.parse_date ~tz:Timedesc.Time_zone.utc start_date `From
140 in
141 let date = Ptime.to_date ptime in
142 Ok (Some (Icalendar.Params.singleton Valuetype `Date, `Date date))
143 | Some start_time -> (
144 match timezone with
145 | None ->
146 let* tzid =
147 match Timedesc.Time_zone.local () with
148 | Some tz -> Ok (Timedesc.Time_zone.name tz)
149 | None -> Error (`Msg "Failed to get system timezone")
150 in
151 let* datetime =
152 Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:start_date
153 ~time:start_time `From
154 in
155 Ok
156 (Some
157 ( Icalendar.Params.empty,
158 `Datetime (`With_tzid (datetime, (false, tzid))) ))
159 | Some "FLOATING" ->
160 let* datetime =
161 Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:start_date
162 ~time:start_time `From
163 in
164 Ok (Some (Icalendar.Params.empty, `Datetime (`Local datetime)))
165 | Some "UTC" ->
166 let* datetime =
167 Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:start_date
168 ~time:start_time `From
169 in
170 Ok (Some (Icalendar.Params.empty, `Datetime (`Utc datetime)))
171 | Some tzid ->
172 let* datetime =
173 Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:start_date
174 ~time:start_time `From
175 in
176 Ok
177 (Some
178 ( Icalendar.Params.empty,
179 `Datetime (`With_tzid (datetime, (false, tzid))) ))))
180
181let parse_end ~end_date ~end_time ~end_timezone =
182 let ( let* ) = Result.bind in
183 let* _ =
184 match end_timezone with
185 | None -> Ok ()
186 | Some tzid -> (
187 match Timedesc.Time_zone.make tzid with
188 | Some _ -> Ok ()
189 | None ->
190 Error (`Msg (Printf.sprintf "Warning: Unknown timezone %s" tzid)))
191 in
192 match end_date with
193 | None ->
194 let* _ =
195 match end_time with
196 | None -> Ok ()
197 | Some _ -> Error (`Msg "Can't specify an end time without an end date")
198 in
199 let* _ =
200 match end_timezone with
201 | None -> Ok ()
202 | Some _ ->
203 Error (`Msg "Can't specify an end timezone without an end date")
204 in
205 Ok None
206 | Some end_date -> (
207 match end_time with
208 | None ->
209 let* _ =
210 match end_timezone with
211 | Some _ ->
212 Error (`Msg "Can't specify an end timezone without a end time")
213 | _ -> Ok ()
214 in
215 let* ptime =
216 Date.parse_date end_date ~tz:Timedesc.Time_zone.utc `From
217 in
218 (* DTEND;VALUE=DATE the event ends at the start of the specified date *)
219 let ptime = Date.add_days ptime 1 in
220 let date = Ptime.to_date ptime in
221 Ok
222 (Some
223 (`Dtend (Icalendar.Params.singleton Valuetype `Date, `Date date)))
224 | Some end_time -> (
225 match end_timezone with
226 | None ->
227 let* tzid =
228 match Timedesc.Time_zone.local () with
229 | Some tz -> Ok (Timedesc.Time_zone.name tz)
230 | None -> Error (`Msg "Failed to get system timezone")
231 in
232 let* datetime =
233 Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:end_date
234 ~time:end_time `From
235 in
236 Ok
237 (Some
238 (`Dtend
239 ( Icalendar.Params.empty,
240 `Datetime (`With_tzid (datetime, (false, tzid))) )))
241 | Some "FLOATING" ->
242 let* datetime =
243 Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:end_date
244 ~time:end_time `From
245 in
246 Ok
247 (Some
248 (`Dtend (Icalendar.Params.empty, `Datetime (`Local datetime))))
249 | Some "UTC" ->
250 let* datetime =
251 Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:end_date
252 ~time:end_time `From
253 in
254 Ok
255 (Some
256 (`Dtend (Icalendar.Params.empty, `Datetime (`Utc datetime))))
257 | Some tzid ->
258 let* datetime =
259 Date.parse_date_time ~tz:Timedesc.Time_zone.utc ~date:end_date
260 ~time:end_time `From
261 in
262 Ok
263 (Some
264 (`Dtend
265 ( Icalendar.Params.empty,
266 `Datetime (`With_tzid (datetime, (false, tzid))) )))))
267
268let combine_results (results : ('a, 'b) result list) : ('a list, 'b) result =
269 let rec aux acc = function
270 | [] -> Ok (List.rev acc)
271 | Ok v :: rest -> aux (v :: acc) rest
272 | Error e :: _ -> Error e
273 in
274 aux [] results
275
276let parse_recurrence recur =
277 let ( let* ) = Result.bind in
278 let parts = String.split_on_char ';' recur in
279 let freq = ref None in
280 let count = ref None in
281 let until = ref None in
282 let interval = ref None in
283 let by_parts = ref [] in
284 let results =
285 List.map
286 (fun part ->
287 let kv = String.split_on_char '=' part in
288 match kv with
289 | [ "FREQ"; value ] -> (
290 match String.uppercase_ascii value with
291 | "DAILY" ->
292 freq := Some `Daily;
293 Ok ()
294 | "WEEKLY" ->
295 freq := Some `Weekly;
296 Ok ()
297 | "MONTHLY" ->
298 freq := Some `Monthly;
299 Ok ()
300 | "YEARLY" ->
301 freq := Some `Yearly;
302 Ok ()
303 | _ -> Error (`Msg ("Unsupported frequency: " ^ value)))
304 | [ "COUNT"; value ] ->
305 if !until <> None then
306 Error (`Msg "Cannot use both COUNT and UNTIL in the same rule")
307 else (
308 count := Some (`Count (int_of_string value));
309 Ok ())
310 | [ "UNTIL"; value ] -> (
311 if !count <> None then
312 Error (`Msg "Cannot use both COUNT and UNTIL in the same rule")
313 else
314 let* v =
315 match Icalendar.parse_datetime value with
316 | Ok v -> Ok v
317 | Error e -> Error (`Msg e)
318 in
319 match v with
320 | `With_tzid _ -> Error (`Msg "Until can't be in a timezone")
321 | `Utc u ->
322 until := Some (`Until (`Utc u));
323 Ok ()
324 | `Local l ->
325 until := Some (`Until (`Local l));
326 Ok ())
327 | [ "INTERVAL"; value ] ->
328 interval := Some (int_of_string value);
329 Ok ()
330 | [ "BYDAY"; value ] ->
331 (* Parse day specifications like MO,WE,FR or 1MO,-1FR *)
332 let days = String.split_on_char ',' value in
333 let parse_day day =
334 (* Extract ordinal if present (like 1MO or -1FR) *)
335 let ordinal, day_code =
336 if
337 String.length day >= 3
338 && (String.get day 0 = '+'
339 || String.get day 0 = '-'
340 || (String.get day 0 >= '0' && String.get day 0 <= '9'))
341 then (
342 let idx = ref 0 in
343 while
344 !idx < String.length day
345 && (String.get day !idx = '+'
346 || String.get day !idx = '-'
347 || String.get day !idx >= '0'
348 && String.get day !idx <= '9')
349 do
350 incr idx
351 done;
352 let ord_str = String.sub day 0 !idx in
353 let day_str =
354 String.sub day !idx (String.length day - !idx)
355 in
356 (int_of_string ord_str, day_str))
357 else (0, day)
358 in
359 let* weekday =
360 match day_code with
361 | "MO" -> Ok `Monday
362 | "TU" -> Ok `Tuesday
363 | "WE" -> Ok `Wednesday
364 | "TH" -> Ok `Thursday
365 | "FR" -> Ok `Friday
366 | "SA" -> Ok `Saturday
367 | "SU" -> Ok `Sunday
368 | _ -> Error (`Msg ("Invalid weekday: " ^ day_code))
369 in
370 Ok (ordinal, weekday)
371 in
372 let* day_specs = combine_results (List.map parse_day days) in
373 by_parts := `Byday day_specs :: !by_parts;
374 Ok ()
375 | [ "BYMONTHDAY"; value ] ->
376 let days = String.split_on_char ',' value in
377 let month_days = List.map int_of_string days in
378 by_parts := `Bymonthday month_days :: !by_parts;
379 Ok ()
380 | [ "BYMONTH"; value ] ->
381 let months = String.split_on_char ',' value in
382 let month_nums = List.map int_of_string months in
383 by_parts := `Bymonth month_nums :: !by_parts;
384 Ok ()
385 | _ -> Ok ())
386 parts
387 in
388 let* _ = combine_results results in
389 match !freq with
390 | Some f ->
391 let limit =
392 match (!count, !until) with
393 | Some c, None -> Some c
394 | None, Some u -> Some u
395 | _ -> None
396 in
397 let recurrence = (f, limit, !interval, !by_parts) in
398 Ok recurrence
399 | None -> Error (`Msg "FREQ is required in recurrence rule")
400
401let recurrence_format_manpage_entries =
402 [
403 `S "RECURRENCE";
404 `P "Recurrence rule in iCalendar RFC5545 format. The FREQ part is required.";
405 `I ("FREQ=<frequency>", "DAILY, WEEKLY, MONTHLY, or YEARLY (required)");
406 `I
407 ( "COUNT=<number>",
408 "Limit to this many occurrences (optional, cannot be used with UNTIL)"
409 );
410 `I
411 ( "UNTIL=<date>",
412 "Repeat until this date (optional, cannot be used with COUNT)" );
413 `I
414 ( "INTERVAL=<number>",
415 "Interval between occurrences, e.g., 2 for every other (optional)" );
416 `I
417 ( "BYDAY=<dayspec>",
418 "Specific days, e.g., MO,WE,FR or 1MO (first Monday) (optional)" );
419 `I
420 ( "BYMONTHDAY=<daynum>",
421 "Day of month, e.g., 1,15 or -1 (last day) (optional)" );
422 `I
423 ( "BYMONTH=<monthnum>",
424 "Month number, e.g., 1,6,12 for Jan,Jun,Dec (optional)" );
425 `P "Examples:";
426 `I ("FREQ=DAILY;COUNT=5", "Daily for 5 occurrences");
427 `I ("FREQ=WEEKLY;INTERVAL=2", "Every other week indefinitely");
428 `I ("FREQ=WEEKLY;BYDAY=MO,WE,FR", "Every Monday, Wednesday, Friday");
429 `I ("FREQ=MONTHLY;BYDAY=1MO", "First Monday of every month");
430 `I
431 ( "FREQ=YEARLY;BYMONTH=1;BYMONTHDAY=1",
432 "Every January 1st (New Year's Day)" );
433 `I ("FREQ=MONTHLY;BYMONTHDAY=-1", "Last day of every month");
434 ]