coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

events: waitlist + auto-promotion + 21 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Details

Browse Source 
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:
giles
2026-06-07 05:59:19 +00:00
parent 29127d8613
commit 7446c24bde
5 changed files with 175 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

60
lib/events/tests/booking.sx
View File

@@ -359,6 +359,65 @@
(ev-booking-count b "hi")
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
ev-booking-tests-run!
(fn
@@ -368,4 +427,5 @@
(set! ev-bk-fail 0)
(set! ev-bk-failures (list))
(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})))