giles
02b721854e
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
ev/book-checked! prevents an attendee double-booking themselves across different events: consults their persist-derived availability (ev/free-p?) for the occurrence window, returns :time-conflict on overlap else the normal ev/book-occ! result. Re-booking the same occurrence stays idempotent (:already); other actors unaffected. ev/would-time-conflict? predicate. 311/311 green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
333 lines
11 KiB
Plaintext
333 lines
11 KiB
Plaintext
;; lib/events/tests/api.sx — public events facade (schedule/agenda/free/book).
|
|
|
|
(define ev-api-pass 0)
|
|
(define ev-api-fail 0)
|
|
(define ev-api-failures (list))
|
|
|
|
(define
|
|
ev-api-check!
|
|
(fn
|
|
(name got expected)
|
|
(if
|
|
(= got expected)
|
|
(set! ev-api-pass (+ ev-api-pass 1))
|
|
(do
|
|
(set! ev-api-fail (+ ev-api-fail 1))
|
|
(append!
|
|
ev-api-failures
|
|
(str name "\n expected: " expected "\n got: " got))))))
|
|
|
|
;; A store with a weekly yoga class (Mon+Wed 18:00, 60m, 4 occurrences).
|
|
(define
|
|
ev-api-store
|
|
(fn
|
|
()
|
|
(ev/schedule
|
|
(ev/empty)
|
|
(quote yoga)
|
|
(ev-dt 2026 6 1 18 0)
|
|
60
|
|
{:freq :weekly :count 4 :byday (list 0 2)}
|
|
20)))
|
|
|
|
(define
|
|
ev-api-run-all!
|
|
(fn
|
|
()
|
|
(let
|
|
((s0 (ev-api-store)))
|
|
(let
|
|
((occs (ev/agenda s0 (ev-date 2026 6 1) (ev-date 2026 7 1))))
|
|
(let
|
|
((s1 (ev/book (ev/book s0 (quote nia) (ev-occ-key (first occs))) (quote nia) (ev-occ-key (first (rest occs))))))
|
|
(do
|
|
(ev-api-check!
|
|
"agenda expands weekly class to four occurrences"
|
|
(map (fn (o) (ev-dt->civil (get o :start))) occs)
|
|
(list
|
|
(list 2026 6 1)
|
|
(list 2026 6 3)
|
|
(list 2026 6 8)
|
|
(list 2026 6 10)))
|
|
(ev-api-check!
|
|
"empty store has empty agenda"
|
|
(ev/agenda
|
|
(ev/empty)
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 7 1))
|
|
(list))
|
|
(ev-api-check!
|
|
"max duration reflects scheduled events"
|
|
(ev/store-max-duration s0)
|
|
60)
|
|
(ev-api-check!
|
|
"max duration of empty store is zero"
|
|
(ev/store-max-duration (ev/empty))
|
|
0)
|
|
(ev-api-check!
|
|
"event-by-id finds the scheduled event"
|
|
(get (ev/event-by-id s0 (quote yoga)) :capacity)
|
|
20)
|
|
(ev-api-check!
|
|
"event-by-id is nil for unknown id"
|
|
(ev/event-by-id s0 (quote nope))
|
|
nil)
|
|
(ev-api-check!
|
|
"agenda-for lists only booked occurrences"
|
|
(map
|
|
(fn (o) (ev-dt->civil (get o :start)))
|
|
(ev/agenda-for
|
|
s1
|
|
(quote nia)
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 7 1)))
|
|
(list
|
|
(list 2026 6 1)
|
|
(list 2026 6 3)))
|
|
(ev-api-check!
|
|
"agenda-for empty for unbooked actor"
|
|
(ev/agenda-for
|
|
s1
|
|
(quote zed)
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 7 1))
|
|
(list))
|
|
(ev-api-check!
|
|
"free? false during a booked occurrence"
|
|
(ev/free?
|
|
s1
|
|
(quote nia)
|
|
(ev-dt 2026 6 1 18 30)
|
|
(ev-dt 2026 6 1 19 0))
|
|
false)
|
|
(ev-api-check!
|
|
"free? true in an open window"
|
|
(ev/free?
|
|
s1
|
|
(quote nia)
|
|
(ev-dt 2026 6 1 9 0)
|
|
(ev-dt 2026 6 1 10 0))
|
|
true)
|
|
(ev-api-check!
|
|
"free? half-open at occurrence end"
|
|
(ev/free?
|
|
s1
|
|
(quote nia)
|
|
(ev-dt 2026 6 1 19 0)
|
|
(ev-dt 2026 6 1 20 0))
|
|
true)
|
|
(ev-api-check!
|
|
"free? true for an actor who booked nothing"
|
|
(ev/free?
|
|
s1
|
|
(quote zed)
|
|
(ev-dt 2026 6 1 18 0)
|
|
(ev-dt 2026 6 1 19 0))
|
|
true)
|
|
(ev-api-check!
|
|
"next-free skips the booked slot to the hour after"
|
|
(ev-dt-tod
|
|
(ev/next-free
|
|
s1
|
|
(quote nia)
|
|
(ev-dt
|
|
2026
|
|
6
|
|
1
|
|
18
|
|
0)
|
|
60
|
|
(ev-dt
|
|
2026
|
|
6
|
|
1
|
|
23
|
|
0)))
|
|
(* 19 60))
|
|
(ev-api-check!
|
|
"next-free returns `after` when already open"
|
|
(ev/next-free
|
|
s1
|
|
(quote nia)
|
|
(ev-dt 2026 6 1 9 0)
|
|
60
|
|
(ev-dt 2026 6 1 18 0))
|
|
(ev-dt 2026 6 1 9 0))
|
|
(ev-api-check!
|
|
"no conflict among disjoint bookings"
|
|
(ev/has-conflict?
|
|
s1
|
|
(quote nia)
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 7 1))
|
|
false)
|
|
(let
|
|
((sc (ev/book (ev/schedule s1 (quote talk) (ev-dt 2026 6 1 18 30) 60 nil 5) (quote nia) (ev-occ-key (ev-occ (quote talk) (ev-dt 2026 6 1 18 30) 60)))))
|
|
(ev-api-check!
|
|
"overlapping second booking creates a conflict"
|
|
(ev/has-conflict?
|
|
sc
|
|
(quote nia)
|
|
(ev-date 2026 6 1)
|
|
(ev-date 2026 7 1))
|
|
true))
|
|
(let
|
|
((b (persist/open)) (occ1 (first occs)))
|
|
(do
|
|
(let
|
|
((sp (ev/schedule (ev/empty) (quote clinic) (ev-dt 2026 6 5 9 0) 30 nil 2)))
|
|
(let
|
|
((occ (ev-occ (quote clinic) (ev-dt 2026 6 5 9 0) 30)))
|
|
(do
|
|
(ev-api-check!
|
|
"durable book returns booked"
|
|
(get (ev/book-occ! b sp (quote a) occ) :status)
|
|
:booked)
|
|
(ev/book-occ! b sp (quote c) occ)
|
|
(ev-api-check!
|
|
"durable book past capacity is full"
|
|
(get (ev/book-occ! b sp (quote d) occ) :status)
|
|
:full)
|
|
(ev-api-check!
|
|
"durable roster reflects persisted bookings"
|
|
(ev/roster-occ b occ)
|
|
(list (quote a) (quote c)))
|
|
(ev-api-check!
|
|
"durable seats-left honours capacity"
|
|
(ev/seats-left-occ b sp occ)
|
|
0)
|
|
(ev-api-check!
|
|
"persist free? false during a durable booking"
|
|
(ev/free-p?
|
|
b
|
|
sp
|
|
(quote a)
|
|
(ev-dt
|
|
2026
|
|
6
|
|
5
|
|
9
|
|
10)
|
|
(ev-dt
|
|
2026
|
|
6
|
|
5
|
|
9
|
|
20))
|
|
false)
|
|
(ev-api-check!
|
|
"persist free? true in an open window"
|
|
(ev/free-p?
|
|
b
|
|
sp
|
|
(quote a)
|
|
(ev-dt
|
|
2026
|
|
6
|
|
5
|
|
10
|
|
0)
|
|
(ev-dt
|
|
2026
|
|
6
|
|
5
|
|
10
|
|
30))
|
|
true)
|
|
(ev/cancel-occ! b sp (quote a) occ)
|
|
(ev-api-check!
|
|
"durable cancel frees a seat"
|
|
(ev/seats-left-occ b sp occ)
|
|
1)
|
|
(ev-api-check!
|
|
"persist free? true after cancellation"
|
|
(ev/free-p?
|
|
b
|
|
sp
|
|
(quote a)
|
|
(ev-dt
|
|
2026
|
|
6
|
|
5
|
|
9
|
|
10)
|
|
(ev-dt
|
|
2026
|
|
6
|
|
5
|
|
9
|
|
20))
|
|
true))))))))))))
|
|
|
|
;; ---- conflict-checked booking ----
|
|
(define
|
|
ev-api-cf-run-all!
|
|
(fn
|
|
()
|
|
(let
|
|
((b (persist/open))
|
|
(store
|
|
(ev/schedule
|
|
(ev/schedule
|
|
(ev/schedule (ev/empty) (quote a) (ev-dt 2026 6 1 9 0) 60 nil 10)
|
|
(quote bb)
|
|
(ev-dt 2026 6 1 9 30)
|
|
60
|
|
nil
|
|
10)
|
|
(quote c)
|
|
(ev-dt 2026 6 1 11 0)
|
|
60
|
|
nil
|
|
10)))
|
|
(let
|
|
((oa (ev-occ (quote a) (ev-dt 2026 6 1 9 0) 60))
|
|
(ob (ev-occ (quote bb) (ev-dt 2026 6 1 9 30) 60))
|
|
(oc (ev-occ (quote c) (ev-dt 2026 6 1 11 0) 60)))
|
|
(do
|
|
(ev-api-check!
|
|
"first checked booking succeeds"
|
|
(get (ev/book-checked! b store (quote nia) oa) :status)
|
|
:booked)
|
|
(ev-api-check!
|
|
"overlapping different-event booking is a time conflict"
|
|
(get (ev/book-checked! b store (quote nia) ob) :status)
|
|
:time-conflict)
|
|
(ev-api-check!
|
|
"the clashing booking did not land on the roster"
|
|
(ev/roster-occ b ob)
|
|
(list))
|
|
(ev-api-check!
|
|
"a non-overlapping booking is allowed"
|
|
(get (ev/book-checked! b store (quote nia) oc) :status)
|
|
:booked)
|
|
(ev-api-check!
|
|
"re-booking the same occurrence is idempotent, not a conflict"
|
|
(get (ev/book-checked! b store (quote nia) oa) :status)
|
|
:already)
|
|
;; a different actor is unaffected by nia's bookings
|
|
(ev-api-check!
|
|
"another actor may take the overlapping slot"
|
|
(get (ev/book-checked! b store (quote ola) ob) :status)
|
|
:booked)
|
|
(ev-api-check!
|
|
"would-time-conflict? predicate agrees"
|
|
(ev/would-time-conflict? b store (quote nia) ob)
|
|
true)
|
|
(ev-api-check!
|
|
"would-time-conflict? false for a free slot"
|
|
(ev/would-time-conflict? b store (quote zed) ob)
|
|
false))))))
|
|
|
|
(define
|
|
ev-api-tests-run!
|
|
(fn
|
|
()
|
|
(do
|
|
(set! ev-api-pass 0)
|
|
(set! ev-api-fail 0)
|
|
(set! ev-api-failures (list))
|
|
(ev-api-run-all!)
|
|
(ev-api-cf-run-all!)
|
|
{:failures ev-api-failures :total (+ ev-api-pass ev-api-fail) :passed ev-api-pass :failed ev-api-fail})))
|