;; 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))))))) ;; Disjoint fixture for slot search: 09:00–10:00 then 10:30–11:30 (a 30m gap). (define ev-av-gap-db (fn () (ev-avail-db (list (ev-occ (quote a) (ev-dt 2026 6 1 9 0) 60) (ev-occ (quote b) (ev-dt 2026 6 1 10 30) 60)) (list (list (quote sam) (ev-av-key (quote a) (ev-dt 2026 6 1 9 0))) (list (quote sam) (ev-av-key (quote b) (ev-dt 2026 6 1 10 30))))))) (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 ((gdb (ev-av-gap-db))) (do (ev-av-check! "next-free finds the gap between bookings" (ev-next-free gdb (quote sam) (ev-dt 2026 6 1 9 0) 30 (ev-dt 2026 6 1 18 0)) (ev-dt 2026 6 1 10 0)) (ev-av-check! "next-free skips a gap too short for the duration" (ev-next-free gdb (quote sam) (ev-dt 2026 6 1 9 0) 60 (ev-dt 2026 6 1 18 0)) (ev-dt 2026 6 1 11 30)) (ev-av-check! "next-free returns `after` when already free" (ev-next-free gdb (quote sam) (ev-dt 2026 6 1 14 0) 60 (ev-dt 2026 6 1 18 0)) (ev-dt 2026 6 1 14 0)) (ev-av-check! "next-free returns nil when nothing fits before horizon" (ev-next-free gdb (quote sam) (ev-dt 2026 6 1 9 0) 120 (ev-dt 2026 6 1 11 0)) nil) (ev-av-check! "next-free for actor with no bookings is `after`" (ev-next-free gdb (quote nobody) (ev-dt 2026 6 1 9 0) 60 (ev-dt 2026 6 1 18 0)) (ev-dt 2026 6 1 9 0)) (ev-av-check! "next-free at exact edge of a booking (half-open)" (ev-next-free gdb (quote sam) (ev-dt 2026 6 1 10 0) 30 (ev-dt 2026 6 1 18 0)) (ev-dt 2026 6 1 10 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})))