rose-ash/lib/events/ical.sx

;; lib/events/ical.sx — iCalendar (RFC 5545) export.
;;
;; Serializes events to VEVENT / VCALENDAR text so a rose-ash calendar can be
;; imported by any standard client (Google/Apple/Outlook). Datetimes are UTC
;; epoch-minutes, emitted as basic-format UTC stamps (YYYYMMDDTHHMM00Z). The
;; full RRULE / EXDATE / RDATE model maps directly to the standard properties.
;;
;; Export is line-oriented: `ev/event->ical-lines` returns the VEVENT as a list
;; of content lines (no folding/CRLF — easy to assert on); `ev/ical-render`
;; joins lines with CRLF, the on-the-wire format. Requires calendar.sx.

;; ---- formatting helpers ----

(define ev-ical-pad2 (fn (n) (if (< n 10) (str "0" n) (str n))))

(define
  ev-ical-pad4
  (fn
    (n)
    (cond
      ((< n 10) (str "000" n))
      ((< n 100) (str "00" n))
      ((< n 1000) (str "0" n))
      (else (str n)))))

(define
  ev-ical-nth
  (fn
    (xs i)
    (if
      (= i 0)
      (first xs)
      (ev-ical-nth (rest xs) (- i 1)))))

(define
  ev-ical-join
  (fn
    (parts sep)
    (if
      (empty? parts)
      ""
      (reduce (fn (acc p) (str acc sep p)) (first parts) (rest parts)))))

;; A UTC epoch-minute as an iCal basic-format UTC stamp.
(define
  ev-ical-dt
  (fn
    (t)
    (let
      ((civ (ev-dt->civil t)) (tod (ev-dt-tod t)))
      (str
        (ev-ical-pad4 (ev-civ-y civ))
        (ev-ical-pad2 (ev-civ-m civ))
        (ev-ical-pad2 (ev-civ-d civ))
        "T"
        (ev-ical-pad2 (quotient tod 60))
        (ev-ical-pad2 (modulo tod 60))
        "00Z"))))

