diff --git a/lib/events/booking.sx b/lib/events/booking.sx index 522203ca..4d57130f 100644 --- a/lib/events/booking.sx +++ b/lib/events/booking.sx @@ -40,6 +40,9 @@ ((= (first xs) x) i) (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 ---- (define @@ -269,3 +272,101 @@ (fn (b occ-key capacity) (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)))) diff --git a/lib/events/scoreboard.json b/lib/events/scoreboard.json index c13c16f4..5c0a02e1 100644 --- a/lib/events/scoreboard.json +++ b/lib/events/scoreboard.json @@ -1,17 +1,17 @@ { "lang": "events", - "total_passed": 219, + "total_passed": 240, "total_failed": 0, - "total": 219, + "total": 240, "suites": [ {"name":"calendar","passed":37,"failed":0,"total":37}, {"name":"availability","passed":22,"failed":0,"total":22}, {"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":"notify","passed":7,"failed":0,"total":7}, {"name":"reminders","passed":14,"failed":0,"total":14}, {"name":"federation","passed":23,"failed":0,"total":23} ], - "generated": "2026-06-07T05:31:56+00:00" + "generated": "2026-06-07T05:59:03+00:00" } diff --git a/lib/events/scoreboard.md b/lib/events/scoreboard.md index 577d6039..3e85f60c 100644 --- a/lib/events/scoreboard.md +++ b/lib/events/scoreboard.md @@ -1,13 +1,13 @@ # events scoreboard -**219 / 219 passing** (0 failure(s)). +**240 / 240 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| | calendar | 37 | 37 | ok | | availability | 22 | 22 | ok | | api | 24 | 24 | ok | -| booking | 61 | 61 | ok | +| booking | 82 | 82 | ok | | ticket | 31 | 31 | ok | | notify | 7 | 7 | ok | | reminders | 14 | 14 | ok | diff --git a/lib/events/tests/booking.sx b/lib/events/tests/booking.sx index 52bd070b..a1ea38d4 100644 --- a/lib/events/tests/booking.sx +++ b/lib/events/tests/booking.sx @@ -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}))) diff --git a/plans/events-on-sx.md b/plans/events-on-sx.md index 376bb418..1bdf8742 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` → **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 @@ -86,6 +86,13 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── ## 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 per actor (iCal free/busy model — privacy-preserving, not event details). `ev/peer-with-busy`, `ev/peer-busy`; `ev/federated-busy` unions local