events: per-occurrence overrides / reschedule (RECURRENCE-ID) + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s

ev-with-override re-times/re-sizes a single instance of a series (keyed by
original start). ev-expand applies overrides after EXDATE/RDATE: agenda
re-sorts, instance moved out of window is dropped (slot vacated), no-op for a
non-occurring start. assoc for immutable event update. 254/254 green.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-06-07 06:52:02 +00:00
parent 48f5b75cc2
commit b308effb9f
5 changed files with 121 additions and 13 deletions

View File

@@ -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) ----