diff options
| -rw-r--r-- | module/vcomponent/xcal/parse.scm | 96 | ||||
| -rw-r--r-- | tests/recurrence-simple.scm | 27 |
2 files changed, 88 insertions, 35 deletions
diff --git a/module/vcomponent/xcal/parse.scm b/module/vcomponent/xcal/parse.scm index 48ce301e..c6a2122f 100644 --- a/module/vcomponent/xcal/parse.scm +++ b/module/vcomponent/xcal/parse.scm @@ -49,40 +49,68 @@ ((@ (vcomponent duration) parse-duration) duration))])] [(recur) - (apply (@ (vcomponent recurrence internal) make-recur-rule) - (concatenate - (for (k v) in value - (list (symbol->keyword k) - (case k - ((wkst) - ((@ (vcomponent recurrence parse) - rfc->datetime-weekday) - (string->symbol v))) - ((freq) (string->symbol v)) - ((until) - ;; RFC 6321 (xcal), p. 30 specifies type-until as - ;; type-until = element until { - ;; type-date | - ;; type-date-time - ;; } - ;; but doesn't bother defining type-date[-time]... - ;; This is acknowledged in errata 3315 [1], but - ;; it lacks a solution... - ;; Seeing as RFC 7265 (jcal) in Example 2 (p. 16) - ;; show the date as a direct string we will roll - ;; with that here to. - ;; [1]: https://www.rfc-editor.org/errata/eid3315 - (string->date/-time v)) - ((byday) #|TODO|# - (throw 'not-yet-implemented)) - ((count interval bysecond bymunite byhour - bymonthday byyearday byweekno - bymonth bysetpos) - (string->number v)) - (else (throw - 'key-error - "Invalid key ~a, with value ~a" - k v)))))))] + ;; RFC6221 (xcal) Appendix A 3.3.10 specifies that all components should + ;; come in a specified order, and by extension that all components of the + ;; same type should follow each other. Actually checking that is harder + ;; than to just accept anything in any order. It would also make us less + ;; robust for other implementations with other ideas. + (let ((parse-value-of-that-type + (lambda (type value) + (case type + ((wkst) + ((@ (vcomponent recurrence parse) + rfc->datetime-weekday) + (string->symbol value))) + ((freq) (string->symbol value)) + ((until) + ;; RFC 6321 (xcal), p. 30 specifies type-until as + ;; type-until = element until { + ;; type-date | + ;; type-date-time + ;; } + ;; but doesn't bother defining type-date[-time]... + ;; This is acknowledged in errata 3315 [1], but + ;; it lacks a solution... + ;; Seeing as RFC 7265 (jcal) in Example 2 (p. 16) + ;; show the date as a direct string we will roll + ;; with that here to. + ;; [1]: https://www.rfc-editor.org/errata/eid3315 + (string->date/-time value)) + ((byday) ((@@ (vcomponent recurrence parse) parse-day-spec) value)) + ((count interval bysecond bymunite byhour + bymonthday byyearday byweekno + bymonth bysetpos) + (string->number value)) + (else (throw + 'key-error + "Invalid type ~a, with value ~a" + type value)))))) + + ;; freq until count interval wkst + + (apply (@ (vcomponent recurrence internal) make-recur-rule) + (concatenate + (filter identity + (for key in '(bysecond byminute byhour byday bymonthday + byyearday byweekno bymonth bysetpos + freq until count interval wkst) + (define values (assoc-ref-all value key)) + (if (null? values) + #f + (case key + ;; These fields all have zero or one value + ((freq until count interval wkst) + (list (symbol->keyword key) + (parse-value-of-that-type + key (car (map car values))))) + ;; these fields take lists + ((bysecond byminute byhour byday bymonthday + byyearday byweekno bymonth bysetpos) + (list (symbol->keyword key) + (map (lambda (v) (parse-value-of-that-type key v)) + (map car values))) + ) + (else (throw 'error)))))))))] [(time) (parse-iso-time (car value))] diff --git a/tests/recurrence-simple.scm b/tests/recurrence-simple.scm index 166fa349..bbe6dd9d 100644 --- a/tests/recurrence-simple.scm +++ b/tests/recurrence-simple.scm @@ -9,7 +9,7 @@ ((vcomponent base) extract prop) ((calp util exceptions) warnings-are-errors warning-handler) - ((guile) format) + ((guile) format @@) ((vcomponent) parse-calendar) ((vcomponent xcal parse) sxcal->vcomponent) @@ -242,6 +242,13 @@ END:VCALENDAR" ;;; Earlier I failed to actually parse the recurrence parts, in short, 1 ≠ "1". +(test-assert "Test that xcal recur rules are parseable" + ((@@ (vcomponent xcal parse) handle-value) + 'recur 'props-are-unused-for-recur + '((freq "WEEKLY") + (interval "1") + (wkst "MO")))) + (define ev (sxcal->vcomponent '(vevent @@ -260,3 +267,21 @@ END:VCALENDAR" (test-assert "Check that recurrence rule commint from xcal also works" (generate-recurrence-set ev)) + +;;; TODO test here, for byday parsing, and multiple byday instances in one recur element +;;; TODO which should also test serializing and deserializing to xcal. +;;; For example, the following rules specify every workday + +;; BEGIN:VCALENDAR
+;; PRODID:-//hugo//calp 0.6.1//EN
+;; VERSION:2.0
+;; CALSCALE:GREGORIAN
+;; BEGIN:VEVENT
+;; SUMMARY:Lunch
+;; DTSTART:20211129T133000
+;; DTEND:20211129T150000
+;; LAST-MODIFIED:20211204T220944Z
+;; UID:3d82c73c-6cdb-4799-beba-5f1d20d55347
+;; RRULE:FREQ=DAILY;BYDAY=MO,TU,WE,TH,FR
+;; END:VEVENT
+;; END:VCALENDAR
|