diff --git a/lib/events/availability.sx b/lib/events/availability.sx index d7988476..d14fc9a9 100644 --- a/lib/events/availability.sx +++ b/lib/events/availability.sx @@ -16,7 +16,7 @@ ;; adjacent slots (E == next start) do NOT conflict. Conflict pairs are ;; canonical (O1 < O2 by key) so each overlap is reported once. The same `busy` ;; rule answers "is A free in [QS,QE)?" (busy_in is empty) and feeds "when is A -;; next free?" — same rules, different bindings. +;; next free?" (ev-next-free probes candidate slots with the same rule). ;; A stable key for an occurrence dict {:id :start :end}. (define ev-occ-key (fn (occ) (str (get occ :id) "@" (get occ :start)))) @@ -98,6 +98,16 @@ ev-sort-lists (fn (xs) (reduce (fn (acc x) (ev-list-insert x acc)) (list) xs))) +(define + ev-dedup-sorted + (fn + (xs) + (cond + ((empty? xs) xs) + ((empty? (rest xs)) xs) + ((= (first xs) (first (rest xs))) (ev-dedup-sorted (rest xs))) + (else (cons (first xs) (ev-dedup-sorted (rest xs))))))) + ;; All busy intervals (list S E) for an actor, ascending by start. (define ev-busy @@ -129,3 +139,39 @@ (let ((rows (dl-query db (list (quote busy_in) actor (quote QS) (quote QE))))) (begin (dl-retract! db (ev-qwindow-fact qs qe)) (empty? rows)))))) + +;; ---- next-free slot search ---- +;; The earliest start s >= `after` such that [s, s+duration) is entirely free +;; for `actor` and ends at or before `horizon`, or nil if none. The earliest +;; such slot must begin either at `after` or immediately after some busy +;; interval ends (classic interval packing), so those are the only candidates +;; we probe — each probe reuses the busy_in rule via ev-free?. + +(define + ev-first-free + (fn + (db actor cands duration horizon) + (cond + ((empty? cands) nil) + (else + (let + ((s (first cands))) + (if + (and + (<= (+ s duration) horizon) + (ev-free? db actor s (+ s duration))) + s + (ev-first-free db actor (rest cands) duration horizon))))))) + +(define + ev-next-free + (fn + (db actor after duration horizon) + (let + ((ends (filter (fn (e) (>= e after)) (map (fn (iv) (first (rest iv))) (ev-busy db actor))))) + (ev-first-free + db + actor + (ev-dedup-sorted (sort (cons after ends))) + duration + horizon)))) diff --git a/lib/events/scoreboard.json b/lib/events/scoreboard.json index 7f13897e..3b817214 100644 --- a/lib/events/scoreboard.json +++ b/lib/events/scoreboard.json @@ -1,11 +1,11 @@ { "lang": "events", - "total_passed": 53, + "total_passed": 59, "total_failed": 0, - "total": 53, + "total": 59, "suites": [ {"name":"calendar","passed":37,"failed":0,"total":37}, - {"name":"availability","passed":16,"failed":0,"total":16} + {"name":"availability","passed":22,"failed":0,"total":22} ], - "generated": "2026-06-07T00:21:06+00:00" + "generated": "2026-06-07T00:49:23+00:00" } diff --git a/lib/events/scoreboard.md b/lib/events/scoreboard.md index 57ff6024..fff9a18a 100644 --- a/lib/events/scoreboard.md +++ b/lib/events/scoreboard.md @@ -1,8 +1,8 @@ # events scoreboard -**53 / 53 passing** (0 failure(s)). +**59 / 59 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| | calendar | 37 | 37 | ok | -| availability | 16 | 16 | ok | +| availability | 22 | 22 | ok | diff --git a/lib/events/tests/availability.sx b/lib/events/tests/availability.sx index c6b8a788..f6ab3577 100644 --- a/lib/events/tests/availability.sx +++ b/lib/events/tests/availability.sx @@ -64,6 +64,33 @@ (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 @@ -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 diff --git a/plans/events-on-sx.md b/plans/events-on-sx.md index cef4f278..c47f9d67 100644 --- a/plans/events-on-sx.md +++ b/plans/events-on-sx.md @@ -18,7 +18,7 @@ capacity rules, transactional booking, and a flow-driven notification dispatcher ## Status (rolling) -`bash lib/events/conformance.sh` → **53/53** (Phase 1: calendar + availability) +`bash lib/events/conformance.sh` → **59/59** (Phase 1: calendar + availability) ## Ground rules @@ -57,8 +57,9 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── - [x] `calendar.sx` — event facts, RRULE expansion in a window (DAILY/WEEKLY) - [x] `calendar.sx` — MONTHLY (bymonthday + nth-weekday byday) - [x] `availability.sx` — free/busy rules (busy/conflict/busy_in on Datalog) -- [ ] `availability.sx` — next-free slot search (same rules, different bindings) -- [ ] `api.sx` + tests + scoreboard + conformance.sh +- [x] `availability.sx` — next-free slot search (same rules, different bindings) +- [ ] `api.sx` — public entry points (schedule/agenda/free-check) +- [ ] tests + scoreboard + conformance.sh [done incrementally; api.sx pending] ## Phase 2 — Ticketing + booking - [ ] capacity rules; transactional booking → `persist` (no overbooking) @@ -78,6 +79,11 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── ## Progress log +- 2026-06-07 — `next-free` slot search: earliest start ≥ after where + [s,s+duration) is free and ends ≤ horizon, else nil. Candidates are `after` + plus each busy-interval end (interval-packing); each probe reuses the + `busy_in` Datalog rule via `ev-free?`. Finds gaps between bookings, skips + too-short gaps, half-open at edges. +6 tests, 59/59. - 2026-06-07 — `availability.sx`: free/busy + conflict detection as forward- chained Datalog over `occurrence`/`booking` EDB. Rules `busy(A,S,E)`, `conflict(A,O1,O2)` (canonical `O1