rose-ash/lib/events/tests/ical.sx

;; lib/events/tests/ical.sx — iCalendar (RFC 5545) export.

(define ev-ic-pass 0)
(define ev-ic-fail 0)
(define ev-ic-failures (list))

(define
  ev-ic-check!
  (fn
    (name got expected)
    (if
      (= got expected)
      (set! ev-ic-pass (+ ev-ic-pass 1))
      (do
        (set! ev-ic-fail (+ ev-ic-fail 1))
        (append!
          ev-ic-failures
          (str name "\n    expected: " expected "\n    got:      " got))))))

;; Find the value of a "KEY:value" line in a VEVENT line list (or nil).
(define
  ev-ic-line
  (fn
    (lines key)
    (cond
      ((empty? lines) nil)
      ((ev-ic-prefix? (first lines) (str key ":")) (first lines))
      (else (ev-ic-line (rest lines) key)))))

(define
  ev-ic-prefix?
  (fn
    (s p)
    (and (>= (len s) (len p)) (= (substring s 0 (len p)) p))))

(define
  ev-ic-run-all!
  (fn
    ()
    (do
      (let
        ((lines (ev/event->ical-lines (ev-event (quote one) (ev-dt 2026 6 10 14 0) 60 nil 1))))
        (do
          (ev-ic-check! "VEVENT opens" (first lines) "BEGIN:VEVENT")
          (ev-ic-check! "VEVENT closes" (ev-ic-line lines "END") "END:VEVENT")
          (ev-ic-check!
            "UID is the event id"
            (ev-ic-line lines "UID")
            "UID:one")
          (ev-ic-check!
            "DTSTART is a UTC basic-format stamp"
            (ev-ic-line lines "DTSTART")
            "DTSTART:20260610T140000Z")
          (ev-ic-check!
            "DURATION of 60m is PT1H"
            (ev-ic-line lines "DURATION")
            "DURATION:PT1H")
          (ev-ic-check!
            "a one-off event has no RRULE"
            (ev-ic-line lines "RRULE")
            nil)))
      (ev-ic-check!
        "30m duration is PT30M"
        (ev-ic-line
          (ev/event->ical-lines
            (ev-event
              (quote e)
              (ev-dt 2026 1 1 9 0)
              30
              nil
              1))
          "DURATION")
        "DURATION:PT30M")
      (ev-ic-check!
        "90m duration is PT1H30M"
        (ev-ic-line
          (ev/event->ical-lines
            (ev-event
              (quote e)
              (ev-dt 2026 1 1 9 0)
              90
              nil
              1))
          "DURATION")
        "DURATION:PT1H30M")
      (let
        ((lines (ev/event->ical-lines (ev-event-full (quote yoga) (ev-dt 2026 6 1 18 0) 90 {:interval 2 :freq :weekly :until (ev-dt 2026 6 30 23 0) :byday (list 0 2)} 20 (list (ev-dt 2026 6 8 18 0)) (list (ev-dt 2026 6 20 18 0))))))
        (do
          (ev-ic-check!
            "weekly RRULE serializes interval/until/byday in order"
            (ev-ic-line lines "RRULE")
            "RRULE:FREQ=WEEKLY;INTERVAL=2;UNTIL=20260630T230000Z;BYDAY=MO,WE")
          (ev-ic-check!
            "EXDATE line"
            (ev-ic-line lines "EXDATE")
            "EXDATE:20260608T180000Z")
          (ev-ic-check!
            "RDATE line"
            (ev-ic-line lines "RDATE")
            "RDATE:20260620T180000Z")))
      (ev-ic-check!
        "daily COUNT RRULE"
        (ev-ic-line
          (ev/event->ical-lines
            (ev-event
              (quote d)
              (ev-dt 2026 6 1 9 0)
              30
              {:freq :daily :count 5}
              1))
          "RRULE")
        "RRULE:FREQ=DAILY;COUNT=5")
      (ev-ic-check!
        "monthly nth-weekday BYDAY (2nd Tuesday)"
        (ev-ic-line
          (ev/event->ical-lines
            (ev-event
              (quote b)
              (ev-dt 2026 1 13 9 0)
              60
              {:freq :monthly :byday (list {:ord 2 :wd 1})}
              5))
          "RRULE")
        "RRULE:FREQ=MONTHLY;BYDAY=2TU")
      (ev-ic-check!
        "monthly last-Friday BYDAY"
        (ev-ic-line
          (ev/event->ical-lines
            (ev-event
              (quote b)
              (ev-dt 2026 1 30 9 0)
              60
              {:freq :monthly :byday (list {:ord -1 :wd 4})}
              5))
          "RRULE")
        "RRULE:FREQ=MONTHLY;BYDAY=-1FR")
      (ev-ic-check!
        "monthly BYMONTHDAY (incl. negative)"
        (ev-ic-line
          (ev/event->ical-lines
            (ev-event
              (quote b)
              (ev-dt 2026 1 15 9 0)
              60
              {:bymonthday (list 15 -1) :freq :monthly}
              5))
          "RRULE")
        "RRULE:FREQ=MONTHLY;BYMONTHDAY=15,-1")
      (ev-ic-check!
        "all seven weekday tokens map correctly"
        (ev-ic-line
          (ev/event->ical-lines
            (ev-event
              (quote w)
              (ev-dt 2026 6 1 9 0)
              30
              {:freq :weekly :byday (list 0 1 2 3 4 5 6)}
              1))
          "RRULE")
        "RRULE:FREQ=WEEKLY;BYDAY=MO,TU,WE,TH,FR,SA,SU")
      (let
        ((cal (ev/events->ical-lines (list (ev-event (quote a) (ev-dt 2026 6 1 9 0) 30 nil 1) (ev-event (quote b) (ev-dt 2026 6 2 9 0) 30 nil 1)))))
        (do
          (ev-ic-check! "VCALENDAR opens" (first cal) "BEGIN:VCALENDAR")
          (ev-ic-check!
            "VCALENDAR declares VERSION"
            (ev-ic-line cal "VERSION")
            "VERSION:2.0")
          (ev-ic-check!
            "two events -> two VEVENT blocks"
            (len (filter (fn (l) (= l "BEGIN:VEVENT")) cal))
            2)
          (ev-ic-check!
            "VCALENDAR has exactly one closing line"
            (len (filter (fn (l) (= l "END:VCALENDAR")) cal))
            1)))
      (ev-ic-check!
        "render joins lines with CRLF"
        (ev/ical-render
          (list "BEGIN:VCALENDAR" "VERSION:2.0" "END:VCALENDAR"))
        "BEGIN:VCALENDAR\r\nVERSION:2.0\r\nEND:VCALENDAR"))))

(define
  ev-ical-tests-run!
  (fn
    ()
    (do
      (set! ev-ic-pass 0)
      (set! ev-ic-fail 0)
      (set! ev-ic-failures (list))
      (ev-ic-run-all!)
      {:failures ev-ic-failures :total (+ ev-ic-pass ev-ic-fail) :passed ev-ic-pass :failed ev-ic-fail})))