diff --git a/lib/events/calendar.sx b/lib/events/calendar.sx index cc65f7ff..b1a5fafe 100644 --- a/lib/events/calendar.sx +++ b/lib/events/calendar.sx @@ -140,6 +140,20 @@ ;; monthly :bymonthday -> (list 15 -1) day of month (negative from end) (define ev-event (fn (id dtstart duration rrule capacity) {:duration duration :id id :dtstart dtstart :capacity capacity :rrule rrule})) +;; Event with EXDATE/RDATE exceptions. exdate/rdate are lists of epoch-minute +;; starts to exclude from / add to the expansion (RFC 5545 VEVENT properties). +(define + ev-event-full + (fn + (id dtstart duration rrule capacity exdate rdate) + {:duration duration + :id id + :dtstart dtstart + :capacity capacity + :rrule rrule + :exdate exdate + :rdate rdate})) + (define ev-occ (fn (id start dur) {:id id :start start :end (+ start dur)})) ;; ---- DAILY expansion ---- @@ -360,9 +374,10 @@ n2))))))))) ;; ---- top-level expansion ---- +;; Raw expansion (RRULE / single event), before EXDATE/RDATE are applied. ;; Returns a list of occurrence dicts {:id :start :end} within the window. (define - ev-expand + ev-expand-base (fn (event win-start win-end) (let @@ -431,9 +446,75 @@ win-end acc 0))) - (else (error (str "ev-expand: unsupported freq: " freq)))) + (else (error (str "ev-expand-base: unsupported freq: " freq)))) acc)))))) +;; ---- EXDATE / RDATE (RFC 5545 exceptions) ---- +;; Applied AFTER raw expansion: RDATE adds explicit occurrences within the +;; window, EXDATE removes occurrences whose start matches (EXDATE wins over +;; RDATE). Both are VEVENT-level: (get event :exdate) / (get event :rdate) are +;; lists of epoch-minute starts; nil for plain events. + +(define + ev-num-member? + (fn + (n xs) + (cond + ((empty? xs) false) + ((= n (first xs)) true) + (else (ev-num-member? n (rest xs)))))) + +;; Drop duplicate-start occurrences from a start-sorted list (keep one). +(define + ev-dedupe-by-start + (fn + (occs) + (cond + ((empty? occs) occs) + ((empty? (rest occs)) occs) + ((= (get (first occs) :start) (get (first (rest occs)) :start)) + (ev-dedupe-by-start (rest occs))) + (else (cons (first occs) (ev-dedupe-by-start (rest occs))))))) + +(define + ev-apply-exceptions + (fn + (event base win-start win-end) + (let + ((id (get event :id)) + (duration (get event :duration)) + (exdate (ev-or (get event :exdate) (list))) + (rdate (ev-or (get event :rdate) (list)))) + (let + ((rdate-occs + (reduce + (fn + (acc d) + (if + (and (>= d win-start) (<= d win-end)) + (cons (ev-occ id d duration) acc) + acc)) + (list) + rdate))) + (let + ((no-ex + (filter + (fn (o) (not (ev-num-member? (get o :start) exdate))) + (append base rdate-occs)))) + (ev-dedupe-by-start (ev-sort-occs no-ex))))))) + +;; Expand an event into occurrence dicts within the window, applying any +;; EXDATE/RDATE exceptions. This is the public entry point. +(define + ev-expand + (fn + (event win-start win-end) + (ev-apply-exceptions + event + (ev-expand-base event win-start win-end) + win-start + win-end))) + ;; ---- multi-event expansion (sorted by start) ---- ;; Insertion of one occurrence into a start-ascending list. diff --git a/lib/events/scoreboard.json b/lib/events/scoreboard.json index 5c0a02e1..01d99c32 100644 --- a/lib/events/scoreboard.json +++ b/lib/events/scoreboard.json @@ -1,10 +1,10 @@ { "lang": "events", - "total_passed": 240, + "total_passed": 248, "total_failed": 0, - "total": 240, + "total": 248, "suites": [ - {"name":"calendar","passed":37,"failed":0,"total":37}, + {"name":"calendar","passed":45,"failed":0,"total":45}, {"name":"availability","passed":22,"failed":0,"total":22}, {"name":"api","passed":24,"failed":0,"total":24}, {"name":"booking","passed":82,"failed":0,"total":82}, @@ -13,5 +13,5 @@ {"name":"reminders","passed":14,"failed":0,"total":14}, {"name":"federation","passed":23,"failed":0,"total":23} ], - "generated": "2026-06-07T05:59:03+00:00" + "generated": "2026-06-07T06:25:58+00:00" } diff --git a/lib/events/scoreboard.md b/lib/events/scoreboard.md index 3e85f60c..c1517e72 100644 --- a/lib/events/scoreboard.md +++ b/lib/events/scoreboard.md @@ -1,10 +1,10 @@ # events scoreboard -**240 / 240 passing** (0 failure(s)). +**248 / 248 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| -| calendar | 37 | 37 | ok | +| calendar | 45 | 45 | ok | | availability | 22 | 22 | ok | | api | 24 | 24 | ok | | booking | 82 | 82 | ok | diff --git a/lib/events/tests/calendar.sx b/lib/events/tests/calendar.sx index e679398e..a65980c4 100644 --- a/lib/events/tests/calendar.sx +++ b/lib/events/tests/calendar.sx @@ -421,6 +421,115 @@ (list (quote a) (list 2026 6 2)) (list (quote a) (list 2026 6 3)))))))) +;; ---- EXDATE / RDATE exceptions ---- +(define + ev-cal-ex-run-all! + (fn + () + (do + ;; EXDATE removes a matching occurrence from the recurrence + (let + ((ex + (ev-event-full + (quote standup) + (ev-dt 2026 6 1 9 0) + 30 + {:freq :daily :count 5} + 1 + (list (ev-dt 2026 6 3 9 0)) + (list)))) + (ev-cal-check! + "EXDATE excludes the matching occurrence" + (ev-cal-starts (ev-expand ex (ev-date 2026 6 1) (ev-date 2026 7 1))) + (list (list 2026 6 1) (list 2026 6 2) (list 2026 6 4) (list 2026 6 5)))) + ;; EXDATE that matches nothing is a no-op + (let + ((ex2 + (ev-event-full + (quote s) + (ev-dt 2026 6 1 9 0) + 30 + {:freq :daily :count 3} + 1 + (list (ev-dt 2026 6 9 9 0)) + (list)))) + (ev-cal-check! + "EXDATE not matching any occurrence is a no-op" + (len (ev-expand ex2 (ev-date 2026 6 1) (ev-date 2026 7 1))) + 3)) + ;; RDATE adds an explicit occurrence (within the window) + (let + ((rd + (ev-event-full + (quote s) + (ev-dt 2026 6 1 9 0) + 30 + {:freq :daily :count 3} + 1 + (list) + (list (ev-dt 2026 6 10 9 0))))) + (do + (ev-cal-check! + "RDATE adds an explicit occurrence, sorted in" + (ev-cal-starts (ev-expand rd (ev-date 2026 6 1) (ev-date 2026 7 1))) + (list (list 2026 6 1) (list 2026 6 2) (list 2026 6 3) (list 2026 6 10))) + (ev-cal-check! + "RDATE outside the window is dropped" + (len (ev-expand rd (ev-date 2026 6 1) (ev-date 2026 6 5))) + 3))) + ;; RDATE coinciding with an rrule occurrence is de-duplicated + (let + ((rdup + (ev-event-full + (quote s) + (ev-dt 2026 6 1 9 0) + 30 + {:freq :daily :count 3} + 1 + (list) + (list (ev-dt 2026 6 2 9 0))))) + (ev-cal-check! + "RDATE duplicating an occurrence does not double it" + (len (ev-expand rdup (ev-date 2026 6 1) (ev-date 2026 7 1))) + 3)) + ;; EXDATE wins over RDATE for the same datetime + (let + ((both + (ev-event-full + (quote s) + (ev-dt 2026 6 1 9 0) + 30 + {:freq :daily :count 3} + 1 + (list (ev-dt 2026 6 2 9 0)) + (list (ev-dt 2026 6 2 9 0))))) + (ev-cal-check! + "EXDATE wins over RDATE and the rrule for the same date" + (ev-cal-starts (ev-expand both (ev-date 2026 6 1) (ev-date 2026 7 1))) + (list (list 2026 6 1) (list 2026 6 3)))) + ;; RDATE-only event (no rrule) + (let + ((ronly + (ev-event-full + (quote s) + (ev-dt 2026 6 1 9 0) + 30 + nil + 1 + (list) + (list (ev-dt 2026 6 5 9 0) (ev-dt 2026 6 3 9 0))))) + (ev-cal-check! + "RDATE-only event yields dtstart plus the extra dates, sorted" + (ev-cal-starts (ev-expand ronly (ev-date 2026 6 1) (ev-date 2026 7 1))) + (list (list 2026 6 1) (list 2026 6 3) (list 2026 6 5)))) + ;; plain ev-event (no exception keys) is unaffected + (let + ((plain (ev-event (quote p) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 3} 1))) + (ev-cal-check! + "plain event without exceptions expands unchanged" + (len (ev-expand plain (ev-date 2026 6 1) (ev-date 2026 7 1))) + 3))))) + (define ev-calendar-tests-run! (fn @@ -430,4 +539,5 @@ (set! ev-cal-fail 0) (set! ev-cal-failures (list)) (ev-cal-run-all!) + (ev-cal-ex-run-all!) {:failures ev-cal-failures :total (+ ev-cal-pass ev-cal-fail) :passed ev-cal-pass :failed ev-cal-fail}))) diff --git a/plans/events-on-sx.md b/plans/events-on-sx.md index 1bdf8742..23257384 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` → **240/240** (Phases 1-4 + ext: federated free/busy, waitlist) +`bash lib/events/conformance.sh` → **248/248** (Phases 1-4 + ext: fed free/busy, waitlist, EXDATE/RDATE) ## Ground rules @@ -86,6 +86,13 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── ## Progress log +- 2026-06-07 — RRULE exceptions EXDATE/RDATE (extension). `ev-event-full` + carries :exdate/:rdate (epoch-minute starts). Raw expansion renamed + `ev-expand-base`; `ev-expand` now applies exceptions: RDATE adds explicit + in-window occurrences, EXDATE removes matching starts, duplicates de-duped, + EXDATE wins over RDATE and the rrule (RFC 5545). RDATE-only events (no rrule) + supported. Plain `ev-event` (no exception keys) unaffected. +8 tests, + 248/248 green. - 2026-06-07 — Waitlist + auto-promotion (extension). When an occurrence is full, `ev/waitlist!` queues actors FIFO (:waitlist/:unwaitlist events on the same stream; waiting fold is independent of the seat fold since taking a seat