events: next-free slot search + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
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:
@@ -16,7 +16,7 @@
|
|||||||
;; adjacent slots (E == next start) do NOT conflict. Conflict pairs are
|
;; 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`
|
;; 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
|
;; 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}.
|
;; A stable key for an occurrence dict {:id :start :end}.
|
||||||
(define ev-occ-key (fn (occ) (str (get occ :id) "@" (get occ :start))))
|
(define ev-occ-key (fn (occ) (str (get occ :id) "@" (get occ :start))))
|
||||||
@@ -98,6 +98,16 @@
|
|||||||
ev-sort-lists
|
ev-sort-lists
|
||||||
(fn (xs) (reduce (fn (acc x) (ev-list-insert x acc)) (list) xs)))
|
(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.
|
;; All busy intervals (list S E) for an actor, ascending by start.
|
||||||
(define
|
(define
|
||||||
ev-busy
|
ev-busy
|
||||||
@@ -129,3 +139,39 @@
|
|||||||
(let
|
(let
|
||||||
((rows (dl-query db (list (quote busy_in) actor (quote QS) (quote QE)))))
|
((rows (dl-query db (list (quote busy_in) actor (quote QS) (quote QE)))))
|
||||||
(begin (dl-retract! db (ev-qwindow-fact qs qe)) (empty? rows))))))
|
(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))))
|
||||||
|
|||||||
@@ -1,11 +1,11 @@
|
|||||||
{
|
{
|
||||||
"lang": "events",
|
"lang": "events",
|
||||||
"total_passed": 53,
|
"total_passed": 59,
|
||||||
"total_failed": 0,
|
"total_failed": 0,
|
||||||
"total": 53,
|
"total": 59,
|
||||||
"suites": [
|
"suites": [
|
||||||
{"name":"calendar","passed":37,"failed":0,"total":37},
|
{"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"
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,8 +1,8 @@
|
|||||||
# events scoreboard
|
# events scoreboard
|
||||||
|
|
||||||
**53 / 53 passing** (0 failure(s)).
|
**59 / 59 passing** (0 failure(s)).
|
||||||
|
|
||||||
| Suite | Passed | Total | Status |
|
| Suite | Passed | Total | Status |
|
||||||
|-------|--------|-------|--------|
|
|-------|--------|-------|--------|
|
||||||
| calendar | 37 | 37 | ok |
|
| calendar | 37 | 37 | ok |
|
||||||
| availability | 16 | 16 | ok |
|
| availability | 22 | 22 | ok |
|
||||||
|
|||||||
@@ -64,6 +64,33 @@
|
|||||||
(quote lunch)
|
(quote lunch)
|
||||||
(ev-dt 2026 6 1 12 0)))))))
|
(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
|
(define
|
||||||
ev-av-run-all!
|
ev-av-run-all!
|
||||||
(fn
|
(fn
|
||||||
@@ -203,6 +230,63 @@
|
|||||||
(list
|
(list
|
||||||
(ev-dt 2026 6 1 12 0)
|
(ev-dt 2026 6 1 12 0)
|
||||||
(ev-dt 2026 6 1 13 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
|
(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))))
|
((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
|
(let
|
||||||
|
|||||||
@@ -18,7 +18,7 @@ capacity rules, transactional booking, and a flow-driven notification dispatcher
|
|||||||
|
|
||||||
## Status (rolling)
|
## 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
|
## 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` — event facts, RRULE expansion in a window (DAILY/WEEKLY)
|
||||||
- [x] `calendar.sx` — MONTHLY (bymonthday + nth-weekday byday)
|
- [x] `calendar.sx` — MONTHLY (bymonthday + nth-weekday byday)
|
||||||
- [x] `availability.sx` — free/busy rules (busy/conflict/busy_in on Datalog)
|
- [x] `availability.sx` — free/busy rules (busy/conflict/busy_in on Datalog)
|
||||||
- [ ] `availability.sx` — next-free slot search (same rules, different bindings)
|
- [x] `availability.sx` — next-free slot search (same rules, different bindings)
|
||||||
- [ ] `api.sx` + tests + scoreboard + conformance.sh
|
- [ ] `api.sx` — public entry points (schedule/agenda/free-check)
|
||||||
|
- [ ] tests + scoreboard + conformance.sh [done incrementally; api.sx pending]
|
||||||
|
|
||||||
## Phase 2 — Ticketing + booking
|
## Phase 2 — Ticketing + booking
|
||||||
- [ ] capacity rules; transactional booking → `persist` (no overbooking)
|
- [ ] capacity rules; transactional booking → `persist` (no overbooking)
|
||||||
@@ -78,6 +79,11 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ──
|
|||||||
|
|
||||||
## Progress log
|
## 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-
|
- 2026-06-07 — `availability.sx`: free/busy + conflict detection as forward-
|
||||||
chained Datalog over `occurrence`/`booking` EDB. Rules `busy(A,S,E)`,
|
chained Datalog over `occurrence`/`booking` EDB. Rules `busy(A,S,E)`,
|
||||||
`conflict(A,O1,O2)` (canonical `O1<O2`, half-open overlap `S1<E2 ∧ S2<E1`),
|
`conflict(A,O1,O2)` (canonical `O1<O2`, half-open overlap `S1<E2 ∧ S2<E1`),
|
||||||
|
|||||||
Reference in New Issue
Block a user