events: iCalendar import + occurrence-exact round-trip + 19 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 38s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 38s
ical.sx parses VEVENT/VCALENDAR text back into events (ev/ical-lines->event, ev/parse-vcalendar): DTSTART/DURATION/RRULE (ordinal BYDAY, BYMONTHDAY, UNTIL/ COUNT/INTERVAL) + EXDATE/RDATE. Round-trip is occurrence-exact — export->import expands to the identical occurrence set. Completes bidirectional interop. 360/360 green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -189,3 +189,153 @@
|
|||||||
|
|
||||||
;; Render content lines to the on-the-wire iCalendar text (CRLF-separated).
|
;; Render content lines to the on-the-wire iCalendar text (CRLF-separated).
|
||||||
(define ev/ical-render (fn (lines) (ev-ical-join lines "\r\n")))
|
(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)))))
|
||||||
|
|||||||
@@ -1,12 +1,12 @@
|
|||||||
{
|
{
|
||||||
"lang": "events",
|
"lang": "events",
|
||||||
"total_passed": 341,
|
"total_passed": 360,
|
||||||
"total_failed": 0,
|
"total_failed": 0,
|
||||||
"total": 341,
|
"total": 360,
|
||||||
"suites": [
|
"suites": [
|
||||||
{"name":"calendar","passed":51,"failed":0,"total":51},
|
{"name":"calendar","passed":51,"failed":0,"total":51},
|
||||||
{"name":"timezone","passed":17,"failed":0,"total":17},
|
{"name":"timezone","passed":17,"failed":0,"total":17},
|
||||||
{"name":"ical","passed":21,"failed":0,"total":21},
|
{"name":"ical","passed":40,"failed":0,"total":40},
|
||||||
{"name":"availability","passed":22,"failed":0,"total":22},
|
{"name":"availability","passed":22,"failed":0,"total":22},
|
||||||
{"name":"api","passed":41,"failed":0,"total":41},
|
{"name":"api","passed":41,"failed":0,"total":41},
|
||||||
{"name":"booking","passed":82,"failed":0,"total":82},
|
{"name":"booking","passed":82,"failed":0,"total":82},
|
||||||
@@ -17,5 +17,5 @@
|
|||||||
{"name":"federation","passed":29,"failed":0,"total":29},
|
{"name":"federation","passed":29,"failed":0,"total":29},
|
||||||
{"name":"integration","passed":8,"failed":0,"total":8}
|
{"name":"integration","passed":8,"failed":0,"total":8}
|
||||||
],
|
],
|
||||||
"generated": "2026-06-07T15:20:08+00:00"
|
"generated": "2026-06-07T17:28:07+00:00"
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,12 +1,12 @@
|
|||||||
# events scoreboard
|
# events scoreboard
|
||||||
|
|
||||||
**341 / 341 passing** (0 failure(s)).
|
**360 / 360 passing** (0 failure(s)).
|
||||||
|
|
||||||
| Suite | Passed | Total | Status |
|
| Suite | Passed | Total | Status |
|
||||||
|-------|--------|-------|--------|
|
|-------|--------|-------|--------|
|
||||||
| calendar | 51 | 51 | ok |
|
| calendar | 51 | 51 | ok |
|
||||||
| timezone | 17 | 17 | ok |
|
| timezone | 17 | 17 | ok |
|
||||||
| ical | 21 | 21 | ok |
|
| ical | 40 | 40 | ok |
|
||||||
| availability | 22 | 22 | ok |
|
| availability | 22 | 22 | ok |
|
||||||
| api | 41 | 41 | ok |
|
| api | 41 | 41 | ok |
|
||||||
| booking | 82 | 82 | ok |
|
| booking | 82 | 82 | ok |
|
||||||
|
|||||||
@@ -180,6 +180,92 @@
|
|||||||
(list "BEGIN:VCALENDAR" "VERSION:2.0" "END:VCALENDAR"))
|
(list "BEGIN:VCALENDAR" "VERSION:2.0" "END:VCALENDAR"))
|
||||||
"BEGIN:VCALENDAR\r\nVERSION:2.0\r\nEND:VCALENDAR"))))
|
"BEGIN:VCALENDAR\r\nVERSION:2.0\r\nEND:VCALENDAR"))))
|
||||||
|
|
||||||
|
;; ---- import + round-trip ----
|
||||||
|
|
||||||
|
;; The occurrence starts an event expands to over a fixed window.
|
||||||
|
(define
|
||||||
|
ev-ic-starts
|
||||||
|
(fn
|
||||||
|
(ev)
|
||||||
|
(map (fn (o) (get o :start)) (ev-expand ev (ev-date 2026 1 1) (ev-date 2027 1 1)))))
|
||||||
|
|
||||||
|
;; Round-trip an event through export then import; true if both expand alike.
|
||||||
|
(define
|
||||||
|
ev-ic-roundtrips?
|
||||||
|
(fn
|
||||||
|
(ev)
|
||||||
|
(= (ev-ic-starts ev) (ev-ic-starts (ev/ical-lines->event (ev/event->ical-lines ev))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
ev-ic-rt-run-all!
|
||||||
|
(fn
|
||||||
|
()
|
||||||
|
(do
|
||||||
|
;; ---- field parsers ----
|
||||||
|
(ev-ic-check! "parse DTSTART" (ev-ical-parse-dt "20260601T180000Z") (ev-dt 2026 6 1 18 0))
|
||||||
|
(ev-ic-check! "parse DURATION PT1H30M" (ev-ical-parse-duration "PT1H30M") 90)
|
||||||
|
(ev-ic-check! "parse DURATION PT1H" (ev-ical-parse-duration "PT1H") 60)
|
||||||
|
(ev-ic-check! "parse DURATION PT30M" (ev-ical-parse-duration "PT30M") 30)
|
||||||
|
(ev-ic-check! "parse plain BYDAY token" (ev-ical-parse-byday-token "MO") 0)
|
||||||
|
(ev-ic-check! "parse ordinal BYDAY token" (ev-ical-parse-byday-token "2TU") {:ord 2 :wd 1})
|
||||||
|
(ev-ic-check! "parse last-weekday BYDAY token" (ev-ical-parse-byday-token "-1FR") {:ord -1 :wd 4})
|
||||||
|
|
||||||
|
;; ---- imported event basic fields ----
|
||||||
|
(let
|
||||||
|
((ev (ev/ical-lines->event (ev/event->ical-lines (ev-event (quote yoga) (ev-dt 2026 6 1 18 0) 90 nil 1)))))
|
||||||
|
(do
|
||||||
|
(ev-ic-check! "imported id is a symbol" (get ev :id) (quote yoga))
|
||||||
|
(ev-ic-check! "imported dtstart" (get ev :dtstart) (ev-dt 2026 6 1 18 0))
|
||||||
|
(ev-ic-check! "imported duration" (get ev :duration) 90)))
|
||||||
|
|
||||||
|
;; ---- round-trips preserve the occurrence set ----
|
||||||
|
(ev-ic-check!
|
||||||
|
"round-trip: one-off event"
|
||||||
|
(ev-ic-roundtrips? (ev-event (quote a) (ev-dt 2026 6 10 14 0) 60 nil 1))
|
||||||
|
true)
|
||||||
|
(ev-ic-check!
|
||||||
|
"round-trip: daily COUNT"
|
||||||
|
(ev-ic-roundtrips? (ev-event (quote a) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 5} 1))
|
||||||
|
true)
|
||||||
|
(ev-ic-check!
|
||||||
|
"round-trip: weekly interval/until/byday + exdate + rdate"
|
||||||
|
(ev-ic-roundtrips?
|
||||||
|
(ev-event-full
|
||||||
|
(quote a)
|
||||||
|
(ev-dt 2026 6 1 18 0)
|
||||||
|
90
|
||||||
|
{:freq :weekly :interval 2 :byday (list 0 2) :until (ev-dt 2026 6 30 23 0)}
|
||||||
|
20
|
||||||
|
(list (ev-dt 2026 6 8 18 0))
|
||||||
|
(list (ev-dt 2026 6 20 18 0))))
|
||||||
|
true)
|
||||||
|
(ev-ic-check!
|
||||||
|
"round-trip: monthly nth-weekday"
|
||||||
|
(ev-ic-roundtrips? (ev-event (quote a) (ev-dt 2026 1 13 9 0) 60 {:freq :monthly :byday (list {:ord 2 :wd 1})} 1))
|
||||||
|
true)
|
||||||
|
(ev-ic-check!
|
||||||
|
"round-trip: monthly bymonthday"
|
||||||
|
(ev-ic-roundtrips? (ev-event (quote a) (ev-dt 2026 1 15 9 0) 60 {:freq :monthly :bymonthday (list 15 -1)} 1))
|
||||||
|
true)
|
||||||
|
|
||||||
|
;; ---- parse a VCALENDAR with several events ----
|
||||||
|
(let
|
||||||
|
((cal
|
||||||
|
(ev/events->ical-lines
|
||||||
|
(list
|
||||||
|
(ev-event (quote a) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 3} 1)
|
||||||
|
(ev-event (quote b) (ev-dt 2026 6 2 10 0) 60 nil 1)))))
|
||||||
|
(let
|
||||||
|
((events (ev/parse-vcalendar cal)))
|
||||||
|
(do
|
||||||
|
(ev-ic-check! "VCALENDAR parses both events" (len events) 2)
|
||||||
|
(ev-ic-check! "first event id" (get (first events) :id) (quote a))
|
||||||
|
(ev-ic-check! "second event id" (get (first (rest events)) :id) (quote b))
|
||||||
|
(ev-ic-check!
|
||||||
|
"parsed events expand correctly"
|
||||||
|
(ev-ic-starts (first events))
|
||||||
|
(ev-ic-starts (ev-event (quote a) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 3} 1)))))))))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
ev-ical-tests-run!
|
ev-ical-tests-run!
|
||||||
(fn
|
(fn
|
||||||
@@ -189,4 +275,5 @@
|
|||||||
(set! ev-ic-fail 0)
|
(set! ev-ic-fail 0)
|
||||||
(set! ev-ic-failures (list))
|
(set! ev-ic-failures (list))
|
||||||
(ev-ic-run-all!)
|
(ev-ic-run-all!)
|
||||||
|
(ev-ic-rt-run-all!)
|
||||||
{:failures ev-ic-failures :total (+ ev-ic-pass ev-ic-fail) :passed ev-ic-pass :failed ev-ic-fail})))
|
{:failures ev-ic-failures :total (+ ev-ic-pass ev-ic-fail) :passed ev-ic-pass :failed ev-ic-fail})))
|
||||||
|
|||||||
@@ -18,7 +18,7 @@ capacity rules, transactional booking, and a flow-driven notification dispatcher
|
|||||||
|
|
||||||
## Status (rolling)
|
## Status (rolling)
|
||||||
|
|
||||||
`bash lib/events/conformance.sh` → **341/341** (Phases 1-4 + 12 ext: …conflict-checked booking, iCalendar export, whole-series booking)
|
`bash lib/events/conformance.sh` → **360/360** (Phases 1-4 + 13 ext: …iCalendar export+import round-trip, whole-series booking)
|
||||||
|
|
||||||
## Ground rules
|
## Ground rules
|
||||||
|
|
||||||
@@ -88,6 +88,13 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ──
|
|||||||
|
|
||||||
## Progress log
|
## Progress log
|
||||||
|
|
||||||
|
- 2026-06-07 — iCalendar import / round-trip (extension). `ical.sx` now parses
|
||||||
|
VEVENT/VCALENDAR text back into events (`ev/ical-lines->event`,
|
||||||
|
`ev/parse-vcalendar`): DTSTART/DURATION/RRULE (incl. ordinal BYDAY, BYMONTHDAY,
|
||||||
|
UNTIL/COUNT/INTERVAL) and EXDATE/RDATE. Round-trip is occurrence-exact —
|
||||||
|
export→import expands to the identical occurrence set (tested across one-off /
|
||||||
|
daily-count / weekly+exdate+rdate / monthly-ordinal / bymonthday). Completes
|
||||||
|
bidirectional interop. +19 tests, 360/360 green.
|
||||||
- 2026-06-07 — Whole-series booking (extension). `ev/book-series!` /
|
- 2026-06-07 — Whole-series booking (extension). `ev/book-series!` /
|
||||||
`ev/cancel-series!` apply a booking/cancel to every occurrence of one event
|
`ev/cancel-series!` apply a booking/cancel to every occurrence of one event
|
||||||
in a window (e.g. RSVP the whole weekly class), returning per-occurrence
|
in a window (e.g. RSVP the whole weekly class), returning per-occurrence
|
||||||
|
|||||||
Reference in New Issue
Block a user