···
let calendar = t.calendar in
{ collection; file; event; calendar }
259
+
type format = [ `Text | `Entries | `Json | `Csv | `Ics | `Sexp ]
261
+
let format_date ?tz date =
262
+
let dt = Date.ptime_to_timedesc ?tz date in
263
+
let y = Timedesc.year dt in
264
+
let m = Timedesc.month dt in
265
+
let d = Timedesc.day dt in
267
+
match Timedesc.weekday dt with
276
+
Printf.sprintf "%04d-%02d-%02d %s" y m d weekday
278
+
let format_time ?tz date =
279
+
let dt = Date.ptime_to_timedesc ?tz date in
280
+
let h = Timedesc.hour dt in
281
+
let m = Timedesc.minute dt in
282
+
Printf.sprintf "%02d:%02d" h m
284
+
let format_datetime ?tz date =
287
+
| Some tz -> Printf.sprintf "(%s)" (Timedesc.Time_zone.name tz)
290
+
Printf.sprintf "%s %s%s" (format_date ?tz date) (format_time ?tz date) tz_str
292
+
let next_day day ~next =
293
+
let y1, m1, d1 = Ptime.to_date day in
294
+
let y2, m2, d2 = Ptime.to_date next in
295
+
y1 == y2 && m1 == m2 && d1 == d2 - 1
297
+
(* exosed from icalendar *)
299
+
let weekday_strings =
303
+
(`Wednesday, "WE");
313
+
(`Hourly, "HOURLY");
314
+
(`Minutely, "MINUTELY");
315
+
(`Monthly, "MONTHLY");
316
+
(`Secondly, "SECONDLY");
317
+
(`Weekly, "WEEKLY");
318
+
(`Yearly, "YEARLY");
321
+
let date_to_str (y, m, d) = Printf.sprintf "%04d%02d%02d" y m d
323
+
let datetime_to_str ptime utc =
324
+
let date, ((hh, mm, ss), _) = Ptime.to_date_time ptime in
325
+
Printf.sprintf "%sT%02d%02d%02d%s" (date_to_str date) hh mm ss
326
+
(if utc then "Z" else "")
328
+
let timestamp_to_ics ts buf =
329
+
Buffer.add_string buf
332
+
| `Utc ts -> datetime_to_str ts true
333
+
| `Local ts -> datetime_to_str ts false
334
+
| `With_tzid (ts, _str) -> (* TODO *) datetime_to_str ts false
336
+
let recurs_to_ics (freq, count_or_until, interval, l) buf =
337
+
let write_rulepart key value =
338
+
Buffer.add_string buf key;
339
+
Buffer.add_char buf '=';
340
+
Buffer.add_string buf value
342
+
let int_list l = String.concat "," @@ List.map string_of_int l in
343
+
let recur_to_ics = function
344
+
| `Byminute byminlist -> write_rulepart "BYMINUTE" (int_list byminlist)
345
+
| `Byday bywdaylist ->
346
+
let wday (weeknumber, weekday) =
347
+
(if weeknumber = 0 then "" else string_of_int weeknumber)
348
+
^ List.assoc weekday weekday_strings
350
+
write_rulepart "BYDAY" (String.concat "," @@ List.map wday bywdaylist)
351
+
| `Byhour byhrlist -> write_rulepart "BYHOUR" (int_list byhrlist)
352
+
| `Bymonth bymolist -> write_rulepart "BYMONTH" (int_list bymolist)
353
+
| `Bymonthday bymodaylist ->
354
+
write_rulepart "BYMONTHDAY" (int_list bymodaylist)
355
+
| `Bysecond byseclist -> write_rulepart "BYSECOND" (int_list byseclist)
356
+
| `Bysetposday bysplist -> write_rulepart "BYSETPOS" (int_list bysplist)
357
+
| `Byweek bywknolist -> write_rulepart "BYWEEKNO" (int_list bywknolist)
358
+
| `Byyearday byyrdaylist ->
359
+
write_rulepart "BYYEARDAY" (int_list byyrdaylist)
360
+
| `Weekday weekday ->
361
+
write_rulepart "WKST" (List.assoc weekday weekday_strings)
363
+
write_rulepart "FREQ" (List.assoc freq freq_strings);
364
+
(match count_or_until with
367
+
Buffer.add_char buf ';';
369
+
| `Count c -> write_rulepart "COUNT" (string_of_int c)
370
+
| `Until enddate ->
372
+
Buffer.add_string buf "UNTIL=";
373
+
timestamp_to_ics enddate buf));
374
+
(match interval with
377
+
Buffer.add_char buf ';';
378
+
write_rulepart "INTERVAL" (string_of_int i));
381
+
Buffer.add_char buf ';';
382
+
recur_to_ics recur)
385
+
let format_event ?(format = `Text) ?tz event =
386
+
let start = get_start event in
387
+
let end_ = get_end event in
390
+
let id = get_id event in
391
+
let start_date = " " ^ format_date ?tz start in
393
+
match is_date event with
395
+
| false -> " " ^ format_time ?tz start
397
+
let end_date, end_time =
401
+
match (is_date event, next_day start ~next:end_) with
402
+
| true, true -> ("", "")
403
+
| true, _ -> (" - " ^ format_date ?tz end_, "")
404
+
| false, true -> ("", " - " ^ format_time ?tz end_)
406
+
(" - " ^ format_date ?tz end_, " " ^ format_time ?tz end_))
409
+
match get_summary event with
410
+
| Some summary when summary <> "" -> " " ^ summary
414
+
match get_location event with
415
+
| Some loc when loc <> "" -> " @" ^ loc
418
+
Printf.sprintf "%-45s%s%s%s%s%s%s" id start_date start_time end_date
419
+
end_time summary location
421
+
let format_opt label f opt =
422
+
Option.map (fun x -> Printf.sprintf "%s: %s\n" label (f x)) opt
423
+
|> Option.value ~default:""
425
+
let format timezone datetime =
426
+
match is_date event with
427
+
| true -> format_date ?tz datetime
429
+
format_datetime ?tz datetime
430
+
^ match timezone with None -> "" | Some t -> " (" ^ t ^ ")")
433
+
format_opt "Start" (format (get_start_timezone event)) (Some start)
435
+
let end_str = format_opt "End" (format (get_end_timezone event)) end_ in
436
+
let location_str = format_opt "Location" Fun.id (get_location event) in
437
+
let description_str =
438
+
format_opt "Description" Fun.id (get_description event)
443
+
let buf = Buffer.create 128 in
444
+
recurs_to_ics r buf;
445
+
Printf.sprintf "%s: %s\n" "Reccurence" (Buffer.contents buf))
446
+
(get_recurrence event)
447
+
|> Option.value ~default:""
449
+
let summary_str = format_opt "Summary" Fun.id (get_summary event) in
450
+
let file_str = format_opt "File" Fun.id (Some (snd (get_file event))) in
451
+
Printf.sprintf "%s%s%s%s%s%s%s" summary_str start_str end_str location_str
452
+
description_str rrule_str file_str
454
+
let open Yojson.Safe in
458
+
("id", `String (get_id event));
460
+
match get_summary event with
461
+
| Some summary -> `String summary
463
+
("start", `String (format_datetime ?tz start));
466
+
| Some e -> `String (format_datetime ?tz e)
469
+
match get_location event with
470
+
| Some loc -> `String loc
473
+
match get_description event with
474
+
| Some desc -> `String desc
477
+
match get_collection event with
478
+
| Collection.Col cal -> `String cal );
484
+
match get_summary event with Some summary -> summary | None -> ""
486
+
let start = format_datetime ?tz start in
488
+
match end_ with Some e -> format_datetime ?tz e | None -> ""
491
+
match get_location event with Some loc -> loc | None -> ""
494
+
match get_collection event with Collection.Col cal -> cal
496
+
Printf.sprintf "\"%s\",\"%s\",\"%s\",\"%s\",\"%s\"" summary start end_str
499
+
let calendar = to_ical_calendar event in
500
+
Icalendar.to_ics ~cr:true calendar
503
+
match get_summary event with Some summary -> summary | None -> ""
505
+
let start_date, start_time =
506
+
let dt = Date.ptime_to_timedesc ?tz start in
507
+
let y = Timedesc.year dt in
508
+
let m = Timedesc.month dt in
509
+
let d = Timedesc.day dt in
510
+
let h = Timedesc.hour dt in
511
+
let min = Timedesc.minute dt in
512
+
let s = Timedesc.second dt in
514
+
match Timedesc.weekday dt with
516
+
| `Tue -> "tuesday"
517
+
| `Wed -> "wednesday"
518
+
| `Thu -> "thursday"
520
+
| `Sat -> "saturday"
523
+
( Printf.sprintf "(%04d %02d %02d %s)" y m d dow,
524
+
Printf.sprintf "(%02d %02d %02d)" h min s )
529
+
let dt = Date.ptime_to_timedesc ?tz end_date in
530
+
let y = Timedesc.year dt in
531
+
let m = Timedesc.month dt in
532
+
let d = Timedesc.day dt in
533
+
let h = Timedesc.hour dt in
534
+
let min = Timedesc.minute dt in
535
+
let s = Timedesc.second dt in
537
+
match Timedesc.weekday dt with
539
+
| `Tue -> "tuesday"
540
+
| `Wed -> "wednesday"
541
+
| `Thu -> "thursday"
543
+
| `Sat -> "saturday"
546
+
Printf.sprintf "((%04d %02d %02d %s) (%02d %02d %02d))" y m d dow h
551
+
match get_location event with
552
+
| Some loc -> Printf.sprintf "\"%s\"" (String.escaped loc)
556
+
match get_description event with
557
+
| Some desc -> Printf.sprintf "\"%s\"" (String.escaped desc)
561
+
match get_collection event with
562
+
| Collection.Col cal -> Printf.sprintf "\"%s\"" (String.escaped cal)
564
+
let id = get_id event in
566
+
"((:id \"%s\" :summary \"%s\" :start (%s %s) :end %s :location %s \
567
+
:description %s :calendar %s))"
568
+
(String.escaped id) (String.escaped summary) start_date start_time
569
+
end_str location description calendar
571
+
let format_events ?(format = `Text) ?tz events =
576
+
(fun e -> Yojson.Safe.from_string (format_event ~format:`Json ?tz e))
579
+
Yojson.Safe.to_string (`List json_events)
581
+
"\"Summary\",\"Start\",\"End\",\"Location\",\"Calendar\"\n"
582
+
^ String.concat "\n" (List.map (format_event ~format:`Csv ?tz) events)
585
+
^ String.concat "\n "
586
+
(List.map (fun e -> format_event ~format:`Sexp ?tz e) events)
589
+
String.concat "\n" (List.map (fun e -> format_event ~format ?tz e) events)
let expand_recurrences ~from ~to_ event =
let rule = get_recurrence event in
ryan.freumh.org