giles
48f5b75cc2
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>
544 lines
16 KiB
Plaintext
544 lines
16 KiB
Plaintext
;; lib/events/tests/calendar.sx — civil date core + RRULE window expansion.
|
|
|
|
(define ev-cal-pass 0)
|
|
(define ev-cal-fail 0)
|
|
(define ev-cal-failures (list))
|
|
|
|
(define
|
|
ev-cal-check!
|
|
(fn
|
|
(name got expected)
|
|
(if
|
|
(= got expected)
|
|
(set! ev-cal-pass (+ ev-cal-pass 1))
|
|
(do
|
|
(set! ev-cal-fail (+ ev-cal-fail 1))
|
|
(append!
|
|
ev-cal-failures
|
|
(str name "\n expected: " expected "\n got: " got))))))
|
|
|
|
;; Project occurrences to (civil weekday) pairs for legible assertions.
|
|
(define
|
|
ev-cal-shape
|
|
(fn
|
|
(occs)
|
|
(map
|
|
(fn
|
|
(o)
|
|
(list (ev-dt->civil (get o :start)) (ev-dt-weekday (get o :start))))
|
|
occs)))
|
|
|
|
(define
|
|
ev-cal-starts
|
|
(fn (occs) (map (fn (o) (ev-dt->civil (get o :start))) occs)))
|
|
|
|
(define
|
|
ev-cal-run-all!
|
|
(fn
|
|
()
|
|
(do
|
|
(ev-cal-check!
|
|
"epoch day zero"
|
|
(ev-days-from-civil 1970 1 1)
|
|
0)
|
|
(ev-cal-check!
|
|
"y2k day number"
|
|
(ev-days-from-civil 2000 1 1)
|
|
10957)
|
|
(ev-cal-check!
|
|
"leap day round trip"
|
|
(ev-civil-from-days
|
|
(ev-days-from-civil 2024 2 29))
|
|
(list 2024 2 29))
|
|
(ev-cal-check!
|
|
"pre-epoch round trip"
|
|
(ev-civil-from-days
|
|
(ev-days-from-civil 1969 12 31))
|
|
(list 1969 12 31))
|
|
(ev-cal-check!
|
|
"epoch is thursday"
|
|
(ev-weekday-of-days 0)
|
|
3)
|
|
(ev-cal-check!
|
|
"2026-06-06 is saturday"
|
|
(ev-dt-weekday (ev-date 2026 6 6))
|
|
5)
|
|
(ev-cal-check!
|
|
"dt carries time of day"
|
|
(ev-dt-tod
|
|
(ev-dt 2026 6 1 9 30))
|
|
570)
|
|
(ev-cal-check!
|
|
"civil from dt"
|
|
(ev-dt->civil
|
|
(ev-dt 2026 12 25 8 0))
|
|
(list 2026 12 25))
|
|
(ev-cal-check!
|
|
"days in feb 2024 (leap)"
|
|
(ev-days-in-month 2024 2)
|
|
29)
|
|
(ev-cal-check!
|
|
"days in feb 2026"
|
|
(ev-days-in-month 2026 2)
|
|
28)
|
|
(ev-cal-check!
|
|
"add months wraps year"
|
|
(ev-add-months 2026 11 3)
|
|
(list 2027 2))
|
|
(ev-cal-check!
|
|
"add months within year"
|
|
(ev-add-months 2026 1 5)
|
|
(list 2026 6))
|
|
(let
|
|
((ev (ev-event (quote one) (ev-dt 2026 6 10 14 0) 60 nil 1)))
|
|
(do
|
|
(ev-cal-check!
|
|
"single inside window emits once"
|
|
(len
|
|
(ev-expand
|
|
ev
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 7 1)))
|
|
1)
|
|
(ev-cal-check!
|
|
"single before window omitted"
|
|
(len
|
|
(ev-expand
|
|
ev
|
|
(ev-date 2026 7 1)
|
|
(ev-date 2026 8 1)))
|
|
0)
|
|
(ev-cal-check!
|
|
"single after window omitted"
|
|
(len
|
|
(ev-expand
|
|
ev
|
|
(ev-date 2026 1 1)
|
|
(ev-date 2026 2 1)))
|
|
0)
|
|
(ev-cal-check!
|
|
"occurrence end is start plus duration"
|
|
(get
|
|
(first
|
|
(ev-expand
|
|
ev
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 7 1)))
|
|
:end)
|
|
(+
|
|
(ev-dt 2026 6 10 14 0)
|
|
60))))
|
|
(let
|
|
((daily (ev-event (quote d) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 5} 1)))
|
|
(do
|
|
(ev-cal-check!
|
|
"daily count caps occurrences"
|
|
(ev-cal-starts
|
|
(ev-expand
|
|
daily
|
|
(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 4)
|
|
(list 2026 6 5)))
|
|
(ev-cal-check!
|
|
"daily preserves time of day"
|
|
(ev-dt-tod
|
|
(get
|
|
(first
|
|
(ev-expand
|
|
daily
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 7 1)))
|
|
:start))
|
|
540)))
|
|
(let
|
|
((di (ev-event (quote di) (ev-dt 2026 6 1 0 0) 30 {:interval 3 :freq :daily :until (ev-date 2026 6 30)} 1)))
|
|
(ev-cal-check!
|
|
"daily interval 3 steps by three days"
|
|
(ev-cal-starts
|
|
(ev-expand
|
|
di
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 6 13)))
|
|
(list
|
|
(list 2026 6 1)
|
|
(list 2026 6 4)
|
|
(list 2026 6 7)
|
|
(list 2026 6 10)
|
|
(list 2026 6 13))))
|
|
(let
|
|
((dc (ev-event (quote dc) (ev-dt 2026 6 1 0 0) 30 {:freq :daily :count 10} 1)))
|
|
(ev-cal-check!
|
|
"count is window-independent (clip middle)"
|
|
(ev-cal-starts
|
|
(ev-expand
|
|
dc
|
|
(ev-date 2026 6 5)
|
|
(ev-date 2026 6 8)))
|
|
(list
|
|
(list 2026 6 5)
|
|
(list 2026 6 6)
|
|
(list 2026 6 7)
|
|
(list 2026 6 8))))
|
|
(let
|
|
((dc2 (ev-event (quote dc2) (ev-dt 2026 6 1 0 0) 30 {:freq :daily :count 3} 1)))
|
|
(ev-cal-check!
|
|
"count exhausted before window yields nothing"
|
|
(len
|
|
(ev-expand
|
|
dc2
|
|
(ev-date 2026 6 10)
|
|
(ev-date 2026 6 20)))
|
|
0))
|
|
(let
|
|
((wk (ev-event (quote w) (ev-dt 2026 6 1 18 0) 90 {:freq :weekly :byday (list 0 2 4)} 1)))
|
|
(ev-cal-check!
|
|
"weekly byday mon/wed/fri first two weeks"
|
|
(ev-cal-shape
|
|
(ev-expand
|
|
wk
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 6 13)))
|
|
(list
|
|
(list (list 2026 6 1) 0)
|
|
(list (list 2026 6 3) 2)
|
|
(list (list 2026 6 5) 4)
|
|
(list (list 2026 6 8) 0)
|
|
(list (list 2026 6 10) 2)
|
|
(list (list 2026 6 12) 4))))
|
|
(let
|
|
((wu (ev-event (quote wu) (ev-dt 2026 6 1 18 0) 90 {:freq :weekly :until (ev-dt 2026 6 10 23 0) :byday (list 0 2)} 1)))
|
|
(ev-cal-check!
|
|
"weekly until clips trailing occurrences"
|
|
(ev-cal-starts
|
|
(ev-expand
|
|
wu
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 7 1)))
|
|
(list
|
|
(list 2026 6 1)
|
|
(list 2026 6 3)
|
|
(list 2026 6 8)
|
|
(list 2026 6 10))))
|
|
(let
|
|
((wi (ev-event (quote wi) (ev-dt 2026 6 1 18 0) 90 {:interval 2 :freq :weekly :byday (list 0)} 1)))
|
|
(ev-cal-check!
|
|
"weekly interval 2 skips alternate weeks"
|
|
(ev-cal-starts
|
|
(ev-expand
|
|
wi
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 7 6)))
|
|
(list
|
|
(list 2026 6 1)
|
|
(list 2026 6 15)
|
|
(list 2026 6 29))))
|
|
(let
|
|
((wd (ev-event (quote wd) (ev-dt 2026 6 3 12 0) 60 {:freq :weekly :count 3} 1)))
|
|
(ev-cal-check!
|
|
"weekly default byday is dtstart weekday"
|
|
(ev-cal-shape
|
|
(ev-expand
|
|
wd
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 8 1)))
|
|
(list
|
|
(list (list 2026 6 3) 2)
|
|
(list (list 2026 6 10) 2)
|
|
(list (list 2026 6 17) 2))))
|
|
(let
|
|
((wc (ev-event (quote wc) (ev-dt 2026 6 1 18 0) 90 {:freq :weekly :count 10 :byday (list 0 2)} 1)))
|
|
(ev-cal-check!
|
|
"weekly count window-independent (clip middle)"
|
|
(ev-cal-starts
|
|
(ev-expand
|
|
wc
|
|
(ev-date 2026 6 15)
|
|
(ev-date 2026 7 5)))
|
|
(list
|
|
(list 2026 6 15)
|
|
(list 2026 6 17)
|
|
(list 2026 6 22)
|
|
(list 2026 6 24)
|
|
(list 2026 6 29)
|
|
(list 2026 7 1))))
|
|
(let
|
|
((wf (ev-event (quote wf) (ev-dt 2026 6 3 18 0) 90 {:freq :weekly :count 4 :byday (list 0 2 4)} 1)))
|
|
(ev-cal-check!
|
|
"first week skips byday earlier than dtstart"
|
|
(ev-cal-starts
|
|
(ev-expand
|
|
wf
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 7 1)))
|
|
(list
|
|
(list 2026 6 3)
|
|
(list 2026 6 5)
|
|
(list 2026 6 8)
|
|
(list 2026 6 10))))
|
|
(let
|
|
((md (ev-event (quote md) (ev-dt 2026 1 15 9 0) 60 {:bymonthday (list 15) :freq :monthly} 1)))
|
|
(do
|
|
(ev-cal-check!
|
|
"monthly bymonthday 15th"
|
|
(ev-cal-starts
|
|
(ev-expand
|
|
md
|
|
(ev-date 2026 1 1)
|
|
(ev-date 2026 4 1)))
|
|
(list
|
|
(list 2026 1 15)
|
|
(list 2026 2 15)
|
|
(list 2026 3 15)))
|
|
(ev-cal-check!
|
|
"monthly preserves time of day"
|
|
(ev-dt-tod
|
|
(get
|
|
(first
|
|
(ev-expand
|
|
md
|
|
(ev-date 2026 1 1)
|
|
(ev-date 2026 4 1)))
|
|
:start))
|
|
540)))
|
|
(let
|
|
((mm (ev-event (quote mm) (ev-dt 2026 1 1 9 0) 60 {:bymonthday (list 1 15) :freq :monthly :count 4} 1)))
|
|
(ev-cal-check!
|
|
"monthly multiple bymonthday sorted within month"
|
|
(ev-cal-starts
|
|
(ev-expand
|
|
mm
|
|
(ev-date 2026 1 1)
|
|
(ev-date 2026 12 1)))
|
|
(list
|
|
(list 2026 1 1)
|
|
(list 2026 1 15)
|
|
(list 2026 2 1)
|
|
(list 2026 2 15))))
|
|
(let
|
|
((ml (ev-event (quote ml) (ev-dt 2026 1 31 9 0) 60 {:bymonthday (list -1) :freq :monthly} 1)))
|
|
(ev-cal-check!
|
|
"monthly bymonthday -1 is last day"
|
|
(ev-cal-starts
|
|
(ev-expand
|
|
ml
|
|
(ev-date 2026 1 1)
|
|
(ev-date 2026 4 1)))
|
|
(list
|
|
(list 2026 1 31)
|
|
(list 2026 2 28)
|
|
(list 2026 3 31))))
|
|
(let
|
|
((mn (ev-event (quote mn) (ev-dt 2026 1 1 9 0) 60 {:freq :monthly :byday (list {:ord 2 :wd 1})} 1)))
|
|
(ev-cal-check!
|
|
"monthly 2nd tuesday"
|
|
(ev-cal-shape
|
|
(ev-expand
|
|
mn
|
|
(ev-date 2026 1 1)
|
|
(ev-date 2026 4 1)))
|
|
(list
|
|
(list (list 2026 1 13) 1)
|
|
(list (list 2026 2 10) 1)
|
|
(list (list 2026 3 10) 1))))
|
|
(let
|
|
((mz (ev-event (quote mz) (ev-dt 2026 1 1 9 0) 60 {:freq :monthly :byday (list {:ord -1 :wd 4})} 1)))
|
|
(ev-cal-check!
|
|
"monthly last friday"
|
|
(ev-cal-shape
|
|
(ev-expand
|
|
mz
|
|
(ev-date 2026 1 1)
|
|
(ev-date 2026 4 1)))
|
|
(list
|
|
(list (list 2026 1 30) 4)
|
|
(list (list 2026 2 27) 4)
|
|
(list (list 2026 3 27) 4))))
|
|
(let
|
|
((m31 (ev-event (quote m31) (ev-dt 2026 1 31 9 0) 60 {:freq :monthly :count 4} 1)))
|
|
(ev-cal-check!
|
|
"monthly default day-of-month skips short months"
|
|
(ev-cal-starts
|
|
(ev-expand
|
|
m31
|
|
(ev-date 2026 1 1)
|
|
(ev-date 2026 12 1)))
|
|
(list
|
|
(list 2026 1 31)
|
|
(list 2026 3 31)
|
|
(list 2026 5 31)
|
|
(list 2026 7 31))))
|
|
(let
|
|
((mi (ev-event (quote mi) (ev-dt 2026 1 10 9 0) 60 {:interval 3 :freq :monthly :count 3} 1)))
|
|
(ev-cal-check!
|
|
"monthly interval 3 steps by quarter"
|
|
(ev-cal-starts
|
|
(ev-expand
|
|
mi
|
|
(ev-date 2026 1 1)
|
|
(ev-date 2027 1 1)))
|
|
(list
|
|
(list 2026 1 10)
|
|
(list 2026 4 10)
|
|
(list 2026 7 10))))
|
|
(let
|
|
((mc (ev-event (quote mc) (ev-dt 2026 1 5 9 0) 60 {:freq :monthly :count 12} 1)))
|
|
(ev-cal-check!
|
|
"monthly count window-independent (clip middle)"
|
|
(ev-cal-starts
|
|
(ev-expand
|
|
mc
|
|
(ev-date 2026 4 1)
|
|
(ev-date 2026 6 30)))
|
|
(list
|
|
(list 2026 4 5)
|
|
(list 2026 5 5)
|
|
(list 2026 6 5))))
|
|
(let
|
|
((a (ev-event (quote a) (ev-dt 2026 6 2 10 0) 30 {:freq :daily :count 2} 1))
|
|
(b
|
|
(ev-event
|
|
(quote b)
|
|
(ev-dt 2026 6 1 9 0)
|
|
30
|
|
{:freq :daily :count 2}
|
|
1)))
|
|
(ev-cal-check!
|
|
"expand-all sorts merged occurrences by start"
|
|
(map
|
|
(fn (o) (list (get o :id) (ev-dt->civil (get o :start))))
|
|
(ev-expand-all
|
|
(list a b)
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 7 1)))
|
|
(list
|
|
(list (quote b) (list 2026 6 1))
|
|
(list (quote b) (list 2026 6 2))
|
|
(list (quote a) (list 2026 6 2))
|
|
(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
|
|
ev-calendar-tests-run!
|
|
(fn
|
|
()
|
|
(do
|
|
(set! ev-cal-pass 0)
|
|
(set! ev-cal-fail 0)
|
|
(set! ev-cal-failures (list))
|
|
(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})))
|