events: waitlist + auto-promotion + 21 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
When full, ev/waitlist! queues actors FIFO (:waitlist/:unwaitlist on the booking stream; waiting fold independent of the seat fold). ev/waitlist, ev/waitlist-position, ev/leave-waitlist!. ev/cancel-promote! frees a seat and auto-promotes the head of the queue to a confirmed booking. Idempotent. 240/240 green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -40,6 +40,9 @@
|
|||||||
((= (first xs) x) i)
|
((= (first xs) x) i)
|
||||||
(else (ev-bk-index (rest xs) x (+ i 1))))))
|
(else (ev-bk-index (rest xs) x (+ i 1))))))
|
||||||
|
|
||||||
|
(define ev-bk-append (fn (xs a) (append xs (list a))))
|
||||||
|
(define ev-bk-remove (fn (xs a) (filter (fn (x) (not (= x a))) xs)))
|
||||||
|
|
||||||
;; ---- per-actor state association list: ((actor state) ...) in join order ----
|
;; ---- per-actor state association list: ((actor state) ...) in join order ----
|
||||||
|
|
||||||
(define
|
(define
|
||||||
@@ -269,3 +272,101 @@
|
|||||||
(fn
|
(fn
|
||||||
(b occ-key capacity)
|
(b occ-key capacity)
|
||||||
(max 0 (- capacity (ev-booking-count b occ-key)))))
|
(max 0 (- capacity (ev-booking-count b occ-key)))))
|
||||||
|
|
||||||
|
;; ---- waitlist ----
|
||||||
|
;; When an occurrence is full, actors join a FIFO waitlist (:waitlist /
|
||||||
|
;; :unwaitlist events on the same stream). Taking a seat (:booking / :hold)
|
||||||
|
;; removes an actor from the queue, so the waitlist fold is independent of the
|
||||||
|
;; seat fold. Cancelling/releasing a seat can auto-promote the head of the
|
||||||
|
;; queue (a :booking appended for them).
|
||||||
|
|
||||||
|
(define
|
||||||
|
ev-fold-waiting
|
||||||
|
(fn
|
||||||
|
(events)
|
||||||
|
(reduce
|
||||||
|
(fn
|
||||||
|
(acc e)
|
||||||
|
(let
|
||||||
|
((typ (persist/event-type e))
|
||||||
|
(actor (get (persist/event-data e) :actor)))
|
||||||
|
(cond
|
||||||
|
((= typ :waitlist) (if (ev-bk-member? actor acc) acc (ev-bk-append acc actor)))
|
||||||
|
((= typ :unwaitlist) (ev-bk-remove acc actor))
|
||||||
|
((= typ :booking) (ev-bk-remove acc actor))
|
||||||
|
((= typ :hold) (ev-bk-remove acc actor))
|
||||||
|
(else acc))))
|
||||||
|
(list)
|
||||||
|
events)))
|
||||||
|
|
||||||
|
;; The current waitlist queue (FIFO, oldest first).
|
||||||
|
(define
|
||||||
|
ev/waitlist
|
||||||
|
(fn (b occ-key) (ev-fold-waiting (persist/read b (ev-booking-stream occ-key)))))
|
||||||
|
|
||||||
|
;; 1-based queue position for an actor (0 if not waiting).
|
||||||
|
(define
|
||||||
|
ev/waitlist-position
|
||||||
|
(fn (b occ-key actor) (ev-seat-of (ev/waitlist b occ-key) actor)))
|
||||||
|
|
||||||
|
;; Book if a seat is free, else join the waitlist. Idempotent: already seated →
|
||||||
|
;; :already; already queued → :already-waiting.
|
||||||
|
(define
|
||||||
|
ev/waitlist!
|
||||||
|
(fn
|
||||||
|
(b occ-key capacity actor)
|
||||||
|
(let
|
||||||
|
((seats (ev-booked-actors b occ-key))
|
||||||
|
(waiting (ev/waitlist b occ-key)))
|
||||||
|
(cond
|
||||||
|
((ev-bk-member? actor seats)
|
||||||
|
{:status :already :seat (ev-seat-of seats actor) :actor actor})
|
||||||
|
((ev-bk-member? actor waiting)
|
||||||
|
{:status :already-waiting :position (ev-seat-of waiting actor) :actor actor})
|
||||||
|
(else
|
||||||
|
(let
|
||||||
|
((r (ev/book! b occ-key capacity actor)))
|
||||||
|
(if
|
||||||
|
(= (get r :status) :booked)
|
||||||
|
r
|
||||||
|
(begin
|
||||||
|
(persist/append b (ev-booking-stream occ-key) :waitlist 0 {:actor actor})
|
||||||
|
{:status :waitlisted
|
||||||
|
:position (+ (len waiting) 1)
|
||||||
|
:actor actor}))))))))
|
||||||
|
|
||||||
|
;; Leave the waitlist. :left or :not-waiting.
|
||||||
|
(define
|
||||||
|
ev/leave-waitlist!
|
||||||
|
(fn
|
||||||
|
(b occ-key actor)
|
||||||
|
(if
|
||||||
|
(ev-bk-member? actor (ev/waitlist b occ-key))
|
||||||
|
(begin
|
||||||
|
(persist/append b (ev-booking-stream occ-key) :unwaitlist 0 {:actor actor})
|
||||||
|
{:status :left :actor actor})
|
||||||
|
{:status :not-waiting :actor actor})))
|
||||||
|
|
||||||
|
;; Cancel a seat and, if that frees capacity, auto-promote the head of the
|
||||||
|
;; waitlist (a confirmed booking). Returns the cancel result plus :promoted
|
||||||
|
;; (the actor promoted, or nil).
|
||||||
|
(define
|
||||||
|
ev/cancel-promote!
|
||||||
|
(fn
|
||||||
|
(b occ-key capacity actor)
|
||||||
|
(let
|
||||||
|
((c (ev/cancel! b occ-key actor)))
|
||||||
|
(if
|
||||||
|
(= (get c :status) :cancelled)
|
||||||
|
(let
|
||||||
|
((waiting (ev/waitlist b occ-key))
|
||||||
|
(seats (ev-booked-actors b occ-key)))
|
||||||
|
(if
|
||||||
|
(and (not (empty? waiting)) (< (len seats) capacity))
|
||||||
|
(let
|
||||||
|
((promoted (first waiting)))
|
||||||
|
(begin
|
||||||
|
(persist/append b (ev-booking-stream occ-key) :booking 0 {:actor promoted})
|
||||||
|
{:status :cancelled :actor actor :promoted promoted}))
|
||||||
|
{:status :cancelled :actor actor :promoted nil}))
|
||||||
|
c))))
|
||||||
|
|||||||
@@ -1,17 +1,17 @@
|
|||||||
{
|
{
|
||||||
"lang": "events",
|
"lang": "events",
|
||||||
"total_passed": 219,
|
"total_passed": 240,
|
||||||
"total_failed": 0,
|
"total_failed": 0,
|
||||||
"total": 219,
|
"total": 240,
|
||||||
"suites": [
|
"suites": [
|
||||||
{"name":"calendar","passed":37,"failed":0,"total":37},
|
{"name":"calendar","passed":37,"failed":0,"total":37},
|
||||||
{"name":"availability","passed":22,"failed":0,"total":22},
|
{"name":"availability","passed":22,"failed":0,"total":22},
|
||||||
{"name":"api","passed":24,"failed":0,"total":24},
|
{"name":"api","passed":24,"failed":0,"total":24},
|
||||||
{"name":"booking","passed":61,"failed":0,"total":61},
|
{"name":"booking","passed":82,"failed":0,"total":82},
|
||||||
{"name":"ticket","passed":31,"failed":0,"total":31},
|
{"name":"ticket","passed":31,"failed":0,"total":31},
|
||||||
{"name":"notify","passed":7,"failed":0,"total":7},
|
{"name":"notify","passed":7,"failed":0,"total":7},
|
||||||
{"name":"reminders","passed":14,"failed":0,"total":14},
|
{"name":"reminders","passed":14,"failed":0,"total":14},
|
||||||
{"name":"federation","passed":23,"failed":0,"total":23}
|
{"name":"federation","passed":23,"failed":0,"total":23}
|
||||||
],
|
],
|
||||||
"generated": "2026-06-07T05:31:56+00:00"
|
"generated": "2026-06-07T05:59:03+00:00"
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,13 +1,13 @@
|
|||||||
# events scoreboard
|
# events scoreboard
|
||||||
|
|
||||||
**219 / 219 passing** (0 failure(s)).
|
**240 / 240 passing** (0 failure(s)).
|
||||||
|
|
||||||
| Suite | Passed | Total | Status |
|
| Suite | Passed | Total | Status |
|
||||||
|-------|--------|-------|--------|
|
|-------|--------|-------|--------|
|
||||||
| calendar | 37 | 37 | ok |
|
| calendar | 37 | 37 | ok |
|
||||||
| availability | 22 | 22 | ok |
|
| availability | 22 | 22 | ok |
|
||||||
| api | 24 | 24 | ok |
|
| api | 24 | 24 | ok |
|
||||||
| booking | 61 | 61 | ok |
|
| booking | 82 | 82 | ok |
|
||||||
| ticket | 31 | 31 | ok |
|
| ticket | 31 | 31 | ok |
|
||||||
| notify | 7 | 7 | ok |
|
| notify | 7 | 7 | ok |
|
||||||
| reminders | 14 | 14 | ok |
|
| reminders | 14 | 14 | ok |
|
||||||
|
|||||||
@@ -359,6 +359,65 @@
|
|||||||
(ev-booking-count b "hi")
|
(ev-booking-count b "hi")
|
||||||
1))))))
|
1))))))
|
||||||
|
|
||||||
|
;; ---- waitlist ----
|
||||||
|
(define
|
||||||
|
ev-bk-wl-run-all!
|
||||||
|
(fn
|
||||||
|
()
|
||||||
|
(do
|
||||||
|
;; join the waitlist when full; book directly when a seat is free
|
||||||
|
(let
|
||||||
|
((b (persist/open)))
|
||||||
|
(do
|
||||||
|
(ev-bk-check! "waitlist! books when a seat is free" (get (ev/waitlist! b "w" 2 (quote a)) :status) :booked)
|
||||||
|
(ev-bk-check! "second booking still fits" (get (ev/waitlist! b "w" 2 (quote c)) :status) :booked)
|
||||||
|
(ev-bk-check! "third joins the waitlist when full" (get (ev/waitlist! b "w" 2 (quote x)) :status) :waitlisted)
|
||||||
|
(ev-bk-check! "fourth is next in line" (get (ev/waitlist! b "w" 2 (quote y)) :position) 2)
|
||||||
|
(ev-bk-check! "waitlist is FIFO" (ev/waitlist b "w") (list (quote x) (quote y)))
|
||||||
|
(ev-bk-check! "seats unaffected by waitlisting" (ev/roster b "w") (list (quote a) (quote c)))
|
||||||
|
(ev-bk-check! "waitlist-position reports a queued actor" (ev/waitlist-position b "w" (quote y)) 2)
|
||||||
|
(ev-bk-check! "waitlist-position 0 for a seated actor" (ev/waitlist-position b "w" (quote a)) 0)))
|
||||||
|
;; idempotency
|
||||||
|
(let
|
||||||
|
((b (persist/open)))
|
||||||
|
(do
|
||||||
|
(ev/waitlist! b "wi" 1 (quote a))
|
||||||
|
(ev/waitlist! b "wi" 1 (quote x))
|
||||||
|
(ev-bk-check! "re-joining as a seated actor is :already" (get (ev/waitlist! b "wi" 1 (quote a)) :status) :already)
|
||||||
|
(ev-bk-check! "re-joining the queue is :already-waiting" (get (ev/waitlist! b "wi" 1 (quote x)) :status) :already-waiting)
|
||||||
|
(ev-bk-check! "queue did not grow on re-join" (ev/waitlist b "wi") (list (quote x)))))
|
||||||
|
;; leaving the waitlist
|
||||||
|
(let
|
||||||
|
((b (persist/open)))
|
||||||
|
(do
|
||||||
|
(ev/waitlist! b "wl" 1 (quote a))
|
||||||
|
(ev/waitlist! b "wl" 1 (quote x))
|
||||||
|
(ev/waitlist! b "wl" 1 (quote y))
|
||||||
|
(ev-bk-check! "leave-waitlist reports left" (get (ev/leave-waitlist! b "wl" (quote x)) :status) :left)
|
||||||
|
(ev-bk-check! "leaving removes from the queue" (ev/waitlist b "wl") (list (quote y)))
|
||||||
|
(ev-bk-check! "leaving when not queued is not-waiting" (get (ev/leave-waitlist! b "wl" (quote z)) :status) :not-waiting)))
|
||||||
|
;; auto-promotion on cancel
|
||||||
|
(let
|
||||||
|
((b (persist/open)))
|
||||||
|
(do
|
||||||
|
(ev/waitlist! b "wp" 1 (quote a))
|
||||||
|
(ev/waitlist! b "wp" 1 (quote x))
|
||||||
|
(ev/waitlist! b "wp" 1 (quote y))
|
||||||
|
(let
|
||||||
|
((r (ev/cancel-promote! b "wp" 1 (quote a))))
|
||||||
|
(do
|
||||||
|
(ev-bk-check! "cancel-promote cancels the seat holder" (get r :status) :cancelled)
|
||||||
|
(ev-bk-check! "cancel-promote promotes the head of the queue" (get r :promoted) (quote x))))
|
||||||
|
(ev-bk-check! "promoted actor now holds the seat" (ev/roster b "wp") (list (quote x)))
|
||||||
|
(ev-bk-check! "promoted actor left the queue" (ev/waitlist b "wp") (list (quote y)))
|
||||||
|
(ev-bk-check! "promoted seat is confirmed" (ev/seat-state b "wp" (quote x)) :confirmed)
|
||||||
|
;; cancelling with an empty waitlist promotes nobody
|
||||||
|
(ev/leave-waitlist! b "wp" (quote y))
|
||||||
|
(let
|
||||||
|
((r2 (ev/cancel-promote! b "wp" 1 (quote x))))
|
||||||
|
(ev-bk-check! "cancel with empty waitlist promotes nobody" (get r2 :promoted) nil))
|
||||||
|
(ev-bk-check! "seat is free after the last cancel" (ev/seats-left b "wp" 1) 1))))))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
ev-booking-tests-run!
|
ev-booking-tests-run!
|
||||||
(fn
|
(fn
|
||||||
@@ -368,4 +427,5 @@
|
|||||||
(set! ev-bk-fail 0)
|
(set! ev-bk-fail 0)
|
||||||
(set! ev-bk-failures (list))
|
(set! ev-bk-failures (list))
|
||||||
(ev-bk-run-all!)
|
(ev-bk-run-all!)
|
||||||
|
(ev-bk-wl-run-all!)
|
||||||
{:failures ev-bk-failures :total (+ ev-bk-pass ev-bk-fail) :passed ev-bk-pass :failed ev-bk-fail})))
|
{:failures ev-bk-failures :total (+ ev-bk-pass ev-bk-fail) :passed ev-bk-pass :failed ev-bk-fail})))
|
||||||
|
|||||||
@@ -18,7 +18,7 @@ capacity rules, transactional booking, and a flow-driven notification dispatcher
|
|||||||
|
|
||||||
## Status (rolling)
|
## Status (rolling)
|
||||||
|
|
||||||
`bash lib/events/conformance.sh` → **219/219** (Phases 1-4 + ext: federated free/busy)
|
`bash lib/events/conformance.sh` → **240/240** (Phases 1-4 + ext: federated free/busy, waitlist)
|
||||||
|
|
||||||
## Ground rules
|
## Ground rules
|
||||||
|
|
||||||
@@ -86,6 +86,13 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ──
|
|||||||
|
|
||||||
## Progress log
|
## Progress log
|
||||||
|
|
||||||
|
- 2026-06-07 — Waitlist + auto-promotion (extension). When an occurrence is
|
||||||
|
full, `ev/waitlist!` queues actors FIFO (:waitlist/:unwaitlist events on the
|
||||||
|
same stream; waiting fold is independent of the seat fold since taking a seat
|
||||||
|
removes from the queue). `ev/waitlist` (queue), `ev/waitlist-position`,
|
||||||
|
`ev/leave-waitlist!`. `ev/cancel-promote!` cancels a seat and auto-promotes
|
||||||
|
the head of the queue to a confirmed booking when capacity opens. Idempotent
|
||||||
|
(:already / :already-waiting). +21 tests, 240/240 green.
|
||||||
- 2026-06-07 — Federated free/busy (extension). Peers publish BUSY intervals
|
- 2026-06-07 — Federated free/busy (extension). Peers publish BUSY intervals
|
||||||
per actor (iCal free/busy model — privacy-preserving, not event details).
|
per actor (iCal free/busy model — privacy-preserving, not event details).
|
||||||
`ev/peer-with-busy`, `ev/peer-busy`; `ev/federated-busy` unions local
|
`ev/peer-with-busy`, `ev/peer-busy`; `ev/federated-busy` unions local
|
||||||
|
|||||||
Reference in New Issue
Block a user