events: VTIMEZONE iCal export — full DST-correct tz recurrence + 16 tests

A tz event now exports DTSTART;TZID=<name>:<local> (EXDATE/RDATE likewise; UNTIL stays UTC per RFC), and the VCALENDAR emits a VTIMEZONE per distinct zone with DAYLIGHT/STANDARD sub-components generated from the zone's transition rules (offsets + FREQ=YEARLY;BYMONTH;BYDAY) — London/Paris blocks match real-world definitions. Clients recur at fixed wall-clock time, DST-correct (prior caveat gone). Importer tolerates ;TZID= params. 376/376 green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 20:03:07 +00:00
parent 34c9b211ac
commit 826d926740
5 changed files with 273 additions and 74 deletions
--- a/lib/events/ical.sx
+++ b/lib/events/ical.sx
@@ -41,9 +41,9 @@
      ""
      (reduce (fn (acc p) (str acc sep p)) (first parts) (rest parts)))))

-;; A UTC epoch-minute as an iCal basic-format UTC stamp.
+;; An epoch-minute as an iCal basic-format stamp (no zone suffix).
 (define
-  ev-ical-dt
+  ev-ical-dt-stamp
  (fn
    (t)
    (let
@@ -55,7 +55,25 @@
        "T"
        (ev-ical-pad2 (quotient tod 60))
        (ev-ical-pad2 (modulo tod 60))
-        "00Z"))))
+        "00"))))
+
+;; A UTC epoch-minute as a UTC stamp (trailing Z).
+(define ev-ical-dt (fn (t) (str (ev-ical-dt-stamp t) "Z")))
+
+;; A local epoch-minute as a floating/local stamp (no Z) — used with TZID.
+(define ev-ical-dt-local ev-ical-dt-stamp)
+
+;; A UTC offset in minutes as "+HHMM" / "-HHMM".
+(define
+  ev-ical-offset
+  (fn
+    (mins)
+    (let
+      ((a (abs mins)))
+      (str
+        (if (< mins 0) "-" "+")
+        (ev-ical-pad2 (quotient a 60))
+        (ev-ical-pad2 (modulo a 60))))))

 ;; A duration in minutes as an iCal DURATION value (PT#H#M).
 (define
@@ -94,14 +112,8 @@
      (str (get e :ord) (ev-ical-wd (get e :wd)))
      (ev-ical-wd e))))

-;; A datetime converter for an event: tz-aware events store wall-clock LOCAL
-;; times, so export converts them to UTC (the `Z` stamps are absolute);
-;; non-tz events pass through unchanged.
-;;   CAVEAT: a UTC RRULE recurs at a fixed UTC offset, whereas a tz event's
-;;   expansion stays wall-clock-stable across DST — so for a tz recurrence that
-;;   crosses a DST boundary the exported series drifts by the offset change
-;;   after the boundary. DTSTART and each individual stamp are correct; full
-;;   fidelity would need a VTIMEZONE block (deferred).
+;; UNTIL converter: per RFC 5545, even a TZID DTSTART requires UNTIL in UTC, so
+;; a tz event converts its (local) UNTIL to UTC; a non-tz event passes through.
 (define
  ev-ical-conv
  (fn
@@ -110,6 +122,74 @@
      ((tz (get event :tz)))
      (if (nil? tz) (fn (t) t) (fn (t) (ev-tz-local->utc tz t))))))

