From 38c57d8c65c0bf41c0c6132ab39a34c3c7591ec4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Wed, 8 Jun 2022 17:00:33 +0200 Subject: Add rrule-instances-raw The current rrule-instances requires an event, the new one works directly on recurrence rules (and dates) meaning that it can be used independently. --- module/vcomponent/recurrence/generate.scm | 41 ++++++++++++++++++++----------- 1 file changed, 26 insertions(+), 15 deletions(-) diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm index 33f86e3d..1cf054d1 100644 --- a/module/vcomponent/recurrence/generate.scm +++ b/module/vcomponent/recurrence/generate.scm @@ -314,14 +314,33 @@ date-stream))) ;; (a := ) => , a → (stream a) -(define-stream (generate-posibilities rrule start-date) +(define-stream (generate-posibilities* rrule start-date) (limit-recurrence-set rrule (extend-recurrence-set rrule start-date))) +(define-stream (generate-posibilities rrule start-date) + ;; Some expanders can produce dates before our start time. + ;; For example FREQ=WEEKLY;BYDAY=MO where DTSTART is + ;; anything after monday. This filters these out. + (stream-drop-while + (lambda (d) (date/-time< d start-date)) + (generate-posibilities* rrule start-date))) + +(define-stream (limit-rrule-stream rrule < date-stream) + (cond [(count rrule) => (lambda (c) (stream-take c date-stream))] + [(until rrule) => (lambda (end) (stream-take-while (lambda (dt) (< dt end)) date-stream))] + [else date-stream])) + +(define-stream (rrule-instances-raw rrule start-date) + (limit-rrule-stream rrule (if (date? start-date) + date<= datetime<=) + (generate-posibilities rrule start-date))) ;; Recurring → (stream ) +;; TODO rename this procedure (to something like event-instances), allowing +;; rrule-instances-raw to take its place (define-stream (rrule-instances event) (define rrule (prop event 'RRULE)) @@ -330,14 +349,9 @@ (aif (prop* event 'EXDATE) (cut member <> (map value it)) (const #f)) - ;; Some expanders can produce dates before our start time. - ;; For example FREQ=WEEKLY;BYDAY=MO where DTSTART is - ;; anything after monday. This filters these out. - (stream-drop-while - (lambda (d) (date/-time< d (prop event 'DTSTART))) - (if rrule - (generate-posibilities rrule (prop event 'DTSTART)) - stream-null)) + (if rrule + (generate-posibilities rrule (prop event 'DTSTART)) + stream-null) ;; TODO ideally I should merge the limited recurrence set ;; with the list of rdates here. However, I have never ;; sen an event with an RDATE property, so I wont worry @@ -347,12 +361,9 @@ ;; TODO count and until shoud be applied to the RRULE events, ;; but not the RDATE events ??? ;; (TODO test against some other calendar program) - (cond [(count rrule) => (lambda (c) (stream-take c date-stream))] - [(until rrule) => (lambda (end) (stream-take-while - (cut (if (date? (prop event 'DTSTART)) - date<= datetime<=) <> end) - date-stream))] - [else date-stream]))) + (limit-rrule-stream rrule (if (date? (prop event 'DTSTART)) + date<= datetime<=) date-stream) + )) (export rrule-instances) -- cgit v1.2.3