From 9e19bec04ea7eede8220e0e463640cfd99bf92b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 31 Mar 2019 23:43:22 +0200 Subject: Add parser for BYDAY RRULE's. --- module/vcalendar/recurrence/parse.scm | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) (limited to 'module/vcalendar/recurrence/parse.scm') diff --git a/module/vcalendar/recurrence/parse.scm b/module/vcalendar/recurrence/parse.scm index abead3a9..95d8092e 100644 --- a/module/vcalendar/recurrence/parse.scm +++ b/module/vcalendar/recurrence/parse.scm @@ -65,6 +65,22 @@ (define (string->symbols val delim) (map string->symbol (string-split val delim))) +;; @example +;; ∈ weekdays +;; ::= [[±] ] ;; +3MO +;; (, ...) +;; @end example + +;; Returns a pair, where the @code{car} is the offset +;; and @code{cdr} is the day symbol. +;; The @code{car} may be @code{#f}. +(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)))) + (define (%build-recur-rules str) (fold (lambda (kv obj) @@ -72,10 +88,11 @@ ;; Lazy fields for the poor man. (symb (lambda () (string->symbol val))) (date (lambda () (parse-datetime val))) + (days (lambda () (map parse-day-spec (string-split val #\,)))) (num (lambda () (string->number val))) (nums (lambda () (string->number-list val #\,)))) (quick-case (string->symbol key) obj - (FREQ (symb) (cut memv <> intervals)) ; Requirek + (FREQ (symb) (cut memv <> intervals)) ; Required (UNTIL (date) identity) (COUNT (num) (cut <= 0 <>)) (INTERVAL (num) (cut <= 0 <>)) @@ -83,11 +100,8 @@ (BYMINUTE (nums) (all-in n (<= 0 n 59))) (BYHOUR (nums) (all-in n (<= 0 n 23))) - ;; TODO - ;; ∈ weekdays - ;; ::= [[±] ] ;; +3MO - ;; (, ...) - ;; (BYDAY (string-split val #\,)) + (BYDAY (days) (lambda (p) (let* (((num . symb) p)) + (memv symb weekdays)))) (BYMONTHDAY (nums) (all-in n (<= -31 n 31) (!= n 0))) (BYYEARDAY (nums) (all-in n (<= -366 n 366) (!= n 0))) -- cgit v1.2.3