giles
07e4cb5f4a
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
ev/reschedule-notifications: when an event carries per-occurrence overrides, reads the roster at each overridden occurrence's original occ-key and emits a reschedule message per booked attendee (old-start/new-start/new-duration). Idempotency key = original-key/reschedule/new-start. 272/272 green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
277 lines
9.0 KiB
Plaintext
277 lines
9.0 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)))))))))
|
|
|
|
;; ---- reschedule notifications ----
|
|
(define
|
|
ev-rm-rs-run-all!
|
|
(fn
|
|
()
|
|
(let
|
|
((b (persist/open))
|
|
(ev (ev-event (quote yoga) (ev-dt 2026 6 1 9 0) 60 {:freq :daily :count 3} 20)))
|
|
(let
|
|
((occ2 (ev-occ (quote yoga) (ev-dt 2026 6 2 9 0) 60)))
|
|
(do
|
|
(ev/book-occ! b (ev/add-event (ev/empty) ev) (quote nia) occ2)
|
|
(ev/book-occ! b (ev/add-event (ev/empty) ev) (quote ola) occ2)
|
|
;; reschedule the Jun 2 occurrence to 14:00 / 90 min
|
|
(let
|
|
((moved (ev-with-override ev (ev-dt 2026 6 2 9 0) (ev-dt 2026 6 2 14 0) 90)))
|
|
(let
|
|
((ns (ev/reschedule-notifications b moved)))
|
|
(do
|
|
(ev-rm-check!
|
|
"every booked attendee is notified of the reschedule"
|
|
(map (fn (n) (get n :recipient)) ns)
|
|
(list (quote nia) (quote ola)))
|
|
(ev-rm-check!
|
|
"reschedule carries old and new start"
|
|
(list (get (first ns) :old-start) (get (first ns) :new-start))
|
|
(list (ev-dt 2026 6 2 9 0) (ev-dt 2026 6 2 14 0)))
|
|
(ev-rm-check!
|
|
"reschedule carries the new duration"
|
|
(get (first ns) :new-duration)
|
|
90)
|
|
(ev-rm-check!
|
|
"reschedule idempotency key encodes original key + new start"
|
|
(get (first ns) :id)
|
|
(str (ev-occ-key occ2) "/reschedule/" (ev-dt 2026 6 2 14 0)))
|
|
(ev-rm-check!
|
|
"reschedule projects to notify wire shape"
|
|
(ev/reschedule-notify->msg (first ns))
|
|
(list
|
|
(str (ev-occ-key occ2) "/reschedule/" (ev-dt 2026 6 2 14 0))
|
|
(quote nia)
|
|
(list :rescheduled (quote yoga) (ev-dt 2026 6 2 9 0) (ev-dt 2026 6 2 14 0)))))))
|
|
;; an override on an occurrence nobody booked notifies no one
|
|
(let
|
|
((moved2 (ev-with-override ev (ev-dt 2026 6 3 9 0) (ev-dt 2026 6 3 10 0) 60)))
|
|
(ev-rm-check!
|
|
"rescheduling an unbooked occurrence notifies no one"
|
|
(len (ev/reschedule-notifications b moved2))
|
|
0))
|
|
;; an event with no overrides yields no reschedule notifications
|
|
(ev-rm-check!
|
|
"event without overrides has no reschedule notifications"
|
|
(len (ev/reschedule-notifications b ev))
|
|
0))))))
|
|
|
|
(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!)
|
|
(ev-rm-rs-run-all!)
|
|
{:failures ev-rm-failures :total (+ ev-rm-pass ev-rm-fail) :passed ev-rm-pass :failed ev-rm-fail})))
|