Command-line and Emacs Calendar Client
ryan.freumh.org
1open Cmdliner
2open Caledonia_lib
3
4let from_arg =
5 let doc =
6 "Start date in YYYY-MM-DD format, partial date format (YYYY-MM or YYYY), \
7 or a relative expression (today, tomorrow, this-week, next-week, \
8 this-month, next-month, +Nd, -Nd, +Nw, +Nm). See DATE FORMATS for more."
9 in
10 let i = Arg.info [ "from"; "f" ] ~docv:"DATE" ~doc in
11 Arg.(value @@ opt (some string) None i)
12
13let to_arg =
14 let doc =
15 "End date in YYYY-MM-DD format, partial date format (YYYY-MM or YYYY), or \
16 a relative expression (today, tomorrow, this-week, next-week, this-month, \
17 next-month, +Nd, -Nd, +Nw, +Nm). See DATE FORMATS for more."
18 in
19 let i = Arg.info [ "to"; "t" ] ~docv:"DATE" ~doc in
20 Arg.(value @@ opt (some string) None i)
21
22let calendar_arg =
23 let doc = "Filter by calendar" in
24 Arg.(
25 value & opt_all string [] & info [ "calendar"; "c" ] ~docv:"CALENDAR" ~doc)
26
27let format_enum =
28 [
29 ("text", `Text);
30 ("entries", `Entries);
31 ("json", `Json);
32 ("csv", `Csv);
33 ("ics", `Ics);
34 ("sexp", `Sexp);
35 ]
36
37let format_arg =
38 let doc =
39 "Output format (text, entries, json, csv, ics, sexp). Note that dates are \
40 localised to the TIMEZONE option but the timezone they're defined in is \
41 displayed."
42 in
43 Arg.(
44 value
45 & opt (enum format_enum) `Text
46 & info [ "format"; "o" ] ~docv:"FORMAT" ~doc)
47
48let count_arg =
49 let doc = "Maximum number of events to display" in
50 Arg.(value & opt (some int) None & info [ "count"; "n" ] ~docv:"COUNT" ~doc)
51
52let today_arg =
53 let doc = "Show events for today only" in
54 Arg.(value & flag & info [ "today"; "d" ] ~doc)
55
56let tomorrow_arg =
57 let doc = "Show events for tomorrow only" in
58 Arg.(value & flag & info [ "tomorrow" ] ~doc)
59
60let week_arg =
61 let doc = "Show events for the current week" in
62 Arg.(value & flag & info [ "week"; "w" ] ~doc)
63
64let month_arg =
65 let doc = "Show events for the current month" in
66 Arg.(value & flag & info [ "month"; "m" ] ~doc)
67
68let timezone_arg =
69 let doc =
70 "Timezone to use for date calculations (e.g., 'America/New_York', 'UTC', \
71 'Europe/London') defaulting to the system timezone"
72 in
73 Arg.(
74 value
75 & opt (some string) None
76 & info [ "timezone"; "z" ] ~docv:"TIMEZONE" ~doc)
77
78let sort_field_enum =
79 [
80 ("start", `Start);
81 ("end", `End);
82 ("summary", `Summary);
83 ("location", `Location);
84 ("calendar", `Calendar);
85 ]
86
87type sort_spec = {
88 field : [ `Start | `End | `Summary | `Location | `Calendar ];
89 descending : bool;
90}
91
92let parse_sort_spec str =
93 let ( let* ) = Result.bind in
94 let parts = String.split_on_char ':' str in
95 match parts with
96 | [] -> Error (`Msg "Empty sort specification")
97 | field_str :: order_opt -> (
98 let* descending =
99 match order_opt with
100 | [ "desc" ] | [ "descending" ] -> Ok true
101 | [ "asc" ] | [ "ascending" ] -> Ok false
102 | [] -> Ok false (* Default to ascending *)
103 | _ -> Error (`Msg ("Invalid sort order in: " ^ str))
104 in
105 match List.assoc_opt field_str sort_field_enum with
106 | Some field -> Ok { field; descending }
107 | None ->
108 Error
109 (`Msg
110 (Printf.sprintf "Invalid sort field '%s'. Valid options are: %s"
111 field_str
112 (String.concat ", " (List.map fst sort_field_enum)))))
113
114let sort_converter =
115 let parse s = parse_sort_spec s in
116 let print ppf spec =
117 let field_str =
118 List.find_map
119 (fun (name, field) -> if field = spec.field then Some name else None)
120 sort_field_enum
121 in
122 let order_str = if spec.descending then ":desc" else "" in
123 Fmt.pf ppf "%s%s" (Option.value field_str ~default:"unknown") order_str
124 in
125 Arg.conv (parse, print)
126
127let default_sort = { field = `Start; descending = false }
128
129let sort_arg =
130 let doc =
131 "Sorting specifications in the format 'field[:order]' where field is one \
132 of 'start', 'end', 'summary', 'location', 'calendar' and order is one of \
133 'asc'/'ascending' or 'desc'/'descending' (default: asc). Multiple sort \
134 specs can be provided for multi-level sorting. When no sort is specified, \
135 defaults to sorting by start time ascending."
136 in
137 Arg.(
138 value
139 & opt_all sort_converter [ default_sort ]
140 & info [ "sort"; "S" ] ~docv:"SORT" ~doc)
141
142(* Convert sort specs to an event comparator *)
143let create_event_comparator sort_specs =
144 match sort_specs with
145 | [] -> Event.by_start
146 | [ spec ] ->
147 let comp =
148 match spec.field with
149 | `Start -> Event.by_start
150 | `End -> Event.by_end
151 | `Summary -> Event.by_summary
152 | `Location -> Event.by_location
153 | `Calendar -> Event.by_calendar_name
154 in
155 if spec.descending then Event.descending comp else comp
156 | specs ->
157 (* Chain multiple sort specs together *)
158 List.fold_right
159 (fun spec acc ->
160 let comp =
161 match spec.field with
162 | `Start -> Event.by_start
163 | `End -> Event.by_end
164 | `Summary -> Event.by_summary
165 | `Location -> Event.by_location
166 | `Calendar -> Event.by_calendar_name
167 in
168 let comp = if spec.descending then Event.descending comp else comp in
169 Event.chain comp acc)
170 (List.tl specs)
171 (let spec = List.hd specs in
172 let comp =
173 match spec.field with
174 | `Start -> Event.by_start
175 | `End -> Event.by_end
176 | `Summary -> Event.by_summary
177 | `Location -> Event.by_location
178 | `Calendar -> Event.by_calendar_name
179 in
180 if spec.descending then Event.descending comp else comp)
181
182let parse_timezone ~timezone =
183 match timezone with
184 | Some tzid -> (
185 match Timedesc.Time_zone.make tzid with
186 | Some tz -> tz
187 | None -> failwith ("Invalid timezone: " ^ tzid))
188 | None -> !Date.default_timezone ()
189
190let date_format_manpage_entries =
191 [
192 `S "DATE FORMATS";
193 `P
194 "The following are the possible date formats for the --from and --to \
195 command line parameters. Note the value is dependent on --from / --to, \
196 so --from 2025 --to 2025 will include all the events in the year 2025";
197 `I ("YYYY-MM-DD", "Specific date (e.g., 2025-3-27, zero-padding optional)");
198 `I ("YYYY-MM", "Start/end of specific month (e.g., 2025-3 for March 2025)");
199 `I ("YYYY", "Start/end of specific year (e.g., 2025)");
200 `I ("today", "Current day");
201 `I ("tomorrow", "Next day");
202 `I ("yesterday", "Previous day");
203 `I ("this-week", "Start/end of current week");
204 `I ("next-week", "Start/end of next week");
205 `I ("this-month", "Start/end of current month");
206 `I ("next-month", "Start/end of next month");
207 `I ("+Nd", "N days from today (e.g., +7d for a week from today)");
208 `I ("-Nd", "N days before today (e.g., -7d for a week ago)");
209 `I ("+Nw", "N weeks from today (e.g., +4w for 4 weeks from today)");
210 `I ("+Nm", "N months from today (e.g., +2m for 2 months from today)");
211 ]