diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-14 11:08:14 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-14 11:08:14 +0200 |
| commit | d656da6b654b43cef5ede067f0176957902e60c4 (patch) | |
| tree | 3f0e2e5db3e0602daefabcfab6d2a818c19e949f /module/vcomponent/recurrence/generate-alt.scm | |
| parent | Add label macro. (diff) | |
| download | calp-d656da6b654b43cef5ede067f0176957902e60c4.tar.gz calp-d656da6b654b43cef5ede067f0176957902e60c4.tar.xz | |
Remove some duplicates in recurrence set generation.
Diffstat (limited to '')
| -rw-r--r-- | module/vcomponent/recurrence/generate-alt.scm | 62 |
1 files changed, 34 insertions, 28 deletions
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] |