+;; ---- VTIMEZONE ----
+;; A tz event exports DTSTART;TZID=<name>:<local time> and the VCALENDAR carries
+;; a VTIMEZONE block defining the zone's DST rules, so a client recurs at a
+;; fixed WALL-CLOCK time (DST-correct) rather than fixed UTC.
+
+;; A DST transition rule -> "FREQ=YEARLY;BYMONTH=<m>;BYDAY=<ord><WD>".
+(define
+  ev-ical-vtz-rrule
+  (fn
+    (rule)
+    (str
+      "FREQ=YEARLY;BYMONTH="
+      (get rule :month)
+      ";BYDAY="
+      (get rule :ord)
+      (ev-ical-wd (get rule :wd)))))
+
+;; The transition's DTSTART (local time of the FROM offset) in a reference year.
+(define
+  ev-ical-vtz-dtstart
+  (fn
+    (rule from-offset)
+    (let
+      ((day (ev-resolve-nth-weekday 1970 (get rule :month) (get rule :ord) (get rule :wd))))
+      (ev-ical-dt-local
+        (+ (* (ev-days-from-civil 1970 (get rule :month) day) 1440)
+          (get rule :time)
+          from-offset)))))
+
+;; The VTIMEZONE content lines for a zone (DAYLIGHT + STANDARD for :dst; a
+;; single STANDARD for :fixed).
+(define
+  ev-ical-vtimezone
+  (fn
+    (tz)
+    (if
+      (= (get tz :kind) :dst)
+      (let
+        ((std (get tz :std-offset))
+          (dst (get tz :dst-offset))
+          (sr (get tz :dst-start))
+          (er (get tz :dst-end)))
+        (list
+          "BEGIN:VTIMEZONE"
+          (str "TZID:" (get tz :name))
+          "BEGIN:DAYLIGHT"
+          (str "DTSTART:" (ev-ical-vtz-dtstart sr std))
+          (str "TZOFFSETFROM:" (ev-ical-offset std))
+          (str "TZOFFSETTO:" (ev-ical-offset dst))
+          (str "RRULE:" (ev-ical-vtz-rrule sr))
+          "END:DAYLIGHT"
+          "BEGIN:STANDARD"
+          (str "DTSTART:" (ev-ical-vtz-dtstart er dst))
+          (str "TZOFFSETFROM:" (ev-ical-offset dst))
+          (str "TZOFFSETTO:" (ev-ical-offset std))
+          (str "RRULE:" (ev-ical-vtz-rrule er))
+          "END:STANDARD"
+          "END:VTIMEZONE"))
+      (list
+        "BEGIN:VTIMEZONE"
+        (str "TZID:" (get tz :name))
+        "BEGIN:STANDARD"
+        "DTSTART:19700101T000000"
+        (str "TZOFFSETFROM:" (ev-ical-offset (get tz :offset)))
+        (str "TZOFFSETTO:" (ev-ical-offset (get tz :offset)))
+        "END:STANDARD"
+        "END:VTIMEZONE"))))
+
 ;; ---- RRULE ----
 (define
  ev-ical-rrule
@@ -149,45 +229,84 @@

 ;; ---- VEVENT / VCALENDAR ----

-;; The VEVENT content lines for an event (list of strings).
+;; The VEVENT content lines for an event (list of strings). A tz event uses
+;; DTSTART;TZID=<name>:<local> (matched by a VTIMEZONE at the VCALENDAR level)
+;; with EXDATE/RDATE in the same TZID-local form; UNTIL is always UTC. A non-tz
+;; event uses UTC `Z` stamps throughout.
 (define
  ev/event->ical-lines
  (fn
    (event)
    (let
-      ((lines (list "BEGIN:VEVENT")) (conv (ev-ical-conv event)))
-      (begin
-        (append! lines (str "UID:" (get event :id)))
-        (append! lines (str "SUMMARY:" (get event :id)))
-        (append! lines (str "DTSTART:" (ev-ical-dt (conv (get event :dtstart)))))
-        (append!
-          lines
-          (str "DURATION:" (ev-ical-duration (get event :duration))))
-        (when
-          (not (nil? (get event :rrule)))
-          (append! lines (ev-ical-rrule (get event :rrule) conv)))
-        (when
-          (and
-            (not (nil? (get event :exdate)))
-            (> (len (get event :exdate)) 0))
+      ((lines (list "BEGIN:VEVENT"))
+        (conv (ev-ical-conv event))
+        (tz (get event :tz)))
+      (let
+        ((dtparam (if (nil? tz) "" (str ";TZID=" (get tz :name))))
+          (fmt (if (nil? tz) ev-ical-dt ev-ical-dt-local)))
+        (begin
+          (append! lines (str "UID:" (get event :id)))
+          (append! lines (str "SUMMARY:" (get event :id)))
+          (append! lines (str "DTSTART" dtparam ":" (fmt (get event :dtstart))))
          (append!
            lines
-            (str
-              "EXDATE:"
-              (ev-ical-join (map (fn (d) (ev-ical-dt (conv d))) (get event :exdate)) ","))))
-        (when
-          (and
-            (not (nil? (get event :rdate)))
-            (> (len (get event :rdate)) 0))
-          (append!
-            lines
-            (str
-              "RDATE:"
-              (ev-ical-join (map (fn (d) (ev-ical-dt (conv d))) (get event :rdate)) ","))))
-        (append! lines "END:VEVENT")
-        lines))))
+            (str "DURATION:" (ev-ical-duration (get event :duration))))
+          (when
+            (not (nil? (get event :rrule)))
+            (append! lines (ev-ical-rrule (get event :rrule) conv)))
+          (when
+            (and
+              (not (nil? (get event :exdate)))
+              (> (len (get event :exdate)) 0))
+            (append!
+              lines
+              (str
+                "EXDATE"
+                dtparam
+                ":"
+                (ev-ical-join (map fmt (get event :exdate)) ","))))
+          (when
+            (and
+              (not (nil? (get event :rdate)))
+              (> (len (get event :rdate)) 0))
+            (append!
+              lines
+              (str
+                "RDATE"
+                dtparam
+                ":"
+                (ev-ical-join (map fmt (get event :rdate)) ","))))
+          (append! lines "END:VEVENT")
+          lines)))))

