aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@hornquist.se>2019-04-26 10:41:53 +0200
committerHugo Hörnquist <hugo@hornquist.se>2019-04-26 10:41:53 +0200
commitd1c8546d763399b76b733c785fcdfa593438c6b0 (patch)
treeec3fd930ea6a05eacd775ea8338c2cb06a3183e1
parentOnce again, rewrote quick-case. (diff)
downloadcalp-d1c8546d763399b76b733c785fcdfa593438c6b0.tar.gz
calp-d1c8546d763399b76b733c785fcdfa593438c6b0.tar.xz
Further cleanup in recurrence parser.
-rw-r--r--module/vcomponent/recurrence/parse.scm34
1 files changed, 3 insertions, 31 deletions
diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm
index a3a30006..04c785a4 100644
--- a/module/vcomponent/recurrence/parse.scm
+++ b/module/vcomponent/recurrence/parse.scm
@@ -7,38 +7,10 @@
#:duplicates (last) ; Replace @var{count}
#:use-module (vcomponent recurrence internal)
#:use-module (util)
- #:use-module (util exceptions)
- #:use-module (ice-9 curried-definitions)
#:use-module (ice-9 match)
#:export (parse-recurrence-rule))
-(define (printerr fmt . args)
- (apply format (current-error-port)
- fmt args))
-
-(define (parse-recurrence-rule str)
- (catch-multiple
- (lambda () (%build-recur-rules str))
-
- [unfulfilled-constraint
- (cont obj key val . rest)
- (printerr "ERR ~a [~a] doesn't fulfill constraint of type [~a], ignoring~%"
- err val key)
- (cont #f)]
-
- [invalid-value
- (cont obj key val . rest)
- (printerr "ERR ~a [~a] for key [~a], ignoring.~%"
- err val key)
- (cont #f)]))
-
-(define (string->number-list val delim)
- (map string->number (string-split val delim)))
-
-(define (string->symbols val delim)
- (map string->symbol (string-split val delim)))
-
;; @example
;; <weekday> ∈ weekdays
;; <weekdaynum> ::= [[±] <num>] <weekday> ;; +3MO
@@ -70,7 +42,7 @@
`(else ,@body)))
cases))))
-(define (%build-recur-rules str)
+(define (parse-recurrence-rule str)
(fold
(lambda (kv o)
(let* (((key val) kv))
@@ -79,7 +51,7 @@
(date (date->time-utc (parse-datetime val)))
(days (map parse-day-spec (string-split val #\,)))
(num (string->number val))
- (nums (string->number-list val #\,)))
+ (nums (map string->number (string-split val #\,))))
(quick-case (string->symbol key)
(UNTIL (set! (until o) date))
@@ -95,7 +67,7 @@
(BYHOUR (every (lambda (n) (<= 0 n 23)) nums) => (set! (byhour o) nums))
(BYMONTH (every (lambda (n) (<= 1 n 12)) nums) => (set! (byweekno o) nums))
- (BYDAY (every (lambda (p) (memv (cdr p) weekdays)) days) => (set! (byday o) days))
+ (BYDAY (every (lambda (p) (memv (cdr p) weekdays)) days) => (set! (byday o) days))
(BYMONTHDAY (every (lambda (n) (and (!= n 0) (<= -31 n 31))) nums) => (set! (bymonthday o) nums))
(BYYEARDAY (every (lambda (n) (and (!= n 0) (<= -366 n 366))) nums) => (set! (byyearday o) nums))