events: RRULE EXDATE/RDATE exceptions + 8 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
ev-event-full carries :exdate/:rdate. ev-expand-base = raw expansion; ev-expand applies exceptions: RDATE adds in-window occurrences, EXDATE removes matching starts, de-duped, EXDATE wins over RDATE and the rrule (RFC 5545). RDATE-only events supported; plain ev-event unaffected. 248/248 green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -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.
|
||||
|
||||
Reference in New Issue
Block a user