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