From 1142294fa4e4fd715338c4670ee8ac40fb7a5e69 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sat, 11 Jun 2022 00:31:22 +0200
Subject: Rewrote rrule-instances to handle RDATE and EXDATE correctly.

---
 module/vcomponent/recurrence/generate.scm | 41 ++++++++++++++++---------------
 1 file changed, 21 insertions(+), 20 deletions(-)

(limited to 'module/vcomponent/recurrence/generate.scm')

diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index aba0256a..308ec11e 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -342,27 +342,28 @@
 ;; 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))
-
   ;; 3.8.5.1 exdate are evaluated AFTER rrule (and rdate)
-  (let* ((strm (if rrule
-                   (generate-posibilities rrule (prop event 'DTSTART))
-                   stream-null))
-         (date-stream
-          (cond ((prop* event 'EXDATE)
-                 => (lambda (ex) (stream-remove (cut member <> (map value ex)) strm)))
-                (else strm))
-          ;; 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
-          ;; about it for now.
-          ;; (stream-merge (list->stream (#|rdate's|#))
-          ))
-    ;; TODO count and until shoud be applied to the RRULE events,
-    ;; but not the RDATE events ???
-    ;; (TODO test against some other calendar program)
-    (limit-rrule-stream rrule (if (date? (prop event 'DTSTART))
-                                  date<= datetime<=) date-stream)))
+  (let ((rrule-stream
+         (cond ((prop event 'RRULE)
+                => (lambda (rrule)
+                     (rrule-instances-raw rrule (prop event 'DTSTART))))
+               (else stream-null)))
+        (rdates
+         (cond ((prop* event 'RDATE) => (lambda (v) (map value v)))
+               (else '())))
+        (exdates
+         (cond ((prop* event 'EXDATE) => (lambda (v) (map value v)))
+               (else #f))))
+
+    (let ((items (interleave-streams
+                  date/-time<?
+                  (list (list->stream rdates)
+                        rrule-stream))))
+      ;; `If' outside to avoid running stream-remove when it
+      ;; would always be false
+      (if exdates
+          (stream-remove (lambda (dt) (member dt exdates)) items)
+          items))))
 
 (export rrule-instances)
 
-- 
cgit v1.2.3