giles
540933bfca
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m1s
occurrence/booking EDB; rules busy/conflict (canonical pair, half-open overlap)/busy_in. API ev-busy, ev-conflicts, ev-has-conflict?, ev-free? (transient qwindow). Integrates with calendar expansion. 53/53 green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
248 lines
6.4 KiB
Plaintext
248 lines
6.4 KiB
Plaintext
;; lib/events/tests/availability.sx — free/busy + conflict rules on Datalog.
|
||
|
||
(define ev-av-pass 0)
|
||
(define ev-av-fail 0)
|
||
(define ev-av-failures (list))
|
||
|
||
(define
|
||
ev-av-check!
|
||
(fn
|
||
(name got expected)
|
||
(if
|
||
(= got expected)
|
||
(set! ev-av-pass (+ ev-av-pass 1))
|
||
(do
|
||
(set! ev-av-fail (+ ev-av-fail 1))
|
||
(append!
|
||
ev-av-failures
|
||
(str name "\n expected: " expected "\n got: " got))))))
|
||
|
||
;; Fixture: three occurrences on 2026-06-01.
|
||
;; standup 09:00–09:30 review 09:15–10:15 (overlaps standup)
|
||
;; lunch 12:00–13:00
|
||
(define
|
||
ev-av-occs
|
||
(fn
|
||
()
|
||
(list
|
||
(ev-occ
|
||
(quote standup)
|
||
(ev-dt 2026 6 1 9 0)
|
||
30)
|
||
(ev-occ
|
||
(quote review)
|
||
(ev-dt 2026 6 1 9 15)
|
||
60)
|
||
(ev-occ
|
||
(quote lunch)
|
||
(ev-dt 2026 6 1 12 0)
|
||
60))))
|
||
|
||
(define ev-av-key (fn (id start) (str id "@" start)))
|
||
|
||
;; alice: standup + review (overlap → conflict). bob: lunch only.
|
||
(define
|
||
ev-av-db
|
||
(fn
|
||
()
|
||
(ev-avail-db
|
||
(ev-av-occs)
|
||
(list
|
||
(list
|
||
(quote alice)
|
||
(ev-av-key
|
||
(quote standup)
|
||
(ev-dt 2026 6 1 9 0)))
|
||
(list
|
||
(quote alice)
|
||
(ev-av-key
|
||
(quote review)
|
||
(ev-dt 2026 6 1 9 15)))
|
||
(list
|
||
(quote bob)
|
||
(ev-av-key
|
||
(quote lunch)
|
||
(ev-dt 2026 6 1 12 0)))))))
|
||
|
||
(define
|
||
ev-av-run-all!
|
||
(fn
|
||
()
|
||
(let
|
||
((db (ev-av-db)))
|
||
(do
|
||
(ev-av-check!
|
||
"busy lists alice committed intervals ascending"
|
||
(ev-busy db (quote alice))
|
||
(list
|
||
(list
|
||
(ev-dt 2026 6 1 9 0)
|
||
(ev-dt 2026 6 1 9 30))
|
||
(list
|
||
(ev-dt 2026 6 1 9 15)
|
||
(ev-dt 2026 6 1 10 15))))
|
||
(ev-av-check!
|
||
"busy lists bob single interval"
|
||
(ev-busy db (quote bob))
|
||
(list
|
||
(list
|
||
(ev-dt 2026 6 1 12 0)
|
||
(ev-dt 2026 6 1 13 0))))
|
||
(ev-av-check!
|
||
"busy empty for unknown actor"
|
||
(ev-busy db (quote carol))
|
||
(list))
|
||
(ev-av-check!
|
||
"alice has an overlap conflict"
|
||
(ev-has-conflict? db (quote alice))
|
||
true)
|
||
(ev-av-check!
|
||
"alice conflict reported once (canonical pair)"
|
||
(len (ev-conflicts db (quote alice)))
|
||
1)
|
||
(ev-av-check!
|
||
"bob has no conflict"
|
||
(ev-has-conflict? db (quote bob))
|
||
false)
|
||
(ev-av-check!
|
||
"non-overlapping bookings do not conflict"
|
||
(ev-has-conflict?
|
||
(ev-avail-db
|
||
(list
|
||
(ev-occ
|
||
(quote a)
|
||
(ev-dt
|
||
2026
|
||
6
|
||
1
|
||
9
|
||
0)
|
||
30)
|
||
(ev-occ
|
||
(quote b)
|
||
(ev-dt
|
||
2026
|
||
6
|
||
1
|
||
9
|
||
30)
|
||
30))
|
||
(list
|
||
(list
|
||
(quote dave)
|
||
(ev-av-key
|
||
(quote a)
|
||
(ev-dt
|
||
2026
|
||
6
|
||
1
|
||
9
|
||
0)))
|
||
(list
|
||
(quote dave)
|
||
(ev-av-key
|
||
(quote b)
|
||
(ev-dt
|
||
2026
|
||
6
|
||
1
|
||
9
|
||
30)))))
|
||
(quote dave))
|
||
false)
|
||
(ev-av-check!
|
||
"alice free in an empty window"
|
||
(ev-free?
|
||
db
|
||
(quote alice)
|
||
(ev-dt 2026 6 1 13 0)
|
||
(ev-dt 2026 6 1 14 0))
|
||
true)
|
||
(ev-av-check!
|
||
"alice not free overlapping a booking"
|
||
(ev-free?
|
||
db
|
||
(quote alice)
|
||
(ev-dt 2026 6 1 9 20)
|
||
(ev-dt 2026 6 1 9 40))
|
||
false)
|
||
(ev-av-check!
|
||
"free? is half-open at the trailing edge"
|
||
(ev-free?
|
||
db
|
||
(quote alice)
|
||
(ev-dt 2026 6 1 10 15)
|
||
(ev-dt 2026 6 1 11 0))
|
||
true)
|
||
(ev-av-check!
|
||
"free? is half-open at the leading edge"
|
||
(ev-free?
|
||
db
|
||
(quote bob)
|
||
(ev-dt 2026 6 1 11 0)
|
||
(ev-dt 2026 6 1 12 0))
|
||
true)
|
||
(ev-av-check!
|
||
"free? false when window straddles a booking edge"
|
||
(ev-free?
|
||
db
|
||
(quote bob)
|
||
(ev-dt 2026 6 1 11 0)
|
||
(ev-dt 2026 6 1 12 1))
|
||
false)
|
||
(ev-av-check!
|
||
"free? query leaves db reusable (no leaked qwindow)"
|
||
(do
|
||
(ev-free?
|
||
db
|
||
(quote alice)
|
||
(ev-dt 2026 6 1 9 0)
|
||
(ev-dt 2026 6 1 9 30))
|
||
(ev-busy db (quote bob)))
|
||
(list
|
||
(list
|
||
(ev-dt 2026 6 1 12 0)
|
||
(ev-dt 2026 6 1 13 0))))
|
||
(let
|
||
((daily (ev-expand (ev-event (quote class) (ev-dt 2026 6 1 9 0) 60 {:freq :daily :count 3} 1) (ev-date 2026 6 1) (ev-date 2026 7 1))))
|
||
(let
|
||
((db2 (ev-avail-db daily (map (fn (o) (list (quote sam) (ev-occ-key o))) daily))))
|
||
(do
|
||
(ev-av-check!
|
||
"expanded daily occurrences become busy intervals"
|
||
(len (ev-busy db2 (quote sam)))
|
||
3)
|
||
(ev-av-check!
|
||
"no conflicts among disjoint daily occurrences"
|
||
(ev-has-conflict? db2 (quote sam))
|
||
false)
|
||
(ev-av-check!
|
||
"busy on day two of the series"
|
||
(ev-free?
|
||
db2
|
||
(quote sam)
|
||
(ev-dt
|
||
2026
|
||
6
|
||
2
|
||
9
|
||
30)
|
||
(ev-dt
|
||
2026
|
||
6
|
||
2
|
||
9
|
||
45))
|
||
false))))))))
|
||
|
||
(define
|
||
ev-availability-tests-run!
|
||
(fn
|
||
()
|
||
(do
|
||
(set! ev-av-pass 0)
|
||
(set! ev-av-fail 0)
|
||
(set! ev-av-failures (list))
|
||
(ev-av-run-all!)
|
||
{:failures ev-av-failures :total (+ ev-av-pass ev-av-fail) :passed ev-av-pass :failed ev-av-fail})))
|