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)
|
;; 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}))
|
(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)}))
|
(define ev-occ (fn (id start dur) {:id id :start start :end (+ start dur)}))
|
||||||
|
|
||||||
;; ---- DAILY expansion ----
|
;; ---- DAILY expansion ----
|
||||||
@@ -360,9 +374,10 @@
|
|||||||
n2)))))))))
|
n2)))))))))
|
||||||
|
|
||||||
;; ---- top-level expansion ----
|
;; ---- 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.
|
;; Returns a list of occurrence dicts {:id :start :end} within the window.
|
||||||
(define
|
(define
|
||||||
ev-expand
|
ev-expand-base
|
||||||
(fn
|
(fn
|
||||||
(event win-start win-end)
|
(event win-start win-end)
|
||||||
(let
|
(let
|
||||||
@@ -431,9 +446,75 @@
|
|||||||
win-end
|
win-end
|
||||||
acc
|
acc
|
||||||
0)))
|
0)))
|
||||||
(else (error (str "ev-expand: unsupported freq: " freq))))
|
(else (error (str "ev-expand-base: unsupported freq: " freq))))
|
||||||
acc))))))
|
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) ----
|
;; ---- multi-event expansion (sorted by start) ----
|
||||||
|
|
||||||
;; Insertion of one occurrence into a start-ascending list.
|
;; Insertion of one occurrence into a start-ascending list.
|
||||||
|
|||||||
@@ -1,10 +1,10 @@
|
|||||||
{
|
{
|
||||||
"lang": "events",
|
"lang": "events",
|
||||||
"total_passed": 240,
|
"total_passed": 248,
|
||||||
"total_failed": 0,
|
"total_failed": 0,
|
||||||
"total": 240,
|
"total": 248,
|
||||||
"suites": [
|
"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":"availability","passed":22,"failed":0,"total":22},
|
||||||
{"name":"api","passed":24,"failed":0,"total":24},
|
{"name":"api","passed":24,"failed":0,"total":24},
|
||||||
{"name":"booking","passed":82,"failed":0,"total":82},
|
{"name":"booking","passed":82,"failed":0,"total":82},
|
||||||
@@ -13,5 +13,5 @@
|
|||||||
{"name":"reminders","passed":14,"failed":0,"total":14},
|
{"name":"reminders","passed":14,"failed":0,"total":14},
|
||||||
{"name":"federation","passed":23,"failed":0,"total":23}
|
{"name":"federation","passed":23,"failed":0,"total":23}
|
||||||
],
|
],
|
||||||
"generated": "2026-06-07T05:59:03+00:00"
|
"generated": "2026-06-07T06:25:58+00:00"
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,10 +1,10 @@
|
|||||||
# events scoreboard
|
# events scoreboard
|
||||||
|
|
||||||
**240 / 240 passing** (0 failure(s)).
|
**248 / 248 passing** (0 failure(s)).
|
||||||
|
|
||||||
| Suite | Passed | Total | Status |
|
| Suite | Passed | Total | Status |
|
||||||
|-------|--------|-------|--------|
|
|-------|--------|-------|--------|
|
||||||
| calendar | 37 | 37 | ok |
|
| calendar | 45 | 45 | ok |
|
||||||
| availability | 22 | 22 | ok |
|
| availability | 22 | 22 | ok |
|
||||||
| api | 24 | 24 | ok |
|
| api | 24 | 24 | ok |
|
||||||
| booking | 82 | 82 | ok |
|
| booking | 82 | 82 | ok |
|
||||||
|
|||||||
@@ -421,6 +421,115 @@
|
|||||||
(list (quote a) (list 2026 6 2))
|
(list (quote a) (list 2026 6 2))
|
||||||
(list (quote a) (list 2026 6 3))))))))
|
(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
|
(define
|
||||||
ev-calendar-tests-run!
|
ev-calendar-tests-run!
|
||||||
(fn
|
(fn
|
||||||
@@ -430,4 +539,5 @@
|
|||||||
(set! ev-cal-fail 0)
|
(set! ev-cal-fail 0)
|
||||||
(set! ev-cal-failures (list))
|
(set! ev-cal-failures (list))
|
||||||
(ev-cal-run-all!)
|
(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})))
|
{:failures ev-cal-failures :total (+ ev-cal-pass ev-cal-fail) :passed ev-cal-pass :failed ev-cal-fail})))
|
||||||
|
|||||||
@@ -18,7 +18,7 @@ capacity rules, transactional booking, and a flow-driven notification dispatcher
|
|||||||
|
|
||||||
## Status (rolling)
|
## 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
|
## Ground rules
|
||||||
|
|
||||||
@@ -86,6 +86,13 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ──
|
|||||||
|
|
||||||
## Progress log
|
## 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
|
- 2026-06-07 — Waitlist + auto-promotion (extension). When an occurrence is
|
||||||
full, `ev/waitlist!` queues actors FIFO (:waitlist/:unwaitlist events on the
|
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
|
same stream; waiting fold is independent of the seat fold since taking a seat
|
||||||
|
|||||||
Reference in New Issue
Block a user