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