Propagate recurring events to frontend.

This handles each instance of a recurring event as its own unique event,
which allows us to properly send it to the frontend. It's currently not
possible to submit the repeating events back, but that is probably a
underlying problem.

3 files changed, 67 insertions, 36 deletions

diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm
index bff219aa..4c42d597 100644
--- a/module/calp/html/vcomponent.scm
+++ b/module/calp/html/vcomponent.scm
@@ -15,6 +15,7 @@
   :use-module ((calp util color) :select (calculate-fg-color))
   :use-module ((crypto) :select (sha256 checksum->string))
   :use-module ((xdg basedir) :prefix xdg-)
+  :use-module ((vcomponent recurrence) :select (repeating?))
   :use-module ((vcomponent recurrence internal) :prefix #{rrule:}#)
   :use-module ((vcomponent datetime output)
                :select (fmt-time-span
@@ -414,7 +415,7 @@
                            extra-attributes
                            `((id ,(html-id ev))
                              (data-calendar ,(base64encode (or (prop (parent ev) 'NAME) "unknown")))
-                             (data-uid ,(prop ev 'UID))
+                             (data-uid ,(output-uid ev))
 
                              (class "vevent event"
                                ,(when (and (prop ev 'PARTSTAT)
@@ -470,6 +471,30 @@
                              (else (->string value))))))
                   (prop event 'RRULE)))))
 
+
+;; Return a unique identifier for a specific instance of an event.
+;; Allows us to reference each instance of a repeating event separately
+;; from any other
+(define-public (output-uid event)
+  (string-concatenate
+   (cons
+    (prop event 'UID)
+    (when (repeating? event)
+      ;; TODO this will break if a UID already looks like this...
+      ;; Just using a pre-generated unique string would solve it,
+      ;; until someone wants to break us. Therefore, we just give
+      ;; up for now, until a proper solution can be devised.
+      (list "---"
+            ;; TODO Will this give us a unique identifier?
+            ;; Or can two events share UID along with start time
+            (datetime->string
+             (as-datetime (or
+                           ;; TODO What happens if the parameter RANGE=THISANDFUTURE is set?
+                           (prop event 'RECURRENCE-ID)
+                           (prop event 'DTSTART)))
+             "~Y-~m-~dT~H:~M:~S"))))))
+
+
 ;; TODO bind this into the xcal
 (define (editable-repeat-info event)
   (warning "editable-repeat-info is deprecated")
diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm
index 45309856..b5319ea7 100644
--- a/module/calp/html/view/calendar.scm
+++ b/module/calp/html/view/calendar.scm
@@ -13,6 +13,7 @@
                         fmt-day
                         make-block
                         fmt-single-event
+                        output-uid
                                           ))
   :use-module (calp html config)
   :use-module (calp html util)
@@ -25,6 +26,7 @@
   :use-module (srfi srfi-41)
   :use-module (srfi srfi-41 util)
 
+  :use-module ((vcomponent recurrence) :select (repeating? generate-recurrence-set))
   :use-module ((vcomponent group)
                :select (group-stream get-groups-between))
   :use-module ((base64) :select (base64encode))
@@ -361,26 +363,37 @@ window.default_calendar='~a';"
                        SEQUENCE REQUEST-STATUS
                        )))
 
-    ;; (div (@ (style "display:none !important;"))
-    ;;      ,(map (lambda (calendar)
-    ;;              (prop calendar 'NAME))
-    ;;            calendars))
-
-    ,@(let ((flat-events
-             ;; A simple filter-sorted-stream on event-overlaps? here fails.
-             ;; See tests/annoying-events.scm
-             (stream->list
-              (stream-filter
-               (lambda (ev)
-                 ((@ (vcomponent datetime) event-overlaps?)
-                  ev start-date
-                  (date+ end-date (date day: 1))))
-               (stream-take-while (lambda (ev) (date<
-                                           (as-date (prop ev 'DTSTART))
-                                           (date+ end-date (date day: 1))))
-                                  events)))))
-
-        `((div (@ (style "display:none !important;")
+    ,@(let* (
+             (flat-events
+              ;; A simple filter-sorted-stream on event-overlaps? here fails.
+              ;; See tests/annoying-events.scm
+              (stream->list
+               (stream-filter
+                (lambda (ev)
+                  ((@ (vcomponent datetime) event-overlaps?)
+                   ev start-date
+                   (date+ end-date (date day: 1))))
+                (stream-take-while (lambda (ev) (date<
+                                            (as-date (prop ev 'DTSTART))
+                                            (date+ end-date (date day: 1))))
+                                   events))))
+             (repeating% regular (partition repeating? flat-events))
+             (repeating
+              (for ev in repeating%
+                   (define instance (copy-vcomponent ev))
+
+                   (set! (prop instance 'UID) (output-uid instance))
+                   (delete-parameter! (prop* instance 'DTSTART) '-X-HNH-ORIGINAL)
+                   (delete-parameter! (prop* instance 'DTEND)   '-X-HNH-ORIGINAL)
+
+                   instance)))
+
+        `(
+          ;; Mapping showing which events belongs to which calendar,
+          ;; on the form
+          ;; (calendar (@ (key ,(base64-encode calendar-name)))
+          ;;           (li ,event-uid) ...)
+          (div (@ (style "display:none !important;")
                   (id "calendar-event-mapping"))
                ,(let ((ht (make-hash-table)))
                   (for-each (lambda (event)
@@ -388,7 +401,8 @@ window.default_calendar='~a';"
                               (hash-set! ht name
                                          (cons (prop event 'UID)
                                                (hash-ref ht name '()))))
-                            flat-events)
+                            (append regular repeating))
+
                   (hash-map->list
                    (lambda (key values)
                      `(calendar (@ (key ,(base64encode key)))
@@ -399,8 +413,7 @@ window.default_calendar='~a';"
           ;; Calendar data for all events in current interval,
           ;; rendered as xcal.
           (div (@ (style "display:none !important;")
-                  (id "xcal-data"))
-               ,((@ (vcomponent xcal output) ns-wrap)
-                 (map (@ (vcomponent xcal output) vcomponent->sxcal)
-                      flat-events
-                      ))))))))
+                   (id "xcal-data"))
+                ,((@ (vcomponent xcal output) ns-wrap)
+                  (map (@ (vcomponent xcal output) vcomponent->sxcal)
+                       (append regular repeating)))))))))
diff --git a/module/calp/html/view/calendar/week.scm b/module/calp/html/view/calendar/week.scm
index 6df51da2..d6f35ad8 100644
--- a/module/calp/html/view/calendar/week.scm
+++ b/module/calp/html/view/calendar/week.scm
@@ -14,7 +14,7 @@
                         event-zero-length?
                         events-between))
   :use-module ((calp html vcomponent)
-               :select (make-block) )
+               :select (make-block output-uid) )
   ;; :use-module ((calp html components)
   ;;              :select ())
   :use-module ((vcomponent group)
@@ -56,15 +56,8 @@
                 ,@(for event in (stream->list
                                  (events-between start-date end-date events))
                        `(popup-element
-                         ;; TODO
                          (@ (class "vevent")
-                            (data-uid ,(prop event 'UID)))
-                         )
-                       #;
-                       ((@ (calp html vcomponent ) popup) ;
-                       event (string-append "popup" (html-id event))))
-
-                ))
+                            (data-uid ,(output-uid event)))))))
 
       ;; description in sidebar / tab of popup
       (template (@ (id "vevent-description"))