diff options
Diffstat (limited to 'module/vcomponent/recurrence')
-rw-r--r-- | module/vcomponent/recurrence/generate.scm | 46 | ||||
-rw-r--r-- | module/vcomponent/recurrence/internal.scm | 3 | ||||
-rw-r--r-- | module/vcomponent/recurrence/parse.scm | 22 |
3 files changed, 46 insertions, 25 deletions
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm index 938d99f9..8a4eed36 100644 --- a/module/vcomponent/recurrence/generate.scm +++ b/module/vcomponent/recurrence/generate.scm @@ -142,20 +142,32 @@ ;; TODO DURATION might be used for something else, check applicable types ;; TODO Far from all events have DTEND ;; VTIMEZONE's always lack it. - (if (not (attr event 'RRULE)) - (stream event) - (begin - (set! (attr event 'X-HNH-DURATION) - (cond [(attr event 'DURATION) => identity] - [(attr event 'DTEND) - => (lambda (end) - ;; The value type of dtstart and dtend must be the same - ;; according to RFC 5545 3.8.2.2 (Date-Time End). - (if (date? end) - (date- end (attr event 'DTSTART)) - (datetime- end (attr event 'DTSTART))))])) - (if (attr event "RRULE") - (recur-event-stream event (parse-recurrence-rule (attr event "RRULE"))) - ;; TODO some events STANDARD and DAYLIGT doesn't have RRULE's, but rather - ;; just mention the current part. Handle this - stream-null)))) + (catch #t + (lambda () + (if (not (attr event 'RRULE)) + (stream event) + (begin + (set! (attr event 'X-HNH-DURATION) + (cond [(attr event 'DURATION) => identity] + [(attr event 'DTEND) + => (lambda (end) + ;; The value type of dtstart and dtend must be the same + ;; according to RFC 5545 3.8.2.2 (Date-Time End). + (if (date? end) + (date- end (attr event 'DTSTART)) + (datetime- end (attr event 'DTSTART))))])) + (if (attr event "RRULE") + (recur-event-stream event (parse-recurrence-rule + (attr event "RRULE") + (if (string= "DATE" (and=> (prop (attr* event 'DTSTART) 'VALUE) car)) + parse-date parse-datetime))) + ;; TODO some events STANDARD and DAYLIGT doesn't have RRULE's, but rather + ;; just mention the current part. Handle this + stream-null)))) + (lambda (err . args) + (format (current-error-port) + "\x1b[0;31mError\x1b[m while parsing recurrence rule (ignoring and continuing)~%~a ~a~%~a~%~%" + err args + (attr event 'X-HNH-FILENAME)) + (stream ; event + )))) diff --git a/module/vcomponent/recurrence/internal.scm b/module/vcomponent/recurrence/internal.scm index 12cf7a7b..50c44a60 100644 --- a/module/vcomponent/recurrence/internal.scm +++ b/module/vcomponent/recurrence/internal.scm @@ -37,7 +37,8 @@ (display "=" port) (display (case field - ((until) ((@ (srfi srfi-19 util) time->string) it)) + ;; TODO check over date/time/datetime here + ((until) ((@ (srfi srfi-19 alt util) time->string) it)) (else it)) port))) (display ">" port)))))) diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm index f532987a..1c974727 100644 --- a/module/vcomponent/recurrence/parse.scm +++ b/module/vcomponent/recurrence/parse.scm @@ -18,15 +18,20 @@ ;; (<weekadynum>, ...) ;; @end example +;;; weekdaynum can contain ± +;;; only used in bywdaylist +;;; only present with by BYDAY + ;; Returns a pair, where the @code{car} is the offset ;; and @code{cdr} is the day symbol. ;; The @code{car} may be @code{#f}. +;; str → (<num> . <symb>) (define (parse-day-spec str) - (let* ((numchars (append '(#\+ #\-) (map integer->char (iota 10 #x30)))) - (num symb (span (cut memv <> numchars) - (string->list str)))) - (cons (string->number (list->string num)) - (apply symbol symb)))) + (let* ((numerical-characters (append '(#\+ #\-) (map integer->char (iota 10 #x30)))) + (numbers letters (span (cut memv <> numerical-characters) + (string->list str)))) + (cons (string->number (list->string numbers)) + (apply symbol letters)))) (define-macro (quick-case key . cases) (let ((else-clause (or (assoc-ref cases 'else) @@ -43,17 +48,20 @@ `(else ,@body))) cases)))) -(define (parse-recurrence-rule str) +;; UNTIL must have the exact same value type as the DTSTART of the event from which +;; this string came. I have however seen exceptions to that rule... +(define* (parse-recurrence-rule str optional: (datetime-parser parse-datetime)) (fold (lambda (kv o) (let* (((key val) kv)) (let-lazy ((symb (string->symbol val)) - (date (parse-datetime val)) + (date (datetime-parser val)) (days (map parse-day-spec (string-split val #\,))) (num (string->number val)) (nums (map string->number (string-split val #\,)))) + ;; TODO I think it's an error to give BYHOUR and under for dates which aren't datetimes (quick-case (string->symbol key) (UNTIL (set! (until o) date)) |