From d656da6b654b43cef5ede067f0176957902e60c4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 14 May 2020 11:08:14 +0200 Subject: Remove some duplicates in recurrence set generation. --- module/vcomponent/recurrence/generate-alt.scm | 62 +++++++++++++++------------ 1 file changed, 34 insertions(+), 28 deletions(-) (limited to 'module/vcomponent/recurrence/generate-alt.scm') diff --git a/module/vcomponent/recurrence/generate-alt.scm b/module/vcomponent/recurrence/generate-alt.scm index b5395850..a98d10db 100644 --- a/module/vcomponent/recurrence/generate-alt.scm +++ b/module/vcomponent/recurrence/generate-alt.scm @@ -47,12 +47,19 @@ (filter identity (list - ,@(map (lambda (field) - `(and=> (,(by-proc field) ,rr) - ,(if extender? - `(cut map (con (quote ,(by-symb field))) - <>) - `(con (quote ,(by-symb field)))))) + ,@(map (label self + (match-lambda + [('unless pred field) + `(let ((yearday (,(by-proc 'yearday) ,rr)) + (monthday (,(by-proc 'monthday) ,rr))) + ,(if pred #f + (it field)))] + [field + `(and=> (,(by-proc field) ,rr) + ,(if extender? + `(cut map (con (quote ,(by-symb field))) + <>) + `(con (quote ,(by-symb field)))))])) cc))))]) cases))) @@ -69,8 +76,9 @@ (define (all-extenders rrule) (make-extenders rrule - [YEARLY || month weekno yearday monthday day hour minute second] - [MONTHLY || monthday day hour minute second] + [YEARLY || month weekno yearday monthday (unless (or yearday monthday) day) + hour minute second] + [MONTHLY || monthday (unless monthday day) hour minute second] [WEEKLY || day hour minute second] [DAILY || hour minute second] [HOURLY || minute second] @@ -156,31 +164,29 @@ 7))))] [(MONTHLY) - ;; if bymonthday is present byday turns into a limiter - (if (bymonthday rrule) - dt - (let* ((instances (all-wday-in-month value d))) - (catch 'out-of-range - (lambda () - (cond [(eqv? #f offset) - ;; every of that day in this month - (valued-map to-dt instances)] - - [(positive? offset) - (to-dt (list-ref instances (1- offset)))] - - [(negative? offset) - (to-dt (list-ref (reverse instances) - (1- (- offset))))])) - - (lambda (err proc fmt args . rest) - (warning "BYDAY out of range for MONTHLY. + (let* ((instances (all-wday-in-month value d))) + (catch 'out-of-range + (lambda () + (cond [(eqv? #f offset) + ;; every of that day in this month + (valued-map to-dt instances)] + + [(positive? offset) + (to-dt (list-ref instances (1- offset)))] + + [(negative? offset) + (to-dt (list-ref (reverse instances) + (1- (- offset))))])) + + (lambda (err proc fmt args . rest) + (warning "BYDAY out of range for MONTHLY. Possibly stuck in infinite loop") - dt))))] + dt)))] ;; see Note 2, p. 44 [(YEARLY) (cond + ;; turns it into a limiter [(or (byyearday rrule) (bymonthday rrule)) dt] -- cgit v1.2.3