diff --git a/lib/events/calendar.sx b/lib/events/calendar.sx index b1a5fafe..2e7ed0aa 100644 --- a/lib/events/calendar.sx +++ b/lib/events/calendar.sx @@ -503,17 +503,69 @@ (append base rdate-occs)))) (ev-dedupe-by-start (ev-sort-occs no-ex))))))) +;; ---- per-occurrence overrides (RFC 5545 RECURRENCE-ID) ---- +;; A single instance of a recurring series can be detached and rescheduled. The +;; event carries :overrides — a list of (orig-start {:start :duration}) — keyed +;; by the occurrence's ORIGINAL start. Applied after EXDATE/RDATE. A moved +;; instance whose new start leaves the window is dropped from this window (the +;; original slot is vacated); an instance moved INTO the window from outside is +;; out of scope for a windowed expansion (known stub limitation). + +(define + ev-assoc-lookup + (fn + (k pairs) + (cond + ((empty? pairs) nil) + ((= (first (first pairs)) k) (first (rest (first pairs)))) + (else (ev-assoc-lookup k (rest pairs)))))) + +(define + ev-apply-overrides + (fn + (id base overrides) + (map + (fn + (o) + (let + ((ov (ev-assoc-lookup (get o :start) overrides))) + (if (nil? ov) o (ev-occ id (get ov :start) (get ov :duration))))) + base))) + +;; Add an override that reschedules the occurrence originally at `orig-start` +;; to `new-start` with `new-duration`. +(define + ev-with-override + (fn + (event orig-start new-start new-duration) + (assoc + event + :overrides + (cons + (list orig-start {:start new-start :duration new-duration}) + (ev-or (get event :overrides) (list)))))) + ;; Expand an event into occurrence dicts within the window, applying any -;; EXDATE/RDATE exceptions. This is the public entry point. +;; EXDATE/RDATE exceptions and per-occurrence overrides. 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))) + (let + ((excepted + (ev-apply-exceptions + event + (ev-expand-base event win-start win-end) + win-start + win-end)) + (overrides (ev-or (get event :overrides) (list))) + (id (get event :id))) + (if + (empty? overrides) + excepted + (filter + (fn (o) (and (>= (get o :start) win-start) (<= (get o :start) win-end))) + (ev-sort-occs (ev-apply-overrides id excepted overrides))))))) ;; ---- multi-event expansion (sorted by start) ---- diff --git a/lib/events/scoreboard.json b/lib/events/scoreboard.json index 01d99c32..b0b8558a 100644 --- a/lib/events/scoreboard.json +++ b/lib/events/scoreboard.json @@ -1,10 +1,10 @@ { "lang": "events", - "total_passed": 248, + "total_passed": 254, "total_failed": 0, - "total": 248, + "total": 254, "suites": [ - {"name":"calendar","passed":45,"failed":0,"total":45}, + {"name":"calendar","passed":51,"failed":0,"total":51}, {"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-07T06:25:58+00:00" + "generated": "2026-06-07T06:51:44+00:00" } diff --git a/lib/events/scoreboard.md b/lib/events/scoreboard.md index c1517e72..806c25fe 100644 --- a/lib/events/scoreboard.md +++ b/lib/events/scoreboard.md @@ -1,10 +1,10 @@ # events scoreboard -**248 / 248 passing** (0 failure(s)). +**254 / 254 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| -| calendar | 45 | 45 | ok | +| calendar | 51 | 51 | 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 a65980c4..c0d2e81f 100644 --- a/lib/events/tests/calendar.sx +++ b/lib/events/tests/calendar.sx @@ -530,6 +530,54 @@ (len (ev-expand plain (ev-date 2026 6 1) (ev-date 2026 7 1))) 3))))) +;; ---- per-occurrence overrides (reschedule one instance) ---- +(define + ev-cal-ov-run-all! + (fn + () + (let + ((base (ev-event (quote standup) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 4} 1))) + (do + ;; reschedule one instance to a new time + duration + (let + ((moved (ev-with-override base (ev-dt 2026 6 2 9 0) (ev-dt 2026 6 2 14 0) 45))) + (let + ((occs (ev-expand moved (ev-date 2026 6 1) (ev-date 2026 6 5)))) + (do + (ev-cal-check! + "override moves only the targeted instance" + (map (fn (o) (ev-dt-tod (get o :start))) occs) + (list 540 840 540 540)) + (ev-cal-check! + "override applies the new duration" + (map (fn (o) (- (get o :end) (get o :start))) occs) + (list 30 45 30 30)) + (ev-cal-check! + "override keeps the series length" + (len occs) + 4)))) + ;; an instance moved out of the window vacates its slot + (let + ((movedout (ev-with-override base (ev-dt 2026 6 2 9 0) (ev-dt 2026 6 20 9 0) 30))) + (ev-cal-check! + "instance moved out of window is dropped, slot vacated" + (ev-cal-starts (ev-expand movedout (ev-date 2026 6 1) (ev-date 2026 6 5))) + (list (list 2026 6 1) (list 2026 6 3) (list 2026 6 4)))) + ;; override for a non-existent original start is a no-op + (let + ((noop (ev-with-override base (ev-dt 2026 6 9 9 0) (ev-dt 2026 6 9 14 0) 45))) + (ev-cal-check! + "override for a non-occurring start is a no-op" + (len (ev-expand noop (ev-date 2026 6 1) (ev-date 2026 6 5))) + 4)) + ;; overrides re-sort the agenda when an instance moves earlier + (let + ((early (ev-with-override base (ev-dt 2026 6 3 9 0) (ev-dt 2026 6 1 7 0) 30))) + (ev-cal-check! + "an instance moved earlier re-sorts into place" + (map (fn (o) (ev-dt-tod (get o :start))) (ev-expand early (ev-date 2026 6 1) (ev-date 2026 6 5))) + (list 420 540 540 540))))))) + (define ev-calendar-tests-run! (fn @@ -540,4 +588,5 @@ (set! ev-cal-failures (list)) (ev-cal-run-all!) (ev-cal-ex-run-all!) + (ev-cal-ov-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 23257384..b91d2d95 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` → **248/248** (Phases 1-4 + ext: fed free/busy, waitlist, EXDATE/RDATE) +`bash lib/events/conformance.sh` → **254/254** (Phases 1-4 + ext: fed free/busy, waitlist, EXDATE/RDATE, overrides) ## Ground rules @@ -86,6 +86,13 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── ## Progress log +- 2026-06-07 — Per-occurrence overrides / reschedule (RFC 5545 RECURRENCE-ID). + `ev-with-override event orig-start new-start new-duration` adds an :overrides + entry keyed by the occurrence's original start. `ev-expand` applies overrides + after EXDATE/RDATE: a targeted instance is re-timed/re-sized and the agenda + re-sorted; an instance moved out of the window is dropped (slot vacated); + override of a non-occurring start is a no-op. Used `assoc` for immutable + event update. +6 tests, 254/254 green. - 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