events: next-free slot search + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s

ev-next-free finds the earliest free slot >= after for a duration within a
horizon, probing 'after' + busy-interval ends via the busy_in rule (ev-free?).
Finds gaps, skips too-short gaps, half-open at edges. 59/59 green.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-06-07 00:49:42 +00:00
parent 540933bfca
commit 4674b797cb
5 changed files with 146 additions and 10 deletions

View File

@@ -64,6 +64,33 @@
(quote lunch)
(ev-dt 2026 6 1 12 0)))))))
;; Disjoint fixture for slot search: 09:0010:00 then 10:3011: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
@@ -203,6 +230,63 @@
(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