diff --git a/lib/events/calendar.sx b/lib/events/calendar.sx new file mode 100644 index 00000000..cb32e7ae --- /dev/null +++ b/lib/events/calendar.sx @@ -0,0 +1,314 @@ +;; lib/events/calendar.sx — civil date arithmetic + RRULE expansion in a window. +;; +;; Datetimes are integer "epoch minutes": days-since-1970-01-01 * 1440 plus +;; minute-of-day. Ordering, window bounds, and durations are plain integer +;; arithmetic. Civil <-> day-number conversion uses Howard Hinnant's algorithm +;; (exact, branch-free, correct for the proleptic Gregorian calendar). +;; +;; RRULE expansion is the bridge to Datalog: a recurring event expands to a +;; bounded list of occurrence dicts within an explicit (win-start, win-end) +;; window. Expansion is ALWAYS windowed — an RRULE without a window is an +;; infinite computation and is never permitted. Supported subset (RFC 5545): +;; FREQ=DAILY|WEEKLY, INTERVAL, COUNT, UNTIL, BYDAY (weekly). MONTHLY and the +;; rest are deferred. + +;; ---- integer helpers ---- + +;; Floored integer division (modulo is already floored, so the remainder +;; subtraction makes the quotient exact and floor-correct for any sign). +(define ev-floor-div (fn (a b) (quotient (- a (modulo a b)) b))) + +(define ev-or (fn (x d) (if (nil? x) d x))) + +;; ---- civil date core (Hinnant) ---- + +;; Days since 1970-01-01 for civil (y, m, d). m in [1,12], d in [1,31]. +(define + ev-days-from-civil + (fn + (y0 m d) + (let + ((y (if (<= m 2) (- y0 1) y0))) + (let + ((era (ev-floor-div (if (>= y 0) y (- y 399)) 400))) + (let + ((yoe (- y (* era 400))) + (doy + (+ + (ev-floor-div + (+ + (* + 153 + (+ m (if (> m 2) -3 9))) + 2) + 5) + (- d 1)))) + (let + ((doe (+ (* yoe 365) (ev-floor-div yoe 4) (- (ev-floor-div yoe 100)) doy))) + (+ (* era 146097) doe -719468))))))) + +;; Civil (y m d) list from a day-number. +(define + ev-civil-from-days + (fn + (z0) + (let + ((z (+ z0 719468))) + (let + ((era (ev-floor-div (if (>= z 0) z (- z 146096)) 146097))) + (let + ((doe (- z (* era 146097)))) + (let + ((yoe (ev-floor-div (+ (- doe (ev-floor-div doe 1460)) (ev-floor-div doe 36524) (- (ev-floor-div doe 146096))) 365))) + (let + ((y (+ yoe (* era 400))) + (doy + (- + doe + (+ + (* 365 yoe) + (ev-floor-div yoe 4) + (- (ev-floor-div yoe 100)))))) + (let + ((mp (ev-floor-div (+ (* 5 doy) 2) 153))) + (let + ((d (+ (- doy (ev-floor-div (+ (* 153 mp) 2) 5)) 1)) + (m + (if + (< mp 10) + (+ mp 3) + (- mp 9)))) + (list (if (<= m 2) (+ y 1) y) m d)))))))))) + +;; Weekday of a day-number: 0=Mon .. 6=Sun (1970-01-01 is Thursday = 3). +(define ev-weekday-of-days (fn (z) (modulo (+ z 3) 7))) + +;; ---- datetime (epoch minutes) ---- + +(define + ev-dt + (fn + (y m d hh mm) + (+ (* (ev-days-from-civil y m d) 1440) (* hh 60) mm))) + +(define ev-date (fn (y m d) (ev-dt y m d 0 0))) + +(define ev-dt->days (fn (t) (ev-floor-div t 1440))) + +(define ev-dt->civil (fn (t) (ev-civil-from-days (ev-dt->days t)))) + +(define ev-dt-weekday (fn (t) (ev-weekday-of-days (ev-dt->days t)))) + +(define ev-dt-tod (fn (t) (modulo t 1440))) + +;; ---- event + occurrence constructors ---- + +;; rrule is nil (single event) or a dict: +;; {:freq :daily|:weekly :interval N :count N|nil :until DT|nil +;; :byday (list 0 2 4)|nil} ; byday weekday numbers, 0=Mon +(define ev-event (fn (id dtstart duration rrule capacity) {:duration duration :id id :dtstart dtstart :capacity capacity :rrule rrule})) + +(define ev-occ (fn (id start dur) {:id id :start start :end (+ start dur)})) + +;; ---- DAILY expansion ---- +;; occ starts at dtstart; n counts every generated occurrence (window- +;; independent, so COUNT/UNTIL bound the rule, not the view). Emits only +;; occurrences inside [win-start, win-end]. +(define + ev-daily-loop + (fn + (id occ duration step count until dtstart win-start win-end acc n) + (cond + ((> occ win-end) acc) + ((and (not (nil? count)) (>= n count)) acc) + ((and (not (nil? until)) (> occ until)) acc) + (else + (begin + (when (>= occ win-start) (append! acc (ev-occ id occ duration))) + (ev-daily-loop + id + (+ occ step) + duration + step + count + until + dtstart + win-start + win-end + acc + (+ n 1))))))) + +;; ---- WEEKLY expansion ---- +;; Iterate week by week from the Monday of dtstart's week. Within each active +;; week emit each BYDAY (sorted) whose datetime is >= dtstart and inside the +;; window. n counts every generated occurrence >= dtstart for COUNT. + +(define + ev-week0-days + (fn (dtstart) (- (ev-dt->days dtstart) (ev-dt-weekday dtstart)))) + +(define + ev-byday-default + (fn + (byday dtstart) + (if (nil? byday) (list (ev-dt-weekday dtstart)) (sort byday)))) + +(define + ev-weekly-bd-loop + (fn + (id week-days tod duration bd count until dtstart win-start win-end acc n) + (if + (empty? bd) + n + (let + ((wd (first bd))) + (let + ((occ (+ (* (+ week-days wd) 1440) tod))) + (let + ((generates? (and (>= occ dtstart) (or (nil? until) (<= occ until)) (or (nil? count) (< n count))))) + (begin + (when + (and generates? (>= occ win-start) (<= occ win-end)) + (append! acc (ev-occ id occ duration))) + (ev-weekly-bd-loop + id + week-days + tod + duration + (rest bd) + count + until + dtstart + win-start + win-end + acc + (if generates? (+ n 1) n))))))))) + +(define + ev-weekly-loop + (fn + (id + week-days + tod + duration + week-step + bd + count + until + dtstart + win-start + win-end + acc + n) + (let + ((week-start-dt (* week-days 1440))) + (cond + ((> week-start-dt win-end) acc) + ((and (not (nil? count)) (>= n count)) acc) + (else + (let + ((n2 (ev-weekly-bd-loop id week-days tod duration bd count until dtstart win-start win-end acc n))) + (ev-weekly-loop + id + (+ week-days week-step) + tod + duration + week-step + bd + count + until + dtstart + win-start + win-end + acc + n2))))))) + +;; ---- top-level expansion ---- +;; Returns a list of occurrence dicts {:id :start :end} within the window. +(define + ev-expand + (fn + (event win-start win-end) + (let + ((id (get event :id)) + (dtstart (get event :dtstart)) + (duration (get event :duration)) + (rrule (get event :rrule))) + (if + (nil? rrule) + (if + (and (>= dtstart win-start) (<= dtstart win-end)) + (list (ev-occ id dtstart duration)) + (list)) + (let + ((freq (get rrule :freq)) + (interval (ev-or (get rrule :interval) 1)) + (count (get rrule :count)) + (until (get rrule :until)) + (byday (get rrule :byday)) + (acc (list))) + (begin + (cond + ((= freq :daily) + (ev-daily-loop + id + dtstart + duration + (* interval 1440) + count + until + dtstart + win-start + win-end + acc + 0)) + ((= freq :weekly) + (ev-weekly-loop + id + (ev-week0-days dtstart) + (ev-dt-tod dtstart) + duration + (* interval 7) + (ev-byday-default byday dtstart) + count + until + dtstart + win-start + win-end + acc + 0)) + (else (error (str "ev-expand: unsupported freq: " freq)))) + acc)))))) + +;; ---- multi-event expansion (sorted by start) ---- + +;; Insertion of one occurrence into a start-ascending list. +(define + ev-occ-insert + (fn + (o sorted) + (cond + ((empty? sorted) (list o)) + ((<= (get o :start) (get (first sorted) :start)) (cons o sorted)) + (else (cons (first sorted) (ev-occ-insert o (rest sorted))))))) + +(define + ev-sort-occs + (fn (occs) (reduce (fn (acc o) (ev-occ-insert o acc)) (list) occs))) + +;; Expand many events into one occurrence list, ascending by start. +(define + ev-expand-all + (fn + (events win-start win-end) + (let + ((acc (list))) + (begin + (for-each + (fn + (ev) + (for-each + (fn (o) (append! acc o)) + (ev-expand ev win-start win-end))) + events) + (ev-sort-occs acc))))) diff --git a/lib/events/conformance.conf b/lib/events/conformance.conf new file mode 100644 index 00000000..d3d4e73a --- /dev/null +++ b/lib/events/conformance.conf @@ -0,0 +1,23 @@ +# events-on-sx conformance config — sourced by lib/guest/conformance.sh. + +LANG_NAME=events +MODE=dict +SCOREBOARD_DIR=lib/events + +PRELOADS=( + lib/datalog/tokenizer.sx + lib/datalog/parser.sx + lib/datalog/unify.sx + lib/datalog/db.sx + lib/datalog/builtins.sx + lib/datalog/aggregates.sx + lib/datalog/strata.sx + lib/datalog/eval.sx + lib/datalog/api.sx + lib/datalog/magic.sx + lib/events/calendar.sx +) + +SUITES=( + "calendar:lib/events/tests/calendar.sx:(ev-calendar-tests-run!)" +) diff --git a/lib/events/conformance.sh b/lib/events/conformance.sh new file mode 100755 index 00000000..780afb90 --- /dev/null +++ b/lib/events/conformance.sh @@ -0,0 +1,3 @@ +#!/usr/bin/env bash +# Thin wrapper — see lib/guest/conformance.sh and lib/events/conformance.conf. +exec bash "$(dirname "$0")/../guest/conformance.sh" "$(dirname "$0")/conformance.conf" "$@" diff --git a/lib/events/scoreboard.json b/lib/events/scoreboard.json new file mode 100644 index 00000000..7e6b990a --- /dev/null +++ b/lib/events/scoreboard.json @@ -0,0 +1,10 @@ +{ + "lang": "events", + "total_passed": 24, + "total_failed": 0, + "total": 24, + "suites": [ + {"name":"calendar","passed":24,"failed":0,"total":24} + ], + "generated": "2026-06-06T23:48:10+00:00" +} diff --git a/lib/events/scoreboard.md b/lib/events/scoreboard.md new file mode 100644 index 00000000..331a9355 --- /dev/null +++ b/lib/events/scoreboard.md @@ -0,0 +1,7 @@ +# events scoreboard + +**24 / 24 passing** (0 failure(s)). + +| Suite | Passed | Total | Status | +|-------|--------|-------|--------| +| calendar | 24 | 24 | ok | diff --git a/lib/events/tests/calendar.sx b/lib/events/tests/calendar.sx new file mode 100644 index 00000000..59f82476 --- /dev/null +++ b/lib/events/tests/calendar.sx @@ -0,0 +1,299 @@ +;; lib/events/tests/calendar.sx — civil date core + RRULE window expansion. + +(define ev-cal-pass 0) +(define ev-cal-fail 0) +(define ev-cal-failures (list)) + +(define + ev-cal-check! + (fn + (name got expected) + (if + (= got expected) + (set! ev-cal-pass (+ ev-cal-pass 1)) + (do + (set! ev-cal-fail (+ ev-cal-fail 1)) + (append! + ev-cal-failures + (str name "\n expected: " expected "\n got: " got)))))) + +;; Project occurrences to (civil weekday) pairs for legible assertions. +(define + ev-cal-shape + (fn + (occs) + (map + (fn + (o) + (list (ev-dt->civil (get o :start)) (ev-dt-weekday (get o :start)))) + occs))) + +(define + ev-cal-starts + (fn (occs) (map (fn (o) (ev-dt->civil (get o :start))) occs))) + +(define + ev-cal-run-all! + (fn + () + (do + (ev-cal-check! + "epoch day zero" + (ev-days-from-civil 1970 1 1) + 0) + (ev-cal-check! + "y2k day number" + (ev-days-from-civil 2000 1 1) + 10957) + (ev-cal-check! + "leap day round trip" + (ev-civil-from-days + (ev-days-from-civil 2024 2 29)) + (list 2024 2 29)) + (ev-cal-check! + "pre-epoch round trip" + (ev-civil-from-days + (ev-days-from-civil 1969 12 31)) + (list 1969 12 31)) + (ev-cal-check! + "epoch is thursday" + (ev-weekday-of-days 0) + 3) + (ev-cal-check! + "2026-06-06 is saturday" + (ev-dt-weekday (ev-date 2026 6 6)) + 5) + (ev-cal-check! + "dt carries time of day" + (ev-dt-tod + (ev-dt 2026 6 1 9 30)) + 570) + (ev-cal-check! + "civil from dt" + (ev-dt->civil + (ev-dt 2026 12 25 8 0)) + (list 2026 12 25)) + (let + ((ev (ev-event (quote one) (ev-dt 2026 6 10 14 0) 60 nil 1))) + (do + (ev-cal-check! + "single inside window emits once" + (len + (ev-expand + ev + (ev-date 2026 6 1) + (ev-date 2026 7 1))) + 1) + (ev-cal-check! + "single before window omitted" + (len + (ev-expand + ev + (ev-date 2026 7 1) + (ev-date 2026 8 1))) + 0) + (ev-cal-check! + "single after window omitted" + (len + (ev-expand + ev + (ev-date 2026 1 1) + (ev-date 2026 2 1))) + 0) + (ev-cal-check! + "occurrence end is start plus duration" + (get + (first + (ev-expand + ev + (ev-date 2026 6 1) + (ev-date 2026 7 1))) + :end) + (+ + (ev-dt 2026 6 10 14 0) + 60)))) + (let + ((daily (ev-event (quote d) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 5} 1))) + (do + (ev-cal-check! + "daily count caps occurrences" + (ev-cal-starts + (ev-expand + daily + (ev-date 2026 6 1) + (ev-date 2026 7 1))) + (list + (list 2026 6 1) + (list 2026 6 2) + (list 2026 6 3) + (list 2026 6 4) + (list 2026 6 5))) + (ev-cal-check! + "daily preserves time of day" + (ev-dt-tod + (get + (first + (ev-expand + daily + (ev-date 2026 6 1) + (ev-date 2026 7 1))) + :start)) + 540))) + (let + ((di (ev-event (quote di) (ev-dt 2026 6 1 0 0) 30 {:interval 3 :freq :daily :until (ev-date 2026 6 30)} 1))) + (ev-cal-check! + "daily interval 3 steps by three days" + (ev-cal-starts + (ev-expand + di + (ev-date 2026 6 1) + (ev-date 2026 6 13))) + (list + (list 2026 6 1) + (list 2026 6 4) + (list 2026 6 7) + (list 2026 6 10) + (list 2026 6 13)))) + (let + ((dc (ev-event (quote dc) (ev-dt 2026 6 1 0 0) 30 {:freq :daily :count 10} 1))) + (ev-cal-check! + "count is window-independent (clip middle)" + (ev-cal-starts + (ev-expand + dc + (ev-date 2026 6 5) + (ev-date 2026 6 8))) + (list + (list 2026 6 5) + (list 2026 6 6) + (list 2026 6 7) + (list 2026 6 8)))) + (let + ((dc2 (ev-event (quote dc2) (ev-dt 2026 6 1 0 0) 30 {:freq :daily :count 3} 1))) + (ev-cal-check! + "count exhausted before window yields nothing" + (len + (ev-expand + dc2 + (ev-date 2026 6 10) + (ev-date 2026 6 20))) + 0)) + (let + ((wk (ev-event (quote w) (ev-dt 2026 6 1 18 0) 90 {:freq :weekly :byday (list 0 2 4)} 1))) + (ev-cal-check! + "weekly byday mon/wed/fri first two weeks" + (ev-cal-shape + (ev-expand + wk + (ev-date 2026 6 1) + (ev-date 2026 6 13))) + (list + (list (list 2026 6 1) 0) + (list (list 2026 6 3) 2) + (list (list 2026 6 5) 4) + (list (list 2026 6 8) 0) + (list (list 2026 6 10) 2) + (list (list 2026 6 12) 4)))) + (let + ((wu (ev-event (quote wu) (ev-dt 2026 6 1 18 0) 90 {:freq :weekly :until (ev-dt 2026 6 10 23 0) :byday (list 0 2)} 1))) + (ev-cal-check! + "weekly until clips trailing occurrences" + (ev-cal-starts + (ev-expand + wu + (ev-date 2026 6 1) + (ev-date 2026 7 1))) + (list + (list 2026 6 1) + (list 2026 6 3) + (list 2026 6 8) + (list 2026 6 10)))) + (let + ((wi (ev-event (quote wi) (ev-dt 2026 6 1 18 0) 90 {:interval 2 :freq :weekly :byday (list 0)} 1))) + (ev-cal-check! + "weekly interval 2 skips alternate weeks" + (ev-cal-starts + (ev-expand + wi + (ev-date 2026 6 1) + (ev-date 2026 7 6))) + (list + (list 2026 6 1) + (list 2026 6 15) + (list 2026 6 29)))) + (let + ((wd (ev-event (quote wd) (ev-dt 2026 6 3 12 0) 60 {:freq :weekly :count 3} 1))) + (ev-cal-check! + "weekly default byday is dtstart weekday" + (ev-cal-shape + (ev-expand + wd + (ev-date 2026 6 1) + (ev-date 2026 8 1))) + (list + (list (list 2026 6 3) 2) + (list (list 2026 6 10) 2) + (list (list 2026 6 17) 2)))) + (let + ((wc (ev-event (quote wc) (ev-dt 2026 6 1 18 0) 90 {:freq :weekly :count 10 :byday (list 0 2)} 1))) + (ev-cal-check! + "weekly count window-independent (clip middle)" + (ev-cal-starts + (ev-expand + wc + (ev-date 2026 6 15) + (ev-date 2026 7 5))) + (list + (list 2026 6 15) + (list 2026 6 17) + (list 2026 6 22) + (list 2026 6 24) + (list 2026 6 29) + (list 2026 7 1)))) + (let + ((wf (ev-event (quote wf) (ev-dt 2026 6 3 18 0) 90 {:freq :weekly :count 4 :byday (list 0 2 4)} 1))) + (ev-cal-check! + "first week skips byday earlier than dtstart" + (ev-cal-starts + (ev-expand + wf + (ev-date 2026 6 1) + (ev-date 2026 7 1))) + (list + (list 2026 6 3) + (list 2026 6 5) + (list 2026 6 8) + (list 2026 6 10)))) + (let + ((a (ev-event (quote a) (ev-dt 2026 6 2 10 0) 30 {:freq :daily :count 2} 1)) + (b + (ev-event + (quote b) + (ev-dt 2026 6 1 9 0) + 30 + {:freq :daily :count 2} + 1))) + (ev-cal-check! + "expand-all sorts merged occurrences by start" + (map + (fn (o) (list (get o :id) (ev-dt->civil (get o :start)))) + (ev-expand-all + (list a b) + (ev-date 2026 6 1) + (ev-date 2026 7 1))) + (list + (list (quote b) (list 2026 6 1)) + (list (quote b) (list 2026 6 2)) + (list (quote a) (list 2026 6 2)) + (list (quote a) (list 2026 6 3)))))))) + +(define + ev-calendar-tests-run! + (fn + () + (do + (set! ev-cal-pass 0) + (set! ev-cal-fail 0) + (set! ev-cal-failures (list)) + (ev-cal-run-all!) + {:failures ev-cal-failures :total (+ ev-cal-pass ev-cal-fail) :passed ev-cal-pass :failed ev-cal-fail}))) diff --git a/plans/events-on-sx.md b/plans/events-on-sx.md index c5178db5..a831c535 100644 --- a/plans/events-on-sx.md +++ b/plans/events-on-sx.md @@ -18,7 +18,7 @@ capacity rules, transactional booking, and a flow-driven notification dispatcher ## Status (rolling) -`bash lib/events/conformance.sh` → **0/0** (not yet started) +`bash lib/events/conformance.sh` → **24/24** (Phase 1: calendar recurrence) ## Ground rules @@ -54,7 +54,8 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── ``` ## Phase 1 — Calendar + recurrence -- [ ] `calendar.sx` — event facts, RRULE expansion in a window +- [x] `calendar.sx` — event facts, RRULE expansion in a window (DAILY/WEEKLY) +- [ ] `calendar.sx` — MONTHLY (bymonthday + nth-weekday byday) - [ ] `availability.sx` — free/busy rules - [ ] `api.sx` + tests + scoreboard + conformance.sh @@ -75,7 +76,15 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── - [ ] tests: federated agenda merge ## Progress log -(loop fills this in) + +- 2026-06-06 — Phase 1 scaffold + calendar recurrence. `calendar.sx`: integer + epoch-minute datetimes, Hinnant civil<->day-number conversion, DAILY/WEEKLY + RRULE expansion in a bounded (start,end) window with INTERVAL, COUNT (window- + independent), UNTIL, BYDAY (weekly). `ev-expand-all` merges + sorts. Wired + conformance harness (conf + thin wrapper reusing `lib/guest/conformance.sh`), + scoreboard. 24/24 green. MONTHLY deferred to next commit. ## Blockers -(loop fills this in) + +- None. Substrates present: `lib/datalog` (276/276), `lib/persist`, `lib/flow` + all exist — Phase 2/3 unblocked when reached.