rose-ash/lib/events/timezone.sx

;; lib/events/timezone.sx — timezones + DST for the calendar.
;;
;; Datetimes in calendar.sx are naive epoch-minutes (wall clock). A timezone
;; maps between wall-clock LOCAL time and absolute UTC. An event is authored in
;; local time + a tz; recurrence is expanded in local time (so a "09:00 weekly"
;; meeting stays 09:00 across a DST change), then each occurrence is converted
;; to UTC for storage/comparison.
;;
;; Offset convention: offset = local - utc (minutes). London summer (BST) = +60.
;; UTC = local - offset; local = utc + offset.
;;
;; Two kinds of zone, no IANA database:
;;   :fixed  — a constant offset.
;;   :dst    — std/dst offsets + two transition rules. Transitions are given in
;;             UTC (EU zones all switch at 01:00 UTC), so the offset at any UTC
;;             instant is a direct range check; no recursion. Northern-hemisphere
;;             ordering (dst-start < dst-end within a year) is assumed.
;;
;; Requires calendar.sx (ev-dt, ev-days-from-civil, ev-civil-from-days,
;; ev-civ-y, ev-floor-div, ev-resolve-nth-weekday).

;; A DST transition rule: the ord-th weekday `wd` (0=Mon..6=Sun) of `month`, at
;; `time` minutes-of-day UTC. EU: last Sunday (ord -1, wd 6) at 01:00 UTC.
(define ev-tz-rule (fn (month ord wd time) {:ord ord :wd wd :month month :time time}))

(define ev-tz-fixed (fn (name offset) {:name name :offset offset :kind :fixed}))

(define ev-tz-dst (fn (name std dst start-rule end-rule) {:name name :kind :dst :dst-end end-rule :dst-start start-rule :std-offset std :dst-offset dst}))

;; Standard (winter) offset — the initial guess when inverting local -> utc.
(define
  ev-tz-std-offset
  (fn
    (tz)
    (if (= (get tz :kind) :fixed) (get tz :offset) (get tz :std-offset))))

;; The UTC instant (epoch-minutes) of a transition rule in a given year.
(define
  ev-tz-transition
  (fn
    (year rule)
    (let
      ((day (ev-resolve-nth-weekday year (get rule :month) (get rule :ord) (get rule :wd))))
      (+
        (* (ev-days-from-civil year (get rule :month) day) 1440)
        (get rule :time)))))

;; The offset (minutes) in effect at a UTC instant.
(define
  ev-tz-offset
  (fn
    (tz utc-dt)
    (cond
      ((= (get tz :kind) :fixed) (get tz :offset))
      ((= (get tz :kind) :dst)
        (let
          ((year (ev-civ-y (ev-civil-from-days (ev-floor-div utc-dt 1440)))))
          (let
            ((start (ev-tz-transition year (get tz :dst-start)))
              (end (ev-tz-transition year (get tz :dst-end))))
            (if
              (and (>= utc-dt start) (< utc-dt end))
              (get tz :dst-offset)
              (get tz :std-offset)))))
      (else 0))))

;; UTC instant -> local wall-clock.
(define
  ev-tz-utc->local
  (fn (tz utc-dt) (+ utc-dt (ev-tz-offset tz utc-dt))))

;; Local wall-clock -> UTC instant. The offset depends on the instant, so we
;; guess with the standard offset and refine once (correct except within the
;; one-hour DST gap/overlap, where it resolves to the pre-transition offset).
(define
  ev-tz-local->utc
  (fn
    (tz local-dt)
    (let
      ((utc1 (- local-dt (ev-tz-offset tz (- local-dt (ev-tz-std-offset tz))))))
      (- local-dt (ev-tz-offset tz utc1)))))

;; ---- predefined zones ----
(define ev-tz-utc (ev-tz-fixed "UTC" 0))
(define
  ev-tz-london
  (ev-tz-dst
    "Europe/London"
    0
    60
    (ev-tz-rule 3 -1 6 60)
    (ev-tz-rule 10 -1 6 60)))
(define
  ev-tz-paris
  (ev-tz-dst
    "Europe/Paris"
    60
    120
    (ev-tz-rule 3 -1 6 60)
    (ev-tz-rule 10 -1 6 60)))

;; ---- tz-aware event expansion ----

;; An event authored in local time + a tz. dtstart-local / rrule / exceptions
;; are all wall-clock in `tz`; expansion converts each occurrence to UTC.
(define
  ev-event-tz
  (fn (id dtstart-local duration rrule capacity tz) {:id id :duration duration :dtstart dtstart-local :rrule rrule :capacity capacity :tz tz}))

;; Expand a tz-aware event over a UTC window. Local recurrence is expanded over
;; a window widened by a day each side (to catch occurrences whose UTC lands in
;; range), converted to UTC, then filtered to [win-start, win-end].
(define
  ev-expand-tz
  (fn
    (event tz win-start win-end)
    (let
      ((local-ws (- (ev-tz-utc->local tz win-start) 1440))
        (local-we (+ (ev-tz-utc->local tz win-end) 1440)))
      (let
        ((local-occs (ev-expand-naive event local-ws local-we)))
        (let
          ((utc-occs (map (fn (o) (let ((u (ev-tz-local->utc tz (get o :start))) (dur (- (get o :end) (get o :start)))) {:id (get o :id) :start u :end (+ u dur)})) local-occs)))
          (ev-sort-occs
            (filter
              (fn
                (o)
                (and
                  (>= (get o :start) win-start)
                  (<= (get o :start) win-end)))
              utc-occs)))))))