diff options
Diffstat (limited to 'lib/render/emit_ics.ml')
| -rw-r--r-- | lib/render/emit_ics.ml | 107 |
1 files changed, 107 insertions, 0 deletions
diff --git a/lib/render/emit_ics.ml b/lib/render/emit_ics.ml new file mode 100644 index 0000000..41efb95 --- /dev/null +++ b/lib/render/emit_ics.ml @@ -0,0 +1,107 @@ +(* 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) + (* Dead on shipped data: [event]'s own [iso <> ""] guard is the only + caller, and every real [iso] it passes came from [Date.to_iso8601] in + the first place, so it always parses. Left total rather than raising + (the kernel/render determinism rule), but a caller relying on this + branch would silently get DTEND == DTSTART -- a zero-length event -- + with no diagnostic, if it were ever actually reached. Documented, not + fixed: nothing exercises it. *) + | Error _ -> iso + +(* RFC 5545 section 3.6.1: a VEVENT with a DATE-valued DTSTART and NEITHER + DTEND NOR DURATION has an implicit duration of exactly one day, so + omitting DTEND for the domain's own last day is the standard's own + correct way to say precisely what we mean -- not a workaround. + + Needed because [Date.add_days] is itself UNBOUNDED (date.mli: "may + denote a year outside 1583..9999 -- only [make] enforces the domain"): + the successor of 9999-12-31 is a real [Date.t] that [next_day] above + happily renders as "10000-01-01" (date.ml's [to_iso8601] pads with + [Printf.sprintf "%04d-..."] but never truncates), which [compact] would + turn into a 9-digit, non-conformant DATE. [Date.make] is the ONE kernel + function that actually enforces 1583..9999 (date.mli), so this takes + [next_day]'s own successor string, re-derives its year/month/day, and + re-validates THOSE through [make] before trusting the string at all. + [None] means "one day past the domain's own last day"; the caller omits + DTEND entirely rather than clamp, truncate, or fall back to DURATION. *) +let dtend_of iso = + let next = next_day iso in + match String.split_on_char '-' next with + | [ y; m; d ] -> ( + match (int_of_string_opt y, int_of_string_opt m, int_of_string_opt d) with + | Some year, Some month, Some day -> ( + match Colitur_kernel.Date.make ~year ~month ~day with + | Ok _ -> Some next + | Error _ -> None) + | _ -> None) + | _ -> None + +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 -- and + omitted entirely, rather than emitted malformed, for the one event + whose successor falls outside the engine's own 1583..9999 domain + (see [dtend_of] above). *) + (match dtend_of iso with + | Some next -> line b ("DTEND;VALUE=DATE:" ^ compact next) + | None -> ()); + 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 |