rose-ash/lib/events/api.sx

;; lib/events/api.sx — public events surface over calendar + availability.
;;
;; A `store` is an immutable value holding scheduled events and (in-memory)
;; bookings:
;;
;;   {:events (event ...) :bookings ((actor key) ...)}
;;
;; The in-memory `:bookings` list supports pure, value-level queries. The
;; DURABLE booking path (ev/*-occ! and ev/*-p) keeps bookings in persist
;; streams via booking.sx — capacity-safe, cancellable, replayable — and
;; derives availability from those streams. Use the persist path for real
;; bookings; the in-memory path for projections and tests.
;;
;; All queries are windowed: agenda/free/next-free expand recurring events into
;; concrete occurrences within an explicit (or derived) window before running
;; the Datalog availability rules.

(define ev/store (fn (events bookings) {:bookings bookings :events events}))

(define ev/empty (fn () (ev/store (list) (list))))

(define ev/events (fn (store) (get store :events)))
(define ev/bookings (fn (store) (get store :bookings)))

;; Add a (constructed) event to the store.
(define
  ev/add-event
  (fn
    (store event)
    (ev/store (cons event (ev/events store)) (ev/bookings store))))

;; Schedule a fresh event from parts, returning the updated store. rrule may be
;; nil for a one-off. (Booking is separate — see ev/book.)
(define
  ev/schedule
  (fn
    (store id dtstart duration rrule capacity)
    (ev/add-event store (ev-event id dtstart duration rrule capacity))))

;; Record that `actor` holds the occurrence with `key` (in-memory only — see
;; ev/book-occ! for the durable, capacity-safe path).
(define
  ev/book
  (fn
    (store actor key)
    (ev/store
      (ev/events store)
      (cons (list actor key) (ev/bookings store)))))

;; The event with `id`, or nil.
(define
  ev/event-by-id
  (fn
    (store id)
    (reduce
      (fn
        (found ev)
        (if (nil? found) (if (= (get ev :id) id) ev found) found))
      nil
      (ev/events store))))

;; Capacity of the event an occurrence belongs to (0 if unknown).
(define
  ev/capacity-of
  (fn
    (store occ)
    (let
      ((ev (ev/event-by-id store (get occ :id))))
      (if (nil? ev) 0 (get ev :capacity)))))

;; The maximum event duration in the store (0 when empty) — used to widen
;; expansion windows so any occurrence overlapping a query is captured.
(define
  ev/store-max-duration
  (fn
    (store)
    (reduce
      (fn (m ev) (max m (get ev :duration)))
      0
      (ev/events store))))

;; All occurrences across all events within [ws, we), ascending by start.
(define
  ev/agenda
  (fn (store ws we) (ev-expand-all (ev/events store) ws we)))

(define
  ev-key-member?
  (fn
    (k keys)
    (cond
      ((empty? keys) false)
      ((= k (first keys)) true)
      (else (ev-key-member? k (rest keys))))))

;; Occurrence keys `actor` has booked (in-memory store).
(define
  ev/actor-keys
  (fn
    (store actor)
    (reduce
      (fn
        (acc b)
        (if (= (first b) actor) (cons (first (rest b)) acc) acc))
      (list)
      (ev/bookings store))))

;; The agenda restricted to occurrences `actor` is booked into (in-memory).
(define
  ev/agenda-for
  (fn
    (store actor ws we)
    (let
      ((keys (ev/actor-keys store actor)))
      (filter
        (fn (o) (ev-key-member? (ev-occ-key o) keys))
        (ev/agenda store ws we)))))

;; Build an availability db over occurrences expanded in [ws, we) using the
;; in-memory bookings.
(define
  ev/avail-window-db
  (fn
    (store ws we)
    (ev-avail-db (ev/agenda store ws we) (ev/bookings store))))

;; Is `actor` free across [qs, qe)? Expands a window wide enough (back by the
;; longest event) to capture any occurrence that could overlap.
(define
  ev/free?
  (fn
    (store actor qs qe)
    (ev-free?
      (ev/avail-window-db store (- qs (ev/store-max-duration store)) qe)
      actor
      qs
      qe)))

;; Earliest free slot of `duration` for `actor` in [after, horizon), or nil.
(define
  ev/next-free
  (fn
    (store actor after duration horizon)
    (ev-next-free
      (ev/avail-window-db
        store
        (- after (ev/store-max-duration store))
        horizon)
      actor
      after
      duration
      horizon)))

;; Overlapping double-bookings for `actor` among occurrences in [ws, we).
(define
  ev/conflicts
  (fn
    (store actor ws we)
    (ev-conflicts (ev/avail-window-db store ws we) actor)))

(define
  ev/has-conflict?
  (fn
    (store actor ws we)
    (> (len (ev/conflicts store actor ws we)) 0)))

;; ---- durable, persist-backed booking path ----
;; These take a persist backend `b` (persist/open) plus the schedule `store`.
;; Bookings live in per-occurrence streams (booking.sx); availability is derived
;; by replaying those streams for the occurrences in the query window.

;; Durably book `actor` into occurrence `occ` (dict {:id :start :end}),
;; capacity-safe. Returns the booking.sx result (:booked / :full / :already).
(define
  ev/book-occ!
  (fn
    (b store actor occ)
    (ev/book! b (ev-occ-key occ) (ev/capacity-of store occ) actor)))

;; Durably cancel `actor`'s seat on `occ`, freeing capacity.
(define
  ev/cancel-occ!
  (fn (b store actor occ) (ev/cancel! b (ev-occ-key occ) actor)))

;; Live roster / seats-left for a specific occurrence from persist.
(define ev/roster-occ (fn (b occ) (ev/roster b (ev-occ-key occ))))

(define
  ev/seats-left-occ
  (fn
    (b store occ)
    (ev/seats-left b (ev-occ-key occ) (ev/capacity-of store occ))))

;; Derive (actor key) booking pairs from the persist rosters of `occs`.
(define
  ev/persist-bookings
  (fn
    (b occs)
    (reduce
      (fn
        (acc occ)
        (let
          ((key (ev-occ-key occ)))
          (append
            acc
            (map (fn (actor) (list actor key)) (ev/roster b key)))))
      (list)
      occs)))

;; Availability db over [ws, we) with bookings sourced from persist streams.
(define
  ev/avail-db-p
  (fn
    (b store ws we)
    (let
      ((occs (ev/agenda store ws we)))
      (ev-avail-db occs (ev/persist-bookings b occs)))))

;; Persist-backed availability queries (mirror the in-memory ev/free? etc).
(define
  ev/free-p?
  (fn
    (b store actor qs qe)
    (ev-free?
      (ev/avail-db-p b store (- qs (ev/store-max-duration store)) qe)
      actor
      qs
      qe)))

(define
  ev/next-free-p
  (fn
    (b store actor after duration horizon)
    (ev-next-free
      (ev/avail-db-p b store (- after (ev/store-max-duration store)) horizon)
      actor
      after
      duration
      horizon)))

(define
  ev/conflicts-p
  (fn
    (b store actor ws we)
    (ev-conflicts (ev/avail-db-p b store ws we) actor)))

(define
  ev/has-conflict-p?
  (fn
    (b store actor ws we)
    (> (len (ev/conflicts-p b store actor ws we)) 0)))