aboutsummaryrefslogtreecommitdiff
path: root/lib/render/emit_ics.ml
blob: e1a5ad0eba3eef557f43ddf4bbe9148333b268e0 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
(* emit_ics.ml *)
module T = Template

let get v k = match v with T.Obj kvs -> List.assoc_opt k kvs | _ -> None
let s v k = match get v k with Some (T.Str x) -> x | _ -> ""

let compact iso = (* "2027-01-13" -> "20270113" *)
  String.concat "" (String.split_on_char '-' iso)

(* Civil-date successor without touching the kernel: parse, add, re-format via
   Colitur_kernel.Date, which is already total and validated over 1583..9999. *)
let next_day iso =
  match Colitur_kernel.Date.of_iso8601 iso with
  | Ok d -> Colitur_kernel.Date.to_iso8601 (Colitur_kernel.Date.add_days d 1)
  | Error _ -> iso

let esc x = Escape.apply Escape.Ics x
let line b l = Buffer.add_string b (Escape.fold_ics l)

let event b ~rite ~dtstamp d =
  let iso = s d "iso" in
  if iso <> "" then begin
    let name =
      match get d "name" with
      | Some (T.Obj kvs) -> (
          match List.assoc_opt "en" kvs with
          | Some (T.Str x) when x <> "" -> x
          | _ -> ( match List.assoc_opt "la" kvs with Some (T.Str x) -> x | _ -> s d "slug"))
      | _ -> s d "slug"
    in
    let summary = Printf.sprintf "%s (%s, %s)" name (s d "rank") (s d "colour") in
    let desc =
      String.concat "\n"
        (List.filter (fun x -> x <> "")
           [ (if s d "first" <> "" then "Epistle " ^ s d "first" else "");
             (if s d "gospel" <> "" then "Gospel " ^ s d "gospel" else "") ])
    in
    line b "BEGIN:VEVENT";
    (* RFC 5545 section 3.8.4.7: the UID must be stable across regenerations,
       or every subscriber gets a duplicate of the whole year. *)
    line b (Printf.sprintf "UID:%s-%s@colitur" (compact iso) rite);
    line b ("DTSTAMP:" ^ dtstamp);
    line b ("DTSTART;VALUE=DATE:" ^ compact iso);
    (* RFC 5545 section 3.6.1: DTEND is EXCLUSIVE for an all-day event. *)
    line b ("DTEND;VALUE=DATE:" ^ compact (next_day iso));
    line b ("SUMMARY:" ^ esc summary);
    if desc <> "" then line b ("DESCRIPTION:" ^ esc desc);
    line b "TRANSP:TRANSPARENT";
    line b "END:VEVENT"
  end

let year ?dtstamp ?calname v =
  let rite = s v "rite" in
  let y = s v "year" in
  let dtstamp = match dtstamp with Some x -> x | None -> y ^ "0101T000000Z" in
  let calname = match calname with Some x -> x | None -> "colitur " ^ rite ^ " " ^ y in
  let b = Buffer.create (256 * 1024) in
  line b "BEGIN:VCALENDAR";
  line b "VERSION:2.0";
  line b "PRODID:-//colitur//liturgical calendar//EN";
  line b "CALSCALE:GREGORIAN";
  line b "METHOD:PUBLISH";
  (* Non-standard but universally honoured; without it clients show the URL. *)
  line b ("X-WR-CALNAME:" ^ esc calname);
  (match get v "days" with Some (T.List l) -> List.iter (event b ~rite ~dtstamp) l | _ -> ());
  line b "END:VCALENDAR";
  Buffer.contents b