giles
540933bfca
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m1s
occurrence/booking EDB; rules busy/conflict (canonical pair, half-open overlap)/busy_in. API ev-busy, ev-conflicts, ev-has-conflict?, ev-free? (transient qwindow). Integrates with calendar expansion. 53/53 green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
132 lines
4.0 KiB
Plaintext
132 lines
4.0 KiB
Plaintext
;; lib/events/availability.sx — free/busy + conflict detection on Datalog.
|
|
;;
|
|
;; Availability is per-actor and is forward-chained Datalog over two EDB
|
|
;; relations:
|
|
;;
|
|
;; (occurrence Key EventId Start End) ; an expanded calendar occurrence
|
|
;; (booking Actor Key) ; actor attends/holds that occurrence
|
|
;;
|
|
;; The derived relations are the whole policy:
|
|
;;
|
|
;; busy(A,S,E) — A is committed for [S,E) (a booked occurrence)
|
|
;; conflict(A,O1,O2) — A double-booked into two overlapping occurrences
|
|
;; busy_in(A,QS,QE) — A is busy somewhere inside query window [QS,QE)
|
|
;;
|
|
;; Intervals are half-open [Start,End) in epoch minutes (see calendar.sx), so
|
|
;; adjacent slots (E == next start) do NOT conflict. Conflict pairs are
|
|
;; canonical (O1 < O2 by key) so each overlap is reported once. The same `busy`
|
|
;; rule answers "is A free in [QS,QE)?" (busy_in is empty) and feeds "when is A
|
|
;; next free?" — same rules, different bindings.
|
|
|
|
;; A stable key for an occurrence dict {:id :start :end}.
|
|
(define ev-occ-key (fn (occ) (str (get occ :id) "@" (get occ :start))))
|
|
|
|
(define
|
|
ev-occurrence-fact
|
|
(fn
|
|
(occ)
|
|
(list
|
|
(quote occurrence)
|
|
(ev-occ-key occ)
|
|
(get occ :id)
|
|
(get occ :start)
|
|
(get occ :end))))
|
|
|
|
(define ev-occurrence-facts (fn (occs) (map ev-occurrence-fact occs)))
|
|
|
|
(define ev-booking-fact (fn (actor key) (list (quote booking) actor key)))
|
|
|
|
(define ev-qwindow-fact (fn (qs qe) (list (quote qwindow) qs qe)))
|
|
|
|
;; Range restriction: each comparison's variables are bound by an earlier
|
|
;; positive literal (qwindow / busy precede the < tests). Conflict uses
|
|
;; (< O1 O2) on the keys so each overlapping pair is reported once.
|
|
(define
|
|
ev-avail-rules
|
|
(quote
|
|
((busy A S E <- (booking A O) (occurrence O _ S E))
|
|
(conflict
|
|
A
|
|
O1
|
|
O2
|
|
<-
|
|
(booking A O1)
|
|
(booking A O2)
|
|
(occurrence O1 _ S1 E1)
|
|
(occurrence O2 _ S2 E2)
|
|
(< O1 O2)
|
|
(< S1 E2)
|
|
(< S2 E1))
|
|
(busy_in A QS QE <- (qwindow QS QE) (busy A S E) (< S QE) (< QS E)))))
|
|
|
|
;; Build a Datalog db from EDB facts under the availability ruleset.
|
|
(define ev-build-avail (fn (facts) (dl-program-data facts ev-avail-rules)))
|
|
|
|
;; Convenience: build a db from occurrence dicts + booking pairs.
|
|
;; bookings is a list of (actor key) pairs.
|
|
(define
|
|
ev-avail-db
|
|
(fn
|
|
(occs bookings)
|
|
(ev-build-avail
|
|
(append
|
|
(ev-occurrence-facts occs)
|
|
(map
|
|
(fn (b) (ev-booking-fact (first b) (first (rest b))))
|
|
bookings)))))
|
|
|
|
;; Helper: insertion sort a list of (S E ...) lists ascending by S then E.
|
|
(define
|
|
ev-list-before?
|
|
(fn
|
|
(a b)
|
|
(cond
|
|
((< (first a) (first b)) true)
|
|
((> (first a) (first b)) false)
|
|
(else (< (first (rest a)) (first (rest b)))))))
|
|
|
|
(define
|
|
ev-list-insert
|
|
(fn
|
|
(x sorted)
|
|
(cond
|
|
((empty? sorted) (list x))
|
|
((ev-list-before? x (first sorted)) (cons x sorted))
|
|
(else (cons (first sorted) (ev-list-insert x (rest sorted)))))))
|
|
|
|
(define
|
|
ev-sort-lists
|
|
(fn (xs) (reduce (fn (acc x) (ev-list-insert x acc)) (list) xs)))
|
|
|
|
;; All busy intervals (list S E) for an actor, ascending by start.
|
|
(define
|
|
ev-busy
|
|
(fn
|
|
(db actor)
|
|
(let
|
|
((rows (dl-query db (list (quote busy) actor (quote S) (quote E)))))
|
|
(ev-sort-lists (map (fn (b) (list (get b :S) (get b :E))) rows)))))
|
|
|
|
;; Distinct conflicting occurrence-key pairs for an actor (each pair once).
|
|
(define
|
|
ev-conflicts
|
|
(fn
|
|
(db actor)
|
|
(dl-query db (list (quote conflict) actor (quote O1) (quote O2)))))
|
|
|
|
(define
|
|
ev-has-conflict?
|
|
(fn (db actor) (> (len (ev-conflicts db actor)) 0)))
|
|
|
|
;; Is `actor` free across the whole window [qs,qe)? (no booked occurrence
|
|
;; overlaps it). Asserts a transient qwindow fact, queries, retracts.
|
|
(define
|
|
ev-free?
|
|
(fn
|
|
(db actor qs qe)
|
|
(do
|
|
(dl-assert! db (ev-qwindow-fact qs qe))
|
|
(let
|
|
((rows (dl-query db (list (quote busy_in) actor (quote QS) (quote QE)))))
|
|
(begin (dl-retract! db (ev-qwindow-fact qs qe)) (empty? rows))))))
|