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

;; ---- RRULE ----
(define
  ev-ical-rrule
  (fn
    (rrule)
    (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 (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")))
      (begin
        (append! lines (str "UID:" (get event :id)))
        (append! lines (str "SUMMARY:" (get event :id)))
        (append! lines (str "DTSTART:" (ev-ical-dt (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))))
        (when
          (and
            (not (nil? (get event :exdate)))
            (> (len (get event :exdate)) 0))
          (append!
            lines
            (str
              "EXDATE:"
              (ev-ical-join (map ev-ical-dt (get event :exdate)) ","))))
        (when
          (and
            (not (nil? (get event :rdate)))
            (> (len (get event :rdate)) 0))
          (append!
            lines
            (str
              "RDATE:"
              (ev-ical-join (map ev-ical-dt (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")))