rose-ash/lib/events/calendar.sx

;; 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)))))