Command-line and Emacs Calendar Client
ryan.freumh.org
1type format = [ `Text | `Json | `Csv | `Ics | `Entries | `Sexp ]
2
3let format_date date =
4 let y, m, d = Ptime.to_date date in
5 let cal_date = CalendarLib.Date.make y m d in
6 let weekday =
7 match CalendarLib.Date.day_of_week cal_date with
8 | CalendarLib.Date.Mon -> "Mon"
9 | CalendarLib.Date.Tue -> "Tue"
10 | CalendarLib.Date.Wed -> "Wed"
11 | CalendarLib.Date.Thu -> "Thu"
12 | CalendarLib.Date.Fri -> "Fri"
13 | CalendarLib.Date.Sat -> "Sat"
14 | CalendarLib.Date.Sun -> "Sun"
15 in
16 Printf.sprintf "%04d-%02d-%02d %s" y m d weekday
17
18let format_time date =
19 let _, ((h, m, _), _) = Ptime.to_date_time date in
20 Printf.sprintf "%02d:%02d" h m
21
22let format_datetime date =
23 Printf.sprintf "%s %s" (format_date date) (format_time date)
24
25let next_day day ~next =
26 let y1, m1, d1 = Ptime.to_date day in
27 let y2, m2, d2 = Ptime.to_date next in
28 y1 == y2 && m1 == m2 && d1 == d2 - 1
29
30(* exosed from icalendar *)
31
32let weekday_strings =
33 [
34 (`Monday, "MO");
35 (`Tuesday, "TU");
36 (`Wednesday, "WE");
37 (`Thursday, "TH");
38 (`Friday, "FR");
39 (`Saturday, "SA");
40 (`Sunday, "SU");
41 ]
42
43let freq_strings =
44 [
45 (`Daily, "DAILY");
46 (`Hourly, "HOURLY");
47 (`Minutely, "MINUTELY");
48 (`Monthly, "MONTHLY");
49 (`Secondly, "SECONDLY");
50 (`Weekly, "WEEKLY");
51 (`Yearly, "YEARLY");
52 ]
53
54let date_to_str (y, m, d) = Printf.sprintf "%04d%02d%02d" y m d
55
56let datetime_to_str ptime utc =
57 let date, ((hh, mm, ss), _) = Ptime.to_date_time ptime in
58 Printf.sprintf "%sT%02d%02d%02d%s" (date_to_str date) hh mm ss
59 (if utc then "Z" else "")
60
61let timestamp_to_ics ts buf =
62 Buffer.add_string buf
63 @@
64 match ts with
65 | `Utc ts -> datetime_to_str ts true
66 | `Local ts -> datetime_to_str ts false
67 | `With_tzid (ts, _str) -> (* TODO *) datetime_to_str ts false
68
69let recurs_to_ics (freq, count_or_until, interval, l) buf =
70 let write_rulepart key value =
71 Buffer.add_string buf key;
72 Buffer.add_char buf '=';
73 Buffer.add_string buf value
74 in
75 let int_list l = String.concat "," @@ List.map string_of_int l in
76 let recur_to_ics = function
77 | `Byminute byminlist -> write_rulepart "BYMINUTE" (int_list byminlist)
78 | `Byday bywdaylist ->
79 let wday (weeknumber, weekday) =
80 (if weeknumber = 0 then "" else string_of_int weeknumber)
81 ^ List.assoc weekday weekday_strings
82 in
83 write_rulepart "BYDAY" (String.concat "," @@ List.map wday bywdaylist)
84 | `Byhour byhrlist -> write_rulepart "BYHOUR" (int_list byhrlist)
85 | `Bymonth bymolist -> write_rulepart "BYMONTH" (int_list bymolist)
86 | `Bymonthday bymodaylist ->
87 write_rulepart "BYMONTHDAY" (int_list bymodaylist)
88 | `Bysecond byseclist -> write_rulepart "BYSECOND" (int_list byseclist)
89 | `Bysetposday bysplist -> write_rulepart "BYSETPOS" (int_list bysplist)
90 | `Byweek bywknolist -> write_rulepart "BYWEEKNO" (int_list bywknolist)
91 | `Byyearday byyrdaylist ->
92 write_rulepart "BYYEARDAY" (int_list byyrdaylist)
93 | `Weekday weekday ->
94 write_rulepart "WKST" (List.assoc weekday weekday_strings)
95 in
96 write_rulepart "FREQ" (List.assoc freq freq_strings);
97 (match count_or_until with
98 | None -> ()
99 | Some x -> (
100 Buffer.add_char buf ';';
101 match x with
102 | `Count c -> write_rulepart "COUNT" (string_of_int c)
103 | `Until enddate ->
104 (* TODO cleanup *)
105 Buffer.add_string buf "UNTIL=";
106 timestamp_to_ics enddate buf));
107 (match interval with
108 | None -> ()
109 | Some i ->
110 Buffer.add_char buf ';';
111 write_rulepart "INTERVAL" (string_of_int i));
112 List.iter
113 (fun recur ->
114 Buffer.add_char buf ';';
115 recur_to_ics recur)
116 l
117
118let format_alt ~format ~start ~end_ event =
119 let open Event in
120 match format with
121 | `Text ->
122 let id = get_id event in
123 let start_date = " " ^ format_date start in
124 let start_time =
125 match get_day_event event with
126 | true -> ""
127 | false -> " " ^ format_time start
128 in
129 let end_date, end_time =
130 match end_ with
131 | None -> ("", "")
132 | Some end_ -> (
133 match (get_day_event event, next_day start ~next:end_) with
134 | true, true -> ("", "")
135 | true, _ -> (" - " ^ format_date end_, "")
136 | false, true -> ("", " - " ^ format_time end_)
137 | false, _ -> (" - " ^ format_date end_, " " ^ format_time end_))
138 in
139 let summary =
140 match get_summary event with
141 | Some summary when summary <> "" -> " " ^ summary
142 | _ -> ""
143 in
144 let location =
145 match get_location event with
146 | Some loc when loc <> "" -> " @" ^ loc
147 | _ -> ""
148 in
149 Printf.sprintf "%-45s%s%s%s%s%s%s" id start_date start_time end_date
150 end_time summary location
151 | `Json ->
152 let open Yojson.Safe in
153 let json =
154 `Assoc
155 [
156 ("id", `String (get_id event));
157 ( "summary",
158 match get_summary event with
159 | Some summary -> `String summary
160 | None -> `Null );
161 ("start", `String (format_datetime start));
162 ( "end",
163 match end_ with
164 | Some e -> `String (format_datetime e)
165 | None -> `Null );
166 ( "location",
167 match get_location event with
168 | Some loc -> `String loc
169 | None -> `Null );
170 ( "description",
171 match get_description event with
172 | Some desc -> `String desc
173 | None -> `Null );
174 ( "calendar",
175 match get_collection event with
176 | Collection.Col cal -> `String cal );
177 ]
178 in
179 to_string json
180 | `Csv ->
181 let summary =
182 match get_summary event with Some summary -> summary | None -> ""
183 in
184 let start = format_datetime start in
185 let end_str =
186 match end_ with Some e -> format_datetime e | None -> ""
187 in
188 let location =
189 match get_location event with Some loc -> loc | None -> ""
190 in
191 let cal_id =
192 match get_collection event with Collection.Col cal -> cal
193 in
194 Printf.sprintf "\"%s\",\"%s\",\"%s\",\"%s\",\"%s\"" summary start end_str
195 location cal_id
196 | `Ics ->
197 let cal_props = [] in
198 let event_ical = Event.to_icalendar event in
199 Icalendar.to_ics ~cr:true (cal_props, [ `Event event_ical ])
200 | `Entries ->
201 let summary =
202 match get_summary event with Some summary -> summary | None -> ""
203 in
204 let start = format_datetime start in
205 let end_str =
206 match end_ with Some e -> format_datetime e | None -> ""
207 in
208 let location =
209 match get_location event with Some loc -> loc | None -> ""
210 in
211 let description =
212 match get_description event with Some desc -> desc | None -> ""
213 in
214 let rrule =
215 match get_recurrence event with
216 | Some r ->
217 let buf = Buffer.create 128 in
218 recurs_to_ics r buf;
219 Buffer.contents buf
220 | None -> ""
221 in
222 Printf.sprintf "%s: %s\n%s: %s\n%s: %s\n%s: %s\n%s: %s\n%s: %s" "Summary"
223 summary "Start" start "End" end_str "Location" location "Description"
224 description "Reccurence" rrule
225 | `Sexp ->
226 let summary =
227 match get_summary event with Some summary -> summary | None -> ""
228 in
229 let start_date, start_time =
230 let date = start in
231 let y, m, d = Ptime.to_date date in
232 let _, ((h, min, s), _) = Ptime.to_date_time date in
233 let cal_date = CalendarLib.Date.make y m d in
234 let dow =
235 match CalendarLib.Date.day_of_week cal_date with
236 | CalendarLib.Date.Mon -> "monday"
237 | CalendarLib.Date.Tue -> "tuesday"
238 | CalendarLib.Date.Wed -> "wednesday"
239 | CalendarLib.Date.Thu -> "thursday"
240 | CalendarLib.Date.Fri -> "friday"
241 | CalendarLib.Date.Sat -> "saturday"
242 | CalendarLib.Date.Sun -> "sunday"
243 in
244 ( Printf.sprintf "(%04d %02d %02d %s)" y m d dow,
245 Printf.sprintf "(%02d %02d %02d)" h min s )
246 in
247 let end_str =
248 match end_ with
249 | Some end_date ->
250 let y, m, d = Ptime.to_date end_date in
251 let _, ((h, min, s), _) = Ptime.to_date_time end_date in
252 let cal_date = CalendarLib.Date.make y m d in
253 let dow =
254 match CalendarLib.Date.day_of_week cal_date with
255 | CalendarLib.Date.Mon -> "monday"
256 | CalendarLib.Date.Tue -> "tuesday"
257 | CalendarLib.Date.Wed -> "wednesday"
258 | CalendarLib.Date.Thu -> "thursday"
259 | CalendarLib.Date.Fri -> "friday"
260 | CalendarLib.Date.Sat -> "saturday"
261 | CalendarLib.Date.Sun -> "sunday"
262 in
263 Printf.sprintf "((%04d %02d %02d %s) (%02d %02d %02d))" y m d dow h
264 min s
265 | None -> "nil"
266 in
267 let location =
268 match get_location event with
269 | Some loc -> Printf.sprintf "\"%s\"" (String.escaped loc)
270 | None -> "nil"
271 in
272 let description =
273 match get_description event with
274 | Some desc -> Printf.sprintf "\"%s\"" (String.escaped desc)
275 | None -> "nil"
276 in
277 let calendar =
278 match get_collection event with
279 | Collection.Col cal -> Printf.sprintf "\"%s\"" (String.escaped cal)
280 in
281 let id = get_id event in
282 Printf.sprintf
283 "((:id \"%s\" :summary \"%s\" :start (%s %s) :end %s :location %s \
284 :description %s :calendar %s))"
285 (String.escaped id) (String.escaped summary) start_date start_time
286 end_str location description calendar
287
288let format_event ?(format = `Text) event =
289 format_alt ~format ~start:(Event.get_start event) ~end_:(Event.get_end event)
290 event
291
292let format_instance ?(format = `Text) instance =
293 let open Recur in
294 format_alt ~format ~start:instance.start ~end_:instance.end_ instance.event
295
296let format_events ?(format = `Text) events =
297 match format with
298 | `Json ->
299 let json_events =
300 List.map
301 (fun e -> Yojson.Safe.from_string (format_event ~format:`Json e))
302 events
303 in
304 Yojson.Safe.to_string (`List json_events)
305 | `Csv ->
306 "\"Summary\",\"Start\",\"End\",\"Location\",\"Calendar\"\n"
307 ^ String.concat "\n" (List.map (format_event ~format:`Csv) events)
308 | `Sexp ->
309 "("
310 ^ String.concat "\n "
311 (List.map (fun e -> format_event ~format:`Sexp e) events)
312 ^ ")"
313 | _ -> String.concat "\n" (List.map (fun e -> format_event ~format e) events)
314
315let format_instances ?(format = `Text) instances =
316 match format with
317 | `Json ->
318 let json_instances =
319 List.map
320 (fun e -> Yojson.Safe.from_string (format_instance ~format:`Json e))
321 instances
322 in
323 Yojson.Safe.to_string (`List json_instances)
324 | `Csv ->
325 "\"Summary\",\"Start\",\"End\",\"Location\",\"Calendar\"\n"
326 ^ String.concat "\n" (List.map (format_instance ~format:`Csv) instances)
327 | `Sexp ->
328 "("
329 ^ String.concat "\n "
330 (List.map (fun e -> format_instance ~format:`Sexp e) instances)
331 ^ ")"
332 | _ ->
333 String.concat "\n"
334 (List.map (fun e -> format_instance ~format e) instances)