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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
(* 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
(* [name] is the view's own resolved display string (view.ml) -- no
further fallback needed here: under [Lang.raw] it already equals
[slug], which is what a miss used to require picking by hand.
[rank_name]/[colour_name], not the bare [rank]/[colour]: those two
carry the kernel's own unlocalised strings ("class-1", "white"),
exactly the raw-slug shape [name] itself moved away from -- SUMMARY
is a human-facing calendar entry, and printing "(class-1, white)"
beside a properly resolved name (e.g. "II classis, albus") was the
one field this emitter had not yet been updated to localise; the
JSON/CSV/XML emitters already expose both pairs and a template author
already has to choose the localised one deliberately. *)
let name = s d "name" in
let summary = Printf.sprintf "%s (%s, %s)" name (s d "rank_name") (s d "colour_name") 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
|
