From ddc6635fa8960a520c48815a78ce0e64d769c652 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 14:41:08 +0000 Subject: [PATCH] events: iCalendar (RFC 5545) export + 21 tests ical.sx serializes events to VEVENT/VCALENDAR text for import by standard clients: UTC basic-format stamps, DURATION (PT#H#M), full RRULE (FREQ/INTERVAL/COUNT/UNTIL/BYDAY incl. monthly ordinals 2TU/-1FR/BYMONTHDAY) plus EXDATE/RDATE. Line-oriented (ev/event->ical-lines / ev/events->ical-lines) with ev/ical-render joining CRLF for the wire format. 332/332 green. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/events/conformance.conf | 2 + lib/events/ical.sx | 191 +++++++++++++++++++++++++++++++++++ lib/events/scoreboard.json | 7 +- lib/events/scoreboard.md | 3 +- lib/events/tests/ical.sx | 192 ++++++++++++++++++++++++++++++++++++ plans/events-on-sx.md | 9 +- 6 files changed, 399 insertions(+), 5 deletions(-) create mode 100644 lib/events/ical.sx create mode 100644 lib/events/tests/ical.sx diff --git a/lib/events/conformance.conf b/lib/events/conformance.conf index f8954faf..18dfc046 100644 --- a/lib/events/conformance.conf +++ b/lib/events/conformance.conf @@ -19,6 +19,7 @@ PRELOADS=( lib/datalog/magic.sx lib/events/calendar.sx lib/events/timezone.sx + lib/events/ical.sx lib/events/availability.sx lib/persist/event.sx lib/persist/backend.sx @@ -49,6 +50,7 @@ PRELOADS=( SUITES=( "calendar:lib/events/tests/calendar.sx:(ev-calendar-tests-run!)" "timezone:lib/events/tests/timezone.sx:(ev-timezone-tests-run!)" + "ical:lib/events/tests/ical.sx:(ev-ical-tests-run!)" "availability:lib/events/tests/availability.sx:(ev-availability-tests-run!)" "api:lib/events/tests/api.sx:(ev-api-tests-run!)" "booking:lib/events/tests/booking.sx:(ev-booking-tests-run!)" diff --git a/lib/events/ical.sx b/lib/events/ical.sx new file mode 100644 index 00000000..ae003b7c --- /dev/null +++ b/lib/events/ical.sx @@ -0,0 +1,191 @@ +;; lib/events/ical.sx — iCalendar (RFC 5545) export. +;; +;; Serializes events to VEVENT / VCALENDAR text so a rose-ash calendar can be +;; imported by any standard client (Google/Apple/Outlook). Datetimes are UTC +;; epoch-minutes, emitted as basic-format UTC stamps (YYYYMMDDTHHMM00Z). The +;; full RRULE / EXDATE / RDATE model maps directly to the standard properties. +;; +;; Export is line-oriented: `ev/event->ical-lines` returns the VEVENT as a list +;; of content lines (no folding/CRLF — easy to assert on); `ev/ical-render` +;; joins lines with CRLF, the on-the-wire format. Requires calendar.sx. + +;; ---- formatting helpers ---- + +(define ev-ical-pad2 (fn (n) (if (< n 10) (str "0" n) (str n)))) + +(define + ev-ical-pad4 + (fn + (n) + (cond + ((< n 10) (str "000" n)) + ((< n 100) (str "00" n)) + ((< n 1000) (str "0" n)) + (else (str n))))) + +(define + ev-ical-nth + (fn + (xs i) + (if + (= i 0) + (first xs) + (ev-ical-nth (rest xs) (- i 1))))) + +(define + ev-ical-join + (fn + (parts sep) + (if + (empty? parts) + "" + (reduce (fn (acc p) (str acc sep p)) (first parts) (rest parts))))) + +;; A UTC epoch-minute as an iCal basic-format UTC stamp. +(define + ev-ical-dt + (fn + (t) + (let + ((civ (ev-dt->civil t)) (tod (ev-dt-tod t))) + (str + (ev-ical-pad4 (ev-civ-y civ)) + (ev-ical-pad2 (ev-civ-m civ)) + (ev-ical-pad2 (ev-civ-d civ)) + "T" + (ev-ical-pad2 (quotient tod 60)) + (ev-ical-pad2 (modulo tod 60)) + "00Z")))) + +;; A duration in minutes as an iCal DURATION value (PT#H#M). +(define + ev-ical-duration + (fn + (mins) + (let + ((h (quotient mins 60)) (m (modulo mins 60))) + (cond + ((and (> h 0) (> m 0)) (str "PT" h "H" m "M")) + ((> h 0) (str "PT" h "H")) + (else (str "PT" m "M")))))) + +(define + ev-ical-wd + (fn (w) (ev-ical-nth (list "MO" "TU" "WE" "TH" "FR" "SA" "SU") w))) + +(define + ev-ical-freq + (fn + (f) + (cond + ((= f :daily) "DAILY") + ((= f :weekly) "WEEKLY") + ((= f :monthly) "MONTHLY") + (else "DAILY")))) + +;; One BYDAY token: a weekly weekday number -> "MO"; a monthly ordinal weekday +;; {:ord :wd} -> "2TU" / "-1FR". +(define + ev-ical-byday-token + (fn + (e) + (if + (dict? e) + (str (get e :ord) (ev-ical-wd (get e :wd))) + (ev-ical-wd e)))) + +;; ---- RRULE ---- +(define + ev-ical-rrule + (fn + (rrule) + (let + ((parts (list (str "FREQ=" (ev-ical-freq (get rrule :freq)))))) + (begin + (when + (and + (not (nil? (get rrule :interval))) + (> (get rrule :interval) 1)) + (append! parts (str "INTERVAL=" (get rrule :interval)))) + (when + (not (nil? (get rrule :count))) + (append! parts (str "COUNT=" (get rrule :count)))) + (when + (not (nil? (get rrule :until))) + (append! parts (str "UNTIL=" (ev-ical-dt (get rrule :until))))) + (when + (not (nil? (get rrule :byday))) + (append! + parts + (str + "BYDAY=" + (ev-ical-join (map ev-ical-byday-token (get rrule :byday)) ",")))) + (when + (not (nil? (get rrule :bymonthday))) + (append! + parts + (str + "BYMONTHDAY=" + (ev-ical-join + (map (fn (d) (str d)) (get rrule :bymonthday)) + ",")))) + (str "RRULE:" (ev-ical-join parts ";")))))) + +;; ---- VEVENT / VCALENDAR ---- + +;; The VEVENT content lines for an event (list of strings). +(define + ev/event->ical-lines + (fn + (event) + (let + ((lines (list "BEGIN:VEVENT"))) + (begin + (append! lines (str "UID:" (get event :id))) + (append! lines (str "SUMMARY:" (get event :id))) + (append! lines (str "DTSTART:" (ev-ical-dt (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)))) + (when + (and + (not (nil? (get event :exdate))) + (> (len (get event :exdate)) 0)) + (append! + lines + (str + "EXDATE:" + (ev-ical-join (map ev-ical-dt (get event :exdate)) ",")))) + (when + (and + (not (nil? (get event :rdate))) + (> (len (get event :rdate)) 0)) + (append! + lines + (str + "RDATE:" + (ev-ical-join (map ev-ical-dt (get event :rdate)) ",")))) + (append! lines "END:VEVENT") + lines)))) + +;; A full VCALENDAR (list of content lines) wrapping every event. +(define + ev/events->ical-lines + (fn + (events) + (let + ((lines (list "BEGIN:VCALENDAR" "VERSION:2.0" "PRODID:-//rose-ash//events-on-sx//EN"))) + (begin + (for-each + (fn + (ev) + (for-each (fn (l) (append! lines l)) (ev/event->ical-lines ev))) + events) + (append! lines "END:VCALENDAR") + lines)))) + +;; Render content lines to the on-the-wire iCalendar text (CRLF-separated). +(define ev/ical-render (fn (lines) (ev-ical-join lines "\r\n"))) diff --git a/lib/events/scoreboard.json b/lib/events/scoreboard.json index 7df5fc32..a5a30acd 100644 --- a/lib/events/scoreboard.json +++ b/lib/events/scoreboard.json @@ -1,11 +1,12 @@ { "lang": "events", - "total_passed": 311, + "total_passed": 332, "total_failed": 0, - "total": 311, + "total": 332, "suites": [ {"name":"calendar","passed":51,"failed":0,"total":51}, {"name":"timezone","passed":17,"failed":0,"total":17}, + {"name":"ical","passed":21,"failed":0,"total":21}, {"name":"availability","passed":22,"failed":0,"total":22}, {"name":"api","passed":32,"failed":0,"total":32}, {"name":"booking","passed":82,"failed":0,"total":82}, @@ -16,5 +17,5 @@ {"name":"federation","passed":29,"failed":0,"total":29}, {"name":"integration","passed":8,"failed":0,"total":8} ], - "generated": "2026-06-07T13:59:09+00:00" + "generated": "2026-06-07T14:40:54+00:00" } diff --git a/lib/events/scoreboard.md b/lib/events/scoreboard.md index f7eb1a50..b393b5b6 100644 --- a/lib/events/scoreboard.md +++ b/lib/events/scoreboard.md @@ -1,11 +1,12 @@ # events scoreboard -**311 / 311 passing** (0 failure(s)). +**332 / 332 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| | calendar | 51 | 51 | ok | | timezone | 17 | 17 | ok | +| ical | 21 | 21 | ok | | availability | 22 | 22 | ok | | api | 32 | 32 | ok | | booking | 82 | 82 | ok | diff --git a/lib/events/tests/ical.sx b/lib/events/tests/ical.sx new file mode 100644 index 00000000..905bfc1e --- /dev/null +++ b/lib/events/tests/ical.sx @@ -0,0 +1,192 @@ +;; lib/events/tests/ical.sx — iCalendar (RFC 5545) export. + +(define ev-ic-pass 0) +(define ev-ic-fail 0) +(define ev-ic-failures (list)) + +(define + ev-ic-check! + (fn + (name got expected) + (if + (= got expected) + (set! ev-ic-pass (+ ev-ic-pass 1)) + (do + (set! ev-ic-fail (+ ev-ic-fail 1)) + (append! + ev-ic-failures + (str name "\n expected: " expected "\n got: " got)))))) + +;; Find the value of a "KEY:value" line in a VEVENT line list (or nil). +(define + ev-ic-line + (fn + (lines key) + (cond + ((empty? lines) nil) + ((ev-ic-prefix? (first lines) (str key ":")) (first lines)) + (else (ev-ic-line (rest lines) key))))) + +(define + ev-ic-prefix? + (fn + (s p) + (and (>= (len s) (len p)) (= (substring s 0 (len p)) p)))) + +(define + ev-ic-run-all! + (fn + () + (do + (let + ((lines (ev/event->ical-lines (ev-event (quote one) (ev-dt 2026 6 10 14 0) 60 nil 1)))) + (do + (ev-ic-check! "VEVENT opens" (first lines) "BEGIN:VEVENT") + (ev-ic-check! "VEVENT closes" (ev-ic-line lines "END") "END:VEVENT") + (ev-ic-check! + "UID is the event id" + (ev-ic-line lines "UID") + "UID:one") + (ev-ic-check! + "DTSTART is a UTC basic-format stamp" + (ev-ic-line lines "DTSTART") + "DTSTART:20260610T140000Z") + (ev-ic-check! + "DURATION of 60m is PT1H" + (ev-ic-line lines "DURATION") + "DURATION:PT1H") + (ev-ic-check! + "a one-off event has no RRULE" + (ev-ic-line lines "RRULE") + nil))) + (ev-ic-check! + "30m duration is PT30M" + (ev-ic-line + (ev/event->ical-lines + (ev-event + (quote e) + (ev-dt 2026 1 1 9 0) + 30 + nil + 1)) + "DURATION") + "DURATION:PT30M") + (ev-ic-check! + "90m duration is PT1H30M" + (ev-ic-line + (ev/event->ical-lines + (ev-event + (quote e) + (ev-dt 2026 1 1 9 0) + 90 + nil + 1)) + "DURATION") + "DURATION:PT1H30M") + (let + ((lines (ev/event->ical-lines (ev-event-full (quote yoga) (ev-dt 2026 6 1 18 0) 90 {:interval 2 :freq :weekly :until (ev-dt 2026 6 30 23 0) :byday (list 0 2)} 20 (list (ev-dt 2026 6 8 18 0)) (list (ev-dt 2026 6 20 18 0)))))) + (do + (ev-ic-check! + "weekly RRULE serializes interval/until/byday in order" + (ev-ic-line lines "RRULE") + "RRULE:FREQ=WEEKLY;INTERVAL=2;UNTIL=20260630T230000Z;BYDAY=MO,WE") + (ev-ic-check! + "EXDATE line" + (ev-ic-line lines "EXDATE") + "EXDATE:20260608T180000Z") + (ev-ic-check! + "RDATE line" + (ev-ic-line lines "RDATE") + "RDATE:20260620T180000Z"))) + (ev-ic-check! + "daily COUNT RRULE" + (ev-ic-line + (ev/event->ical-lines + (ev-event + (quote d) + (ev-dt 2026 6 1 9 0) + 30 + {:freq :daily :count 5} + 1)) + "RRULE") + "RRULE:FREQ=DAILY;COUNT=5") + (ev-ic-check! + "monthly nth-weekday BYDAY (2nd Tuesday)" + (ev-ic-line + (ev/event->ical-lines + (ev-event + (quote b) + (ev-dt 2026 1 13 9 0) + 60 + {:freq :monthly :byday (list {:ord 2 :wd 1})} + 5)) + "RRULE") + "RRULE:FREQ=MONTHLY;BYDAY=2TU") + (ev-ic-check! + "monthly last-Friday BYDAY" + (ev-ic-line + (ev/event->ical-lines + (ev-event + (quote b) + (ev-dt 2026 1 30 9 0) + 60 + {:freq :monthly :byday (list {:ord -1 :wd 4})} + 5)) + "RRULE") + "RRULE:FREQ=MONTHLY;BYDAY=-1FR") + (ev-ic-check! + "monthly BYMONTHDAY (incl. negative)" + (ev-ic-line + (ev/event->ical-lines + (ev-event + (quote b) + (ev-dt 2026 1 15 9 0) + 60 + {:bymonthday (list 15 -1) :freq :monthly} + 5)) + "RRULE") + "RRULE:FREQ=MONTHLY;BYMONTHDAY=15,-1") + (ev-ic-check! + "all seven weekday tokens map correctly" + (ev-ic-line + (ev/event->ical-lines + (ev-event + (quote w) + (ev-dt 2026 6 1 9 0) + 30 + {:freq :weekly :byday (list 0 1 2 3 4 5 6)} + 1)) + "RRULE") + "RRULE:FREQ=WEEKLY;BYDAY=MO,TU,WE,TH,FR,SA,SU") + (let + ((cal (ev/events->ical-lines (list (ev-event (quote a) (ev-dt 2026 6 1 9 0) 30 nil 1) (ev-event (quote b) (ev-dt 2026 6 2 9 0) 30 nil 1))))) + (do + (ev-ic-check! "VCALENDAR opens" (first cal) "BEGIN:VCALENDAR") + (ev-ic-check! + "VCALENDAR declares VERSION" + (ev-ic-line cal "VERSION") + "VERSION:2.0") + (ev-ic-check! + "two events -> two VEVENT blocks" + (len (filter (fn (l) (= l "BEGIN:VEVENT")) cal)) + 2) + (ev-ic-check! + "VCALENDAR has exactly one closing line" + (len (filter (fn (l) (= l "END:VCALENDAR")) cal)) + 1))) + (ev-ic-check! + "render joins lines with CRLF" + (ev/ical-render + (list "BEGIN:VCALENDAR" "VERSION:2.0" "END:VCALENDAR")) + "BEGIN:VCALENDAR\r\nVERSION:2.0\r\nEND:VCALENDAR")))) + +(define + ev-ical-tests-run! + (fn + () + (do + (set! ev-ic-pass 0) + (set! ev-ic-fail 0) + (set! ev-ic-failures (list)) + (ev-ic-run-all!) + {:failures ev-ic-failures :total (+ ev-ic-pass ev-ic-fail) :passed ev-ic-pass :failed ev-ic-fail}))) diff --git a/plans/events-on-sx.md b/plans/events-on-sx.md index 0dcf2004..94a7da04 100644 --- 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` → **311/311** (Phases 1-4 + 10 ext: …timezones+DST, e2e delivery pipeline, cross-event conflict-checked booking) +`bash lib/events/conformance.sh` → **332/332** (Phases 1-4 + 11 ext: …e2e delivery, conflict-checked booking, iCalendar export) ## Ground rules @@ -88,6 +88,13 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── ## Progress log +- 2026-06-07 — iCalendar (RFC 5545) export (extension). `ical.sx` serializes + events to VEVENT / VCALENDAR text for import by standard clients. UTC + basic-format stamps (YYYYMMDDTHHMM00Z), DURATION (PT#H#M), and the full RRULE + model (FREQ/INTERVAL/COUNT/UNTIL/BYDAY incl. monthly ordinals "2TU"/"-1FR"/ + BYMONTHDAY) plus EXDATE/RDATE. Line-oriented: `ev/event->ical-lines` / + `ev/events->ical-lines` return content lines; `ev/ical-render` joins with + CRLF (wire format). +21 tests, 332/332 green. - 2026-06-07 — Cross-event conflict-checked booking (extension). Capacity is per-event, but `ev/book-checked!` also prevents an attendee double-booking THEMSELVES across different events: it consults the actor's persist-derived