From 6a4f545a52b47a407c06ac8b0c4b3c1bf7f582e8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sun, 6 Sep 2020 21:47:57 +0200
Subject: Allow recurrence from just Recurrence-ID.

---
 module/vcomponent/recurrence/generate.scm | 55 ++++++++++++++++++++++++-------
 module/vcomponent/recurrence/internal.scm |  3 +-
 module/vcomponent/vdir/parse.scm          |  5 +--
 3 files changed, 49 insertions(+), 14 deletions(-)

(limited to 'module')

diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index 69105fcc..e304f2c1 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -333,13 +333,18 @@
                       ;; anything after monday. This filters these out.
                       (stream-drop-while
                        (lambda (d) (date/-time< d (prop event 'DTSTART)))
-                       (generate-posibilities rrule (prop event 'DTSTART)))
+                       (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
                       ;; 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)
     (cond [(count rrule) => (lambda (c) (stream-take c date-stream))]
           [(until rrule) => (lambda (end) (stream-take-while
                                       (cut (if (date? (prop event 'DTSTART))
@@ -371,7 +376,29 @@
               (datetime-difference end (prop base-event 'DTSTART)))
           #f)))
 
-  (define rrule-stream (rrule-instances base-event))
+
+
+  (define rrule-stream-regular
+    (if (prop base-event 'RRULE)
+        (rrule-instances base-event)
+        stream-null))
+
+  ;; NOTE Others have interpreted the standard to allow RECURRENCE-ID:s to
+  ;; create new instances. While I thought that you needed to specifie them
+  ;; through RDATE components.
+  (define alternative-times
+    (awhen (prop base-event '-X-HNH-ALTERNATIVES)
+           (list (list->stream
+                  (sort*
+                   (hash-map->list (lambda (_ v) (prop v 'DTSTART)) it)
+                   date/-time<?)))))
+
+  (define rrule-stream
+    ;; TODO remove duplicates
+    (interleave-streams
+     date/-time<?
+     (cons rrule-stream-regular
+           alternative-times)))
 
   (stream-map
    (aif (prop base-event '-X-HNH-ALTERNATIVES)
@@ -380,25 +407,31 @@
                it ; RECURRENCE-ID objects come with their own DTEND
                (let ((ev (copy-vcomponent base-event)))
                  (set! (prop ev 'DTSTART) dt)
-                 (when duration
+                 (when duration ; (and (not (prop ev 'DTEND)) duration)
                    ;; p. 123 (3.8.5.3 Recurrence Rule)
                    ;; specifies that the DTEND should be updated to match how the
                    ;; initial dtend related to the initial DTSTART. It also notes
                    ;; that an event of 1 day in length might be longer or shorter
                    ;; than 24h depending on timezone shifts.
-                   (set! (prop ev 'DTEND) ((cond [(date? dt) date+]
-                                                 [(datetime? dt) datetime+]
-                                                 [else (error "Bad type")])
-                                           dt duration)))
+                   (set! (prop ev 'DTEND)
+                     (cond [(date? dt)
+                            (unless (date? duration)
+                              (warning "Expected date, got ~a" duration))
+                            (date+ dt (as-date duration))]
+                           [(datetime? dt)
+                            (unless (datetime? duration)
+                              (warning "Expected datetime, got ~a" duration))
+                            (datetime+ dt (as-datetime duration)) ]
+                           [else (error "Bad type")])))
                  ev)))
         (lambda (dt)
           (let ((ev (copy-vcomponent base-event)))
             (set! (prop ev 'DTSTART) dt)
             (when duration
-             (set! (prop ev 'DTEND) ((cond [(date? dt) date+]
-                                           [(datetime? dt) datetime+]
-                                           [else (error "Bad type")])
-                                     dt duration)))
+              (set! (prop ev 'DTEND) ((cond [(date? dt) date+]
+                                            [(datetime? dt) datetime+]
+                                            [else (error "Bad type")])
+                                      dt duration)))
             ev)))
    rrule-stream))
 
diff --git a/module/vcomponent/recurrence/internal.scm b/module/vcomponent/recurrence/internal.scm
index 0c119bb6..1a2abd85 100644
--- a/module/vcomponent/recurrence/internal.scm
+++ b/module/vcomponent/recurrence/internal.scm
@@ -13,7 +13,8 @@
 (define (repeating? ev)
   "Does this event repeat?"
   (or (prop ev 'RRULE)
-      (prop ev 'RDATE)))
+      (prop ev 'RDATE)
+      (prop ev '-X-HNH-ALTERNATIVES)))
 
 ;; weekday := [0, 7)
 
diff --git a/module/vcomponent/vdir/parse.scm b/module/vcomponent/vdir/parse.scm
index d251e60a..ac9cb1aa 100644
--- a/module/vcomponent/vdir/parse.scm
+++ b/module/vcomponent/vdir/parse.scm
@@ -70,8 +70,9 @@
                  ;; But the patches can apparently share a sequence number
                  ;; of 0 with the original event!
                  ;; (╯°□°）╯ ┻━┻
-                 (let* ((head (find (negate (extract 'RECURRENCE-ID))
-                                    events))
+                 (let* ((head (or (find (extract 'RRULE) events)
+                                  (find (negate (extract 'RECURRENCE-ID)) events)
+                                  (car events)))
                         (rest (delete head events eq?)))
 
                    (set! (prop head '-X-HNH-ALTERNATIVES)
-- 
cgit v1.2.3