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