;; lib/events/reminders.sx — derive reminder + digest messages from the agenda. ;; ;; Bridges the schedule (calendar) and the durable roster (booking on persist) ;; to the notification layer (notify.sx). For each booked attendee of each ;; upcoming occurrence we derive a reminder message that fires `lead` minutes ;; before the occurrence starts. Each message has a deterministic idempotency ;; key — occ-key / recipient / lead — so re-deriving over an overlapping window ;; never produces a duplicate ping (the notify transport dedups on this id). ;; ;; A reminder is a dict: ;; {:id :recipient :event :start :fire-at} ;; `ev/reminder->msg` projects it to notify's (id recipient body) wire shape. ;; Reminders for one occurrence: one per booked attendee (durable roster). (define ev/occurrence-reminders (fn (b occ lead) (let ((occ-key (ev-occ-key occ)) (start (get occ :start)) (evid (get occ :id))) (map (fn (actor) {:id (str occ-key "/" actor "/" lead) :event evid :start start :fire-at (- start lead) :recipient actor}) (ev/roster-occ b occ))))) ;; Insertion sort of reminder dicts ascending by :fire-at (then :id for ties). (define ev-rem-before? (fn (a c) (cond ((< (get a :fire-at) (get c :fire-at)) true) ((> (get a :fire-at) (get c :fire-at)) false) (else (< (get a :id) (get c :id)))))) (define ev-rem-insert (fn (r sorted) (cond ((empty? sorted) (list r)) ((ev-rem-before? r (first sorted)) (cons r sorted)) (else (cons (first sorted) (ev-rem-insert r (rest sorted))))))) (define ev-rem-sort (fn (rs) (reduce (fn (acc r) (ev-rem-insert r acc)) (list) rs))) ;; All reminders across the agenda in [ws, we), ascending by fire-at. (define ev/agenda-reminders (fn (b store ws we lead) (let ((acc (list))) (begin (for-each (fn (occ) (for-each (fn (r) (append! acc r)) (ev/occurrence-reminders b occ lead))) (ev/agenda store ws we)) (ev-rem-sort acc))))) ;; Reminders whose fire-at has arrived (fire-at <= now) — what a scheduler ;; should hand to the notify transport at time `now`. (define ev/due-reminders (fn (reminders now) (filter (fn (r) (<= (get r :fire-at) now)) reminders))) ;; Project a reminder to notify's (id recipient body) wire shape. (define ev/reminder->msg (fn (r) (list (get r :id) (get r :recipient) (list :reminder (get r :event) (get r :start))))) ;; ---- digests ---- ;; The occurrences `actor` is booked into (durable roster), within window. (define ev/agenda-for-p (fn (b store actor ws we) (filter (fn (occ) (ev-bk-member? actor (ev/roster-occ b occ))) (ev/agenda store ws we)))) ;; A single digest message summarising an actor's upcoming booked occurrences. ;; :items is ({:event :start} ...); empty when the actor has nothing booked. (define ev/agenda-digest (fn (b store actor ws we) {:items (map (fn (occ) {:event (get occ :id) :start (get occ :start)}) (ev/agenda-for-p b store actor ws we)) :id (str actor "/digest/" ws "-" we) :recipient actor})) ;; ---- reschedule notifications ---- ;; When an event carries per-occurrence overrides (ev-with-override), every ;; attendee booked at the ORIGINAL start should be told the new time. Bookings ;; were made against the original occ-key (id@orig-start), so we read that ;; roster. Idempotency key encodes the original key and the new start, so ;; re-deriving the same reschedule never double-notifies. (define ev/reschedule-notifications (fn (b event) (let ((overrides (ev-or (get event :overrides) (list))) (evid (get event :id)) (dur (get event :duration))) (reduce (fn (acc entry) (let ((orig-start (first entry)) (ov (first (rest entry)))) (let ((occ (ev-occ evid orig-start dur)) (new-start (get ov :start)) (new-duration (get ov :duration))) (let ((key (ev-occ-key occ))) (append acc (map (fn (actor) {:id (str key "/reschedule/" new-start) :recipient actor :event evid :old-start orig-start :new-start new-start :new-duration new-duration}) (ev/roster-occ b occ))))))) (list) overrides)))) ;; Project a reschedule notification to notify's (id recipient body) shape. (define ev/reschedule-notify->msg (fn (r) (list (get r :id) (get r :recipient) (list :rescheduled (get r :event) (get r :old-start) (get r :new-start)))))