-;; A full VCALENDAR (list of content lines) wrapping every event.
+;; Collect the distinct timezones used by a list of events (by :name).
+(define
+  ev-ical-distinct-tzs
+  (fn
+    (events)
+    (reduce
+      (fn
+        (acc ev)
+        (let
+          ((tz (get ev :tz)))
+          (if
+            (or (nil? tz) (ev-ical-tz-seen? acc (get tz :name)))
+            acc
+            (append acc (list tz)))))
+      (list)
+      events)))
+
+(define
+  ev-ical-tz-seen?
+  (fn
+    (tzs name)
+    (cond
+      ((empty? tzs) false)
+      ((= (get (first tzs) :name) name) true)
+      (else (ev-ical-tz-seen? (rest tzs) name)))))
+
+;; A full VCALENDAR (list of content lines): a VTIMEZONE block for each distinct
+;; zone the events reference, then every VEVENT.
 (define
  ev/events->ical-lines
  (fn
@@ -195,6 +314,11 @@
    (let
      ((lines (list "BEGIN:VCALENDAR" "VERSION:2.0" "PRODID:-//rose-ash//events-on-sx//EN")))
      (begin
+        (for-each
+          (fn
+            (tz)
+            (for-each (fn (l) (append! lines l)) (ev-ical-vtimezone tz)))
+          (ev-ical-distinct-tzs events))
        (for-each
          (fn
            (ev)
@@ -323,7 +447,8 @@
              (when
                (> (len kv) 1)
                (let
-                  ((k (first kv)) (v (first (rest kv))))
+                  ;; strip any property parameters (e.g. ";TZID=...") from the key
+                  ((k (first (split (first kv) ";"))) (v (first (rest kv))))
                  (cond
                    ((= k "UID") (dict-set! ev :id (string->symbol v)))
                    ((= k "DTSTART") (dict-set! ev :dtstart (ev-ical-parse-dt v)))
--- a/lib/events/scoreboard.json
+++ b/lib/events/scoreboard.json
@@ -1,12 +1,12 @@
 {
  "lang": "events",
-  "total_passed": 366,
+  "total_passed": 376,
  "total_failed": 0,
-  "total": 366,
+  "total": 376,
  "suites": [
    {"name":"calendar","passed":51,"failed":0,"total":51},
    {"name":"timezone","passed":17,"failed":0,"total":17},
-    {"name":"ical","passed":46,"failed":0,"total":46},
+    {"name":"ical","passed":56,"failed":0,"total":56},
    {"name":"availability","passed":22,"failed":0,"total":22},
    {"name":"api","passed":41,"failed":0,"total":41},
    {"name":"booking","passed":82,"failed":0,"total":82},
@@ -17,5 +17,5 @@
    {"name":"federation","passed":29,"failed":0,"total":29},
    {"name":"integration","passed":8,"failed":0,"total":8}
  ],
-  "generated": "2026-06-07T18:33:58+00:00"
+  "generated": "2026-06-07T20:02:48+00:00"
 }
--- a/lib/events/scoreboard.md
+++ b/lib/events/scoreboard.md
@@ -1,12 +1,12 @@
 # events scoreboard

-**366 / 366 passing** (0 failure(s)).
+**376 / 376 passing** (0 failure(s)).

 | Suite | Passed | Total | Status |
 |-------|--------|-------|--------|
 | calendar | 51 | 51 | ok |
 | timezone | 17 | 17 | ok |
-| ical | 46 | 46 | ok |
+| ical | 56 | 56 | ok |
 | availability | 22 | 22 | ok |
 | api | 41 | 41 | ok |
 | booking | 82 | 82 | ok |
--- a/lib/events/tests/ical.sx
+++ b/lib/events/tests/ical.sx
@@ -266,47 +266,112 @@
              (ev-ic-starts (first events))
              (ev-ic-starts (ev-event (quote a) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 3} 1)))))))))

-;; ---- timezone-aware export (local wall-clock -> UTC stamps) ----
+;; ---- timezone-aware export (TZID + VTIMEZONE) ----
 (define
-  ev-ic-dtstart
-  (fn (ev) (ev-ic-line (ev/event->ical-lines ev) "DTSTART")))
+  ev-ic-find
+  (fn
+    (lines pfx)
+    (cond
+      ((empty? lines) nil)
+      ((ev-ic-prefix? (first lines) pfx) (first lines))
+      (else (ev-ic-find (rest lines) pfx)))))
+
+(define ev-ic-count (fn (lines x) (len (filter (fn (l) (= l x)) lines))))
+
+(define
+  ev-ic-index
+  (fn
+    (lines x)
+    (cond
+      ((empty? lines) -1)
+      ((= (first lines) x) 0)
+      (else
+        (let ((r (ev-ic-index (rest lines) x))) (if (< r 0) -1 (+ 1 r)))))))

 (define
  ev-ic-tz-run-all!
  (fn
    ()
    (do
+      ;; a tz event's DTSTART is local wall-clock with a TZID parameter
      (ev-ic-check!
-        "London winter event exports as the same UTC (GMT)"
-        (ev-ic-dtstart (ev-event-tz (quote w) (ev-dt 2026 1 15 18 0) 60 nil 1 ev-tz-london))
-        "DTSTART:20260115T180000Z")
+        "tz event DTSTART uses TZID + local wall-clock (not UTC)"
+        (ev-ic-find (ev/event->ical-lines (ev-event-tz (quote w) (ev-dt 2026 7 15 18 0) 60 nil 1 ev-tz-london)) "DTSTART")
+        "DTSTART;TZID=Europe/London:20260715T180000")
      (ev-ic-check!
-        "London summer event exports one hour earlier in UTC (BST)"
-        (ev-ic-dtstart (ev-event-tz (quote s) (ev-dt 2026 7 15 18 0) 60 nil 1 ev-tz-london))
-        "DTSTART:20260715T170000Z")
-      (ev-ic-check!
-        "Paris winter (CET +1) exports one hour earlier in UTC"
-        (ev-ic-dtstart (ev-event-tz (quote p) (ev-dt 2026 1 15 18 0) 60 nil 1 ev-tz-paris))
-        "DTSTART:20260115T170000Z")
-      (ev-ic-check!
-        "Paris summer (CEST +2) exports two hours earlier in UTC"
-        (ev-ic-dtstart (ev-event-tz (quote p) (ev-dt 2026 7 15 18 0) 60 nil 1 ev-tz-paris))
-        "DTSTART:20260715T160000Z")
-      (ev-ic-check!
-        "a non-tz event is exported unchanged"
-        (ev-ic-dtstart (ev-event (quote n) (ev-dt 2026 7 15 18 0) 60 nil 1))
+        "a non-tz event still uses a UTC Z stamp"
+        (ev-ic-find (ev/event->ical-lines (ev-event (quote n) (ev-dt 2026 7 15 18 0) 60 nil 1)) "DTSTART")
        "DTSTART:20260715T180000Z")
-      ;; EXDATE on a tz event is also converted to UTC
+      ;; UNTIL stays UTC even for a TZID event (RFC 5545)
      (ev-ic-check!
-        "tz event EXDATE is converted to UTC"
-        (ev-ic-line
+        "tz event RRULE UNTIL is still UTC"
+        (ev-ic-find
+          (ev/event->ical-lines
+            (ev-event-tz (quote s) (ev-dt 2026 6 1 18 0) 60 {:freq :weekly :byday (list 0) :until (ev-dt 2026 6 30 23 0)} 1 ev-tz-london))
+          "RRULE")
+        "RRULE:FREQ=WEEKLY;UNTIL=20260630T220000Z;BYDAY=MO")
+      ;; EXDATE matches the DTSTART form (TZID + local)
+      (ev-ic-check!
+        "tz event EXDATE uses TZID + local"
+        (ev-ic-find
          (ev/event->ical-lines
            (assoc
              (ev-event-tz (quote s) (ev-dt 2026 7 1 18 0) 60 {:freq :daily :count 3} 1 ev-tz-london)
              :exdate
              (list (ev-dt 2026 7 2 18 0))))
          "EXDATE")
-        "EXDATE:20260702T170000Z"))))
+        "EXDATE;TZID=Europe/London:20260702T180000")
+
+      ;; ---- VTIMEZONE block ----
+      (let
+        ((vtz (ev-ical-vtimezone ev-tz-london)))
+        (do
+          (ev-ic-check! "VTIMEZONE names the zone" (ev-ic-find vtz "TZID") "TZID:Europe/London")
+          (ev-ic-check! "DAYLIGHT transitions GMT->BST" (ev-ic-find vtz "TZOFFSETTO:+0100") "TZOFFSETTO:+0100")
+          (ev-ic-check! "DAYLIGHT rule is last Sunday of March" (ev-ic-find vtz "RRULE:FREQ=YEARLY;BYMONTH=3") "RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU")
+          (ev-ic-check! "STANDARD rule is last Sunday of October" (ev-ic-find vtz "RRULE:FREQ=YEARLY;BYMONTH=10") "RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU")))
+      (let
+        ((vtz (ev-ical-vtimezone ev-tz-paris)))
+        (do
+          (ev-ic-check! "Paris DAYLIGHT goes to +0200 (CEST)" (ev-ic-find vtz "TZOFFSETTO:+0200") "TZOFFSETTO:+0200")
+          (ev-ic-check! "Paris STANDARD goes to +0100 (CET)" (ev-ic-find vtz "TZOFFSETTO:+0100") "TZOFFSETTO:+0100")))
+
+      ;; ---- VCALENDAR carries one VTIMEZONE per distinct zone ----
+      (let
+        ((cal (ev/events->ical-lines (list (ev-event-tz (quote a) (ev-dt 2026 6 1 9 0) 60 nil 1 ev-tz-london)))))
+        (do
+          (ev-ic-check! "VCALENDAR includes the referenced VTIMEZONE" (ev-ic-count cal "BEGIN:VTIMEZONE") 1)
+          (ev-ic-check! "VTIMEZONE precedes the VEVENT" (< (ev-ic-index cal "BEGIN:VTIMEZONE") (ev-ic-index cal "BEGIN:VEVENT")) true)))
+      (ev-ic-check!
+        "two events in the same zone share one VTIMEZONE"
+        (ev-ic-count
+          (ev/events->ical-lines
+            (list
+              (ev-event-tz (quote a) (ev-dt 2026 6 1 9 0) 60 nil 1 ev-tz-london)
+              (ev-event-tz (quote b) (ev-dt 2026 6 2 9 0) 60 nil 1 ev-tz-london)))
+          "BEGIN:VTIMEZONE")
+        1)
+      (ev-ic-check!
+        "events in two zones get two VTIMEZONEs"
+        (ev-ic-count
+          (ev/events->ical-lines
+            (list
+              (ev-event-tz (quote a) (ev-dt 2026 6 1 9 0) 60 nil 1 ev-tz-london)
+              (ev-event-tz (quote b) (ev-dt 2026 6 2 9 0) 60 nil 1 ev-tz-paris)))
+          "BEGIN:VTIMEZONE")
+        2)
+      (ev-ic-check!
+        "a non-tz-only calendar has no VTIMEZONE"
+        (ev-ic-count (ev/events->ical-lines (list (ev-event (quote a) (ev-dt 2026 6 1 9 0) 60 nil 1))) "BEGIN:VTIMEZONE")
+        0)
+
+      ;; ---- import tolerates the TZID parameter ----
+      (ev-ic-check!
+        "import parses DTSTART;TZID local time"
+        (get
+          (ev/ical-lines->event (ev/event->ical-lines (ev-event-tz (quote a) (ev-dt 2026 7 15 18 0) 60 nil 1 ev-tz-london)))
+          :dtstart)
+        (ev-dt 2026 7 15 18 0)))))

 (define
  ev-ical-tests-run!
--- a/plans/events-on-sx.md
+++ b/plans/events-on-sx.md
@@ -18,7 +18,7 @@ capacity rules, transactional booking, and a flow-driven notification dispatcher

 ## Status (rolling)

-`bash lib/events/conformance.sh` → **366/366** (Phases 1-4 + 13 ext + tz-aware iCal export fix)
+`bash lib/events/conformance.sh` → **376/376** (Phases 1-4 + 13 ext + tz iCal export via TZID + VTIMEZONE)

 ## Ground rules

@@ -88,6 +88,15 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ──

 ## Progress log

+- 2026-06-07 — VTIMEZONE iCal export (supersedes the UTC-Z tz fix — full DST
+  fidelity). A tz event now exports DTSTART;TZID=<name>:<local> (+ EXDATE/RDATE
+  in the same TZID-local form; UNTIL stays UTC per RFC), and the VCALENDAR emits
+  a VTIMEZONE per distinct zone with DAYLIGHT/STANDARD sub-components generated
+  from the zone's transition rules (offsets + FREQ=YEARLY;BYMONTH;BYDAY) — the
+  London/Paris blocks match real-world definitions exactly. So a client recurs
+  the event at a fixed WALL-CLOCK time, DST-correct (the prior caveat is gone).
+  `ev-ical-vtimezone`, `ev-ical-offset`, distinct-zone collection; importer now
+  tolerates the ;TZID= parameter. +16 tests (ical 56), 376/376 green.
 - 2026-06-07 — Fix: timezone-aware iCal export. Bug — tz events store wall-clock
  LOCAL times, but export stamped them with a `Z` (UTC) suffix, so a London
  18:00 event falsely read as 18:00 UTC. `ev-ical-conv` now converts a tz