events: availability.sx — free/busy + conflict detection on Datalog + 16 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m1s
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>
This commit is contained in:
247
lib/events/tests/availability.sx
Normal file
247
lib/events/tests/availability.sx
Normal file
@@ -0,0 +1,247 @@
|
||||
;; 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})))
|
||||
Reference in New Issue
Block a user