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