events: per-occurrence overrides / reschedule (RECURRENCE-ID) + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s
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:
@@ -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) ----
|
||||
|
||||
|
||||
Reference in New Issue
Block a user