diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2020-01-30 22:51:45 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2020-01-30 22:51:45 +0100 |
commit | f852c30bcef530d18a474ab6ab8350a3ef93d563 (patch) | |
tree | 00fc29a6ff1a8c842d0a526f04d4124977dd6e46 /module/vcomponent/recurrence/parse.scm | |
parent | Update recurrence generate to new date obj. (diff) | |
download | calp-f852c30bcef530d18a474ab6ab8350a3ef93d563.tar.gz calp-f852c30bcef530d18a474ab6ab8350a3ef93d563.tar.xz |
Once again compiles.
Diffstat (limited to '')
-rw-r--r-- | module/vcomponent/recurrence/parse.scm | 22 |
1 files changed, 15 insertions, 7 deletions
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)) |