giles
f6c1d1e9bf
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 40s
reminders.sx bridges calendar + durable rosters to notify: ev/occurrence- reminders (one per booked attendee, fires lead before start, idempotency key occ-key/recipient/lead), ev/agenda-reminders (sorted by fire-at), ev/due-reminders (fire-at <= now), ev/reminder->msg (notify wire shape), ev/agenda-digest + ev/agenda-for-p. 196/196 green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
221 lines
6.5 KiB
Plaintext
221 lines
6.5 KiB
Plaintext
;; lib/events/tests/reminders.sx — reminder + digest derivation from the agenda.
|
|
|
|
(define ev-rm-pass 0)
|
|
(define ev-rm-fail 0)
|
|
(define ev-rm-failures (list))
|
|
|
|
(define
|
|
ev-rm-check!
|
|
(fn
|
|
(name got expected)
|
|
(if
|
|
(= got expected)
|
|
(set! ev-rm-pass (+ ev-rm-pass 1))
|
|
(do
|
|
(set! ev-rm-fail (+ ev-rm-fail 1))
|
|
(append!
|
|
ev-rm-failures
|
|
(str name "\n expected: " expected "\n got: " got))))))
|
|
|
|
;; A store with a weekly class (Mon+Wed 18:00, 60m, 4 occurrences) and a one-off
|
|
;; talk; durable bookings on a persist backend.
|
|
(define
|
|
ev-rm-store
|
|
(fn
|
|
()
|
|
(ev/schedule
|
|
(ev/schedule
|
|
(ev/empty)
|
|
(quote yoga)
|
|
(ev-dt 2026 6 1 18 0)
|
|
60
|
|
{:freq :weekly :count 4 :byday (list 0 2)}
|
|
20)
|
|
(quote talk)
|
|
(ev-dt 2026 6 2 12 0)
|
|
30
|
|
nil
|
|
50)))
|
|
|
|
(define
|
|
ev-rm-run-all!
|
|
(fn
|
|
()
|
|
(let
|
|
((store (ev-rm-store)) (b (persist/open)))
|
|
(let
|
|
((occs (ev/agenda store (ev-date 2026 6 1) (ev-date 2026 7 1))))
|
|
(do
|
|
(ev/book-occ! b store (quote nia) (first occs))
|
|
(ev/book-occ! b store (quote ola) (first occs))
|
|
(ev/book-occ!
|
|
b
|
|
store
|
|
(quote ola)
|
|
(ev-occ
|
|
(quote talk)
|
|
(ev-dt 2026 6 2 12 0)
|
|
30))
|
|
(do
|
|
(let
|
|
((rs (ev/occurrence-reminders b (first occs) 60)))
|
|
(do
|
|
(ev-rm-check!
|
|
"one reminder per booked attendee"
|
|
(len rs)
|
|
2)
|
|
(ev-rm-check!
|
|
"reminder fires lead minutes before start"
|
|
(get (first rs) :fire-at)
|
|
(-
|
|
(ev-dt
|
|
2026
|
|
6
|
|
1
|
|
18
|
|
0)
|
|
60))
|
|
(ev-rm-check!
|
|
"reminder idempotency key encodes occ/recipient/lead"
|
|
(get (first rs) :id)
|
|
(str
|
|
(ev-occ-key (first occs))
|
|
"/"
|
|
(quote nia)
|
|
"/"
|
|
60))
|
|
(ev-rm-check!
|
|
"reminder names the event"
|
|
(get (first rs) :event)
|
|
(quote yoga))))
|
|
(ev-rm-check!
|
|
"unbooked occurrence has no reminders"
|
|
(len
|
|
(ev/occurrence-reminders b (ev-occ (quote yoga) (ev-dt 2026 6 3 18 0) 60) 60))
|
|
0)
|
|
(let
|
|
((all (ev/agenda-reminders b store (ev-date 2026 6 1) (ev-date 2026 7 1) 60)))
|
|
(do
|
|
(ev-rm-check!
|
|
"agenda reminders cover all bookings"
|
|
(len all)
|
|
3)
|
|
(ev-rm-check!
|
|
"agenda reminders sorted by fire-at"
|
|
(map (fn (r) (get r :fire-at)) all)
|
|
(list
|
|
(-
|
|
(ev-dt
|
|
2026
|
|
6
|
|
1
|
|
18
|
|
0)
|
|
60)
|
|
(-
|
|
(ev-dt
|
|
2026
|
|
6
|
|
1
|
|
18
|
|
0)
|
|
60)
|
|
(-
|
|
(ev-dt
|
|
2026
|
|
6
|
|
2
|
|
12
|
|
0)
|
|
60)))))
|
|
(let
|
|
((all (ev/agenda-reminders b store (ev-date 2026 6 1) (ev-date 2026 7 1) 60)))
|
|
(do
|
|
(ev-rm-check!
|
|
"nothing due before the first fire-at"
|
|
(len
|
|
(ev/due-reminders
|
|
all
|
|
(-
|
|
(ev-dt
|
|
2026
|
|
6
|
|
1
|
|
17
|
|
0)
|
|
1)))
|
|
0)
|
|
(ev-rm-check!
|
|
"the two yoga reminders are due at 17:00"
|
|
(len
|
|
(ev/due-reminders
|
|
all
|
|
(ev-dt
|
|
2026
|
|
6
|
|
1
|
|
17
|
|
0)))
|
|
2)
|
|
(ev-rm-check!
|
|
"all reminders due once past the last fire-at"
|
|
(len
|
|
(ev/due-reminders
|
|
all
|
|
(ev-dt
|
|
2026
|
|
6
|
|
2
|
|
12
|
|
0)))
|
|
3)))
|
|
(let
|
|
((r (first (ev/occurrence-reminders b (first occs) 60))))
|
|
(ev-rm-check!
|
|
"reminder projects to (id recipient body)"
|
|
(ev/reminder->msg r)
|
|
(list
|
|
(str
|
|
(ev-occ-key (first occs))
|
|
"/"
|
|
(quote nia)
|
|
"/"
|
|
60)
|
|
(quote nia)
|
|
(list
|
|
:reminder (quote yoga)
|
|
(ev-dt
|
|
2026
|
|
6
|
|
1
|
|
18
|
|
0)))))
|
|
(let
|
|
((dig (ev/agenda-digest b store (quote ola) (ev-date 2026 6 1) (ev-date 2026 7 1))))
|
|
(do
|
|
(ev-rm-check!
|
|
"digest is addressed to the actor"
|
|
(get dig :recipient)
|
|
(quote ola))
|
|
(ev-rm-check!
|
|
"digest lists the actor's booked occurrences"
|
|
(map (fn (it) (get it :event)) (get dig :items))
|
|
(list (quote yoga) (quote talk)))))
|
|
(let
|
|
((empty-dig (ev/agenda-digest b store (quote nobody) (ev-date 2026 6 1) (ev-date 2026 7 1))))
|
|
(ev-rm-check!
|
|
"digest empty for an actor with no bookings"
|
|
(get empty-dig :items)
|
|
(list)))))))))
|
|
|
|
(define
|
|
ev-reminders-tests-run!
|
|
(fn
|
|
()
|
|
(do
|
|
(set! ev-rm-pass 0)
|
|
(set! ev-rm-fail 0)
|
|
(set! ev-rm-failures (list))
|
|
(ev-rm-run-all!)
|
|
{:failures ev-rm-failures :total (+ ev-rm-pass ev-rm-fail) :passed ev-rm-pass :failed ev-rm-fail})))
|