;; A duration in minutes as an iCal DURATION value (PT#H#M).
(define
  ev-ical-duration
  (fn
    (mins)
    (let
      ((h (quotient mins 60)) (m (modulo mins 60)))
      (cond
        ((and (> h 0) (> m 0)) (str "PT" h "H" m "M"))
        ((> h 0) (str "PT" h "H"))
        (else (str "PT" m "M"))))))

(define
  ev-ical-wd
  (fn (w) (ev-ical-nth (list "MO" "TU" "WE" "TH" "FR" "SA" "SU") w)))

(define
  ev-ical-freq
  (fn
    (f)
    (cond
      ((= f :daily) "DAILY")
      ((= f :weekly) "WEEKLY")
      ((= f :monthly) "MONTHLY")
      (else "DAILY"))))

;; One BYDAY token: a weekly weekday number -> "MO"; a monthly ordinal weekday
;; {:ord :wd} -> "2TU" / "-1FR".
(define
  ev-ical-byday-token
  (fn
    (e)
    (if
      (dict? e)
      (str (get e :ord) (ev-ical-wd (get e :wd)))
      (ev-ical-wd e))))

;; A datetime converter for an event: tz-aware events store wall-clock LOCAL
;; times, so export converts them to UTC (the `Z` stamps are absolute);
;; non-tz events pass through unchanged.
;;   CAVEAT: a UTC RRULE recurs at a fixed UTC offset, whereas a tz event's
;;   expansion stays wall-clock-stable across DST — so for a tz recurrence that
;;   crosses a DST boundary the exported series drifts by the offset change
;;   after the boundary. DTSTART and each individual stamp are correct; full
;;   fidelity would need a VTIMEZONE block (deferred).
(define
  ev-ical-conv
  (fn
    (event)
    (let
      ((tz (get event :tz)))
      (if (nil? tz) (fn (t) t) (fn (t) (ev-tz-local->utc tz t))))))

;; ---- RRULE ----
(define
  ev-ical-rrule
  (fn
    (rrule conv)
    (let
      ((parts (list (str "FREQ=" (ev-ical-freq (get rrule :freq))))))
      (begin
        (when
          (and
            (not (nil? (get rrule :interval)))
            (> (get rrule :interval) 1))
          (append! parts (str "INTERVAL=" (get rrule :interval))))
        (when
          (not (nil? (get rrule :count)))
          (append! parts (str "COUNT=" (get rrule :count))))
        (when
          (not (nil? (get rrule :until)))
          (append! parts (str "UNTIL=" (ev-ical-dt (conv (get rrule :until))))))
        (when
          (not (nil? (get rrule :byday)))
          (append!
            parts
            (str
              "BYDAY="
              (ev-ical-join (map ev-ical-byday-token (get rrule :byday)) ","))))
        (when
          (not (nil? (get rrule :bymonthday)))
          (append!
            parts
            (str
              "BYMONTHDAY="
              (ev-ical-join
                (map (fn (d) (str d)) (get rrule :bymonthday))
                ","))))
        (str "RRULE:" (ev-ical-join parts ";"))))))

;; ---- VEVENT / VCALENDAR ----

;; The VEVENT content lines for an event (list of strings).
(define
  ev/event->ical-lines
  (fn
    (event)
    (let
      ((lines (list "BEGIN:VEVENT")) (conv (ev-ical-conv event)))
      (begin
        (append! lines (str "UID:" (get event :id)))
        (append! lines (str "SUMMARY:" (get event :id)))
        (append! lines (str "DTSTART:" (ev-ical-dt (conv (get event :dtstart)))))
        (append!
          lines
          (str "DURATION:" (ev-ical-duration (get event :duration))))
        (when
          (not (nil? (get event :rrule)))
          (append! lines (ev-ical-rrule (get event :rrule) conv)))
        (when
          (and
            (not (nil? (get event :exdate)))
            (> (len (get event :exdate)) 0))
          (append!
            lines
            (str
              "EXDATE:"
              (ev-ical-join (map (fn (d) (ev-ical-dt (conv d))) (get event :exdate)) ","))))
        (when
          (and
            (not (nil? (get event :rdate)))
            (> (len (get event :rdate)) 0))
          (append!
            lines
            (str
              "RDATE:"
              (ev-ical-join (map (fn (d) (ev-ical-dt (conv d))) (get event :rdate)) ","))))
        (append! lines "END:VEVENT")
        lines))))

;; A full VCALENDAR (list of content lines) wrapping every event.
(define
  ev/events->ical-lines
  (fn
    (events)
    (let
      ((lines (list "BEGIN:VCALENDAR" "VERSION:2.0" "PRODID:-//rose-ash//events-on-sx//EN")))
      (begin
        (for-each
          (fn
            (ev)
            (for-each (fn (l) (append! lines l)) (ev/event->ical-lines ev)))
          events)
        (append! lines "END:VCALENDAR")
        lines))))

;; Render content lines to the on-the-wire iCalendar text (CRLF-separated).
(define ev/ical-render (fn (lines) (ev-ical-join lines "\r\n")))

;; ---- import (parse VEVENT/VCALENDAR back into events) ----
;; Inverse of the export above: parse iCalendar content lines into event dicts
;; (ev-event-full shape). Capacity is not an iCal property, so imported events
;; default to capacity 0 — set it after import if needed.

;; "20260601T180000Z" -> UTC epoch-minutes.
(define
  ev-ical-parse-dt
  (fn
    (s)
    (ev-dt
      (string->number (substring s 0 4))
      (string->number (substring s 4 6))
      (string->number (substring s 6 8))
      (string->number (substring s 9 11))
      (string->number (substring s 11 13)))))

;; "30M" / "" -> minutes.
(define
  ev-ical-parse-min
  (fn
    (s)
    (if (= (string-length s) 0) 0 (string->number (first (split s "M"))))))

;; "PT1H30M" / "PT1H" / "PT30M" -> minutes.
(define
  ev-ical-parse-duration
  (fn
    (s)
    (let
      ((body (substring s 2 (string-length s))))
      (let
        ((hparts (split body "H")))
        (if
          (> (len hparts) 1)
          (+ (* 60 (string->number (first hparts))) (ev-ical-parse-min (first (rest hparts))))
          (ev-ical-parse-min body))))))

(define
  ev-ical-wd->num
  (fn
    (tok)
    (cond
      ((= tok "MO") 0)
      ((= tok "TU") 1)
      ((= tok "WE") 2)
      ((= tok "TH") 3)
      ((= tok "FR") 4)
      ((= tok "SA") 5)
      ((= tok "SU") 6)
      (else 0))))

;; "MO" -> 0 ; "2TU" -> {:ord 2 :wd 1} ; "-1FR" -> {:ord -1 :wd 4}
(define
  ev-ical-parse-byday-token
  (fn
    (tok)
    (let
      ((n (string-length tok)))
      (if
        (= n 2)
        (ev-ical-wd->num tok)
        {:ord (string->number (substring tok 0 (- n 2)))
          :wd (ev-ical-wd->num (substring tok (- n 2) n))}))))

(define
  ev-ical-parse-freq
  (fn
    (v)
    (cond
      ((= v "DAILY") :daily)
      ((= v "WEEKLY") :weekly)
      ((= v "MONTHLY") :monthly)
      (else :daily))))

;; "FREQ=WEEKLY;INTERVAL=2;UNTIL=...;BYDAY=MO,WE" -> rrule dict.
(define
  ev-ical-parse-rrule
  (fn
    (val)
    (let
      ((rr {}))
      (begin
        (for-each
          (fn
            (p)
            (let
              ((kv (split p "=")))
              (let
                ((k (first kv)) (v (first (rest kv))))
                (cond
                  ((= k "FREQ") (dict-set! rr :freq (ev-ical-parse-freq v)))
                  ((= k "INTERVAL") (dict-set! rr :interval (string->number v)))
                  ((= k "COUNT") (dict-set! rr :count (string->number v)))
                  ((= k "UNTIL") (dict-set! rr :until (ev-ical-parse-dt v)))
                  ((= k "BYDAY") (dict-set! rr :byday (map ev-ical-parse-byday-token (split v ","))))
                  ((= k "BYMONTHDAY") (dict-set! rr :bymonthday (map string->number (split v ","))))
                  (else nil)))))
          (split val ";"))
        rr))))

;; Parse a VEVENT's content lines into an event dict.
(define
  ev/ical-lines->event
  (fn
    (lines)
    (let
      ((ev {:capacity 0 :rrule nil}) (exd (list)) (rd (list)))
      (begin
        (for-each
          (fn
            (line)
            (let
              ((kv (split line ":")))
              (when
                (> (len kv) 1)
                (let
                  ((k (first kv)) (v (first (rest kv))))
                  (cond
                    ((= k "UID") (dict-set! ev :id (string->symbol v)))
                    ((= k "DTSTART") (dict-set! ev :dtstart (ev-ical-parse-dt v)))
                    ((= k "DURATION") (dict-set! ev :duration (ev-ical-parse-duration v)))
                    ((= k "RRULE") (dict-set! ev :rrule (ev-ical-parse-rrule v)))
                    ((= k "EXDATE") (set! exd (map ev-ical-parse-dt (split v ","))))
                    ((= k "RDATE") (set! rd (map ev-ical-parse-dt (split v ","))))
                    (else nil))))))
          lines)
        (dict-set! ev :exdate exd)
        (dict-set! ev :rdate rd)
        ev))))

;; Split a VCALENDAR line list into per-VEVENT line groups.
(define
  ev-ical-group-vevents
  (fn
    (lines cur in acc)
    (cond
      ((empty? lines) acc)
      ((= (first lines) "BEGIN:VEVENT") (ev-ical-group-vevents (rest lines) (list) true acc))
      ((= (first lines) "END:VEVENT") (ev-ical-group-vevents (rest lines) (list) false (append acc (list cur))))
      (in (ev-ical-group-vevents (rest lines) (append cur (list (first lines))) true acc))
      (else (ev-ical-group-vevents (rest lines) cur false acc)))))

;; Parse a VCALENDAR line list into a list of events.
(define
  ev/parse-vcalendar
  (fn
    (lines)
    (map ev/ical-lines->event (ev-ical-group-vevents lines (list) false (list)))))