workuid-stuff

8 files changed, 149 insertions, 80 deletions

diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm
index 574ad954..69e955db 100644
--- a/module/calp/html/vcomponent.scm
+++ b/module/calp/html/vcomponent.scm
@@ -99,7 +99,9 @@
             (class ,(when (and (prop ev 'PARTSTAT)
                                (eq? 'TENTATIVE (prop ev 'PARTSTAT)))
                       " tentative "))
-            (data-uid ,(output-uid ev)))))
+            ,@(when (repeating? ev)
+                `((data-instance ,(datetime->string (as-datetime (prop ev 'DTSTART))))))
+            (data-uid ,(prop ev 'UID)))))
     (div (@ (class "vevent eventtext summary-tab"))
          (h3 ,(fmt-header
                (when (prop ev 'RRULE)
@@ -283,7 +285,9 @@
                            extra-attributes
                            `((id ,(html-id ev) "-block")
                              (data-calendar ,(base64encode (or (prop (parent ev) 'NAME) "unknown")))
-                             (data-uid ,(output-uid ev))
+                             (data-uid ,(prop ev 'UID))
+                             ,@(when (repeating? ev)
+                                 `((data-instance ,(datetime->string (as-datetime (prop ev 'DTSTART))))))
 
                              (class "vevent event"
                                ,(when (and (prop ev 'PARTSTAT)
@@ -342,29 +346,6 @@
                   (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"))))))
-
-
 (define (week-day-select args)
   `(select (@ ,@args)
      (option "-")
@@ -475,7 +456,9 @@
                ;; (hr)
 
 
-               (input (@ (type "submit")))
+               (input (@ (type "submit") (data-key "this") (value "This")))
+               (input (@ (type "submit") (data-key "this_future") (value "This & Future")))
+               (input (@ (type "submit") (data-key "all") (value "All")))
                ))))
 
 ;; description in sidebar / tab of popup
diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm
index 6945c5d2..25cfb575 100644
--- a/module/calp/html/view/calendar.scm
+++ b/module/calp/html/view/calendar.scm
@@ -10,7 +10,6 @@
                         fmt-day
                         make-block
                         fmt-single-event
-                        output-uid
                                           ))
   :use-module (calp html config)
   :use-module (calp html util)
@@ -30,6 +29,8 @@
 
   :use-module (ice-9 format)
   :use-module (calp translation)
+  :use-module ((vcomponent formats xcal output)
+               :select (vcomponent->sxcal))
   )
 
 
@@ -380,11 +381,11 @@ window.default_calendar='~a';"
                                             (date+ post-end (date day: 1))))
                                    events))))
              (repeating% regular (partition repeating? flat-events))
+             ;;; TODO
              (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)
 
@@ -417,5 +418,9 @@ window.default_calendar='~a';"
           (div (@ (style "display:none !important;")
                    (id "xcal-data"))
                 ,((@ (vcomponent formats xcal output) ns-wrap)
-                  (map (@ (vcomponent formats xcal output) vcomponent->sxcal)
-                       (append regular repeating)))))))))
+                  (append
+                   (map vcomponent->sxcal regular)
+                   (map (lambda (ev)
+                          (set! (prop ev 'X-HNH-INSTANCE-ID)
+                            (datetime->string (as-datetime (prop ev 'DTSTART))))
+                          (vcomponent->sxcal ev)) repeating)))))))))
diff --git a/module/calp/html/view/calendar/month.scm b/module/calp/html/view/calendar/month.scm
index 2b4c888a..b5328571 100644
--- a/module/calp/html/view/calendar/month.scm
+++ b/module/calp/html/view/calendar/month.scm
@@ -11,7 +11,7 @@
                :select (really-long-event?
                         events-between))
   :use-module ((calp html vcomponent)
-               :select (make-block output-uid))
+               :select (make-block))
   :use-module ((vcomponent util group)
                :select (group-stream get-groups-between))
   )
@@ -83,7 +83,7 @@
                      (events-between pre-start post-end events))
            `(popup-element
              (@ (class "vevent")
-                (data-uid ,(output-uid event)))))
+                (data-uid ,(prop event 'UID)))))
 
     (template
      (@ (id "vevent-block"))
diff --git a/module/calp/html/view/calendar/week.scm b/module/calp/html/view/calendar/week.scm
index 16337102..7d8f83d2 100644
--- a/module/calp/html/view/calendar/week.scm
+++ b/module/calp/html/view/calendar/week.scm
@@ -14,13 +14,14 @@
                         event-zero-length?
                         events-between))
   :use-module ((calp html vcomponent)
-               :select (make-block output-uid) )
+               :select (make-block) )
   ;; :use-module ((calp html components)
   ;;              :select ())
   :use-module (calp translation)
   :use-module ((vcomponent util group)
                :select (group-stream get-groups-between))
   :use-module (ice-9 format)
+  :use-module ((vcomponent recurrence) :select (repeating?))
   )
 
 
@@ -63,7 +64,9 @@
                                  (events-between start-date end-date events))
                        `(popup-element
                          (@ (class "vevent")
-                            (data-uid ,(output-uid event)))))))
+                            ,@(when (repeating? event)
+                                `((data-instance ,(datetime->string (as-datetime (prop event 'DTSTART))))))
+                            (data-uid ,(prop event 'UID)))))))
 
 
       ;; This template is here, instead of in (calp html calendar) since it only
diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm
index 8c416585..930f153d 100644
--- a/module/calp/server/routes.scm
+++ b/module/calp/server/routes.scm
@@ -31,6 +31,12 @@
 
   :autoload (vcomponent util instance) (global-event-object)
 
+  :use-module (vcomponent recurrence)
+  :use-module ((vcomponent recurrence internal) :select (until))
+  :use-module (srfi srfi-41)
+  :use-module (srfi srfi-41 util)
+  :use-module (hnh util uuid)
+
   :use-module (calp util config)
   :use-module (calp html view calendar)
   :use-module ((calp html view search) :select (search-result-page))
@@ -199,7 +205,7 @@
 
    ;; TODO this fails when dtstart is <date>.
    ;; @var{cal} should be the name of the calendar encoded in base64.
-   (POST "/insert" (cal data)
+   (POST "/insert" (cal data submit_type)
 
          (unless (and cal data)
            (return (build-response code: 400)
@@ -263,8 +269,65 @@
 
              (parameterize ((warnings-are-errors #t))
                (catch*
-                (lambda () (add-and-save-event global-event-object
+                (lambda ()
+                  (if (repeating? event)
+                      (cond
+                       ((not (string? submit_type))
+                        (scm-error 'wrong-type-arg #f
+                                   "Expected string, got ~s" (list submit_type) #f)
+                        )
+                       ((string=? submit_type "this")
+                        ;; Change this instance only
+                        ;; set EXDATE
+                        (string->datetime (prop event 'X-HNH-INSTANCE-ID))
+                        )
+                       ;; change this and future instances
+                       ((string=? submit_type "this_future")
+                        ;; mark original event's RRULE with until this event
+                        ;; create new event, which should be really similar
+                        (let* ((og-event  (get-event-by-uid global-event-object (prop event 'UID)))
+                               (occurences (generate-recurrence-set og-event))
+                               (pairs (stream-zip occurences (stream-cdr occurences)))
+                               (dt (string->datetime (prop event 'X-HNH-INSTANCE-ID))))
+                          ;; find recurrence instance before this one
+                          (let ((last-of-old-instances
+                                 (car
+                                  (stream-find (lambda (p) (datetime= dt (cadr (prop p 'DTSTART))))
+                                               pairs))))
+                            (let ((event-a event)
+                                  (event-b (copy-vcomponent event)))
+                              (set!
+                                  (prop event-a 'RRULE)
+                                (set-> (prop og-event 'RRULE)
+                                       (until (prop last-of-old-instances 'DTSTART)))
+                                (prop event-a 'DTSTART) (prop og-event 'DTSTART)
+                                (prop event-a 'DTEND) (prop og-event 'DTEND)
+                                (prop event-b 'UID) (uuid)
+                                )
+                              )
+                            ))
+                        ;; use its date as UNTIL in RRULE
+                        )
+                       ((string=? submit_type "all")
+                        ;; change all instances
+                        (let ((og-event (get-event-by-uid global-event-object (prop event 'UID))))
+                          (set!
+                              (prop event 'DTSTART)
+                            (datetime date: (as-date (prop og-event 'DTSTART))
+                                      time: (as-time (prop event 'DTSTART)))
+                            (prop event 'DTEND)
+                            (datetime date: (as-date (prop og-event 'DTEND))
+                                      time: (as-time (prop event 'DTEND))))
+                          (add-and-save-event global-event-object
+                                              calendar event)))
+                       (else
+                        (scm-error 'misc-error #f
+                                   "Invalid submit_type: ~s"
+                                   (list submit_type) #f)))
+                      ;; else (if not repeating)
+                      (add-and-save-event global-event-object
                                           calendar event))
+                  )
                 (warning
                  (lambda (err fmt args)
                    (define str (format #f "~?" fmt args))
diff --git a/module/vcomponent/util/instance/methods.scm b/module/vcomponent/util/instance/methods.scm
index 028e01c0..a127ef8d 100644
--- a/module/vcomponent/util/instance/methods.scm
+++ b/module/vcomponent/util/instance/methods.scm
@@ -160,61 +160,66 @@
                         (prop event 'UID)))
               (slot-ref this 'event-set)))
 
-  (hash-set! (slot-ref this 'uid-map) (prop event 'UID)
-             #f))
+  (remove-child! (parent event) event)
 
+  (hash-remove! (slot-ref this 'uid-map) (prop event 'UID)))
 
 
-(define-method (add-and-save-event (this <events>) calendar event)
-  (cond
-   [(get-event-by-uid this (prop event 'UID))
-    => (lambda (old-event)
+(define-method (update-and-save-event (this <events>) calendar old-event)
+  ;; remove old instance of event from runtime
+  (remove-event this old-event)
 
-         ;; remove old instance of event from runtime
-         (remove-event this old-event)
-         (remove-child! (parent old-event) old-event)
+  ;; Add new event to runtime,
+  ;; MUST be done after since the two events SHOULD share UID.
+  ;; NOTE that this can emit warnings
+  (add-event this calendar old-event)
+  (remove-child! (parent old-event) old-event)
 
-         ;; Add new event to runtime,
-         ;; MUST be done after since the two events SHOULD share UID.
-         ;; NOTE that this can emit warnings
-         (add-event this calendar event)
+  (set! (prop old-event 'LAST-MODIFIED)
+    (current-datetime))
 
-         (set! (prop event 'LAST-MODIFIED)
-           (current-datetime))
+  ;; NOTE Posibly defer save to a later point.
+  ;; That would allow better asyncronous preformance.
 
-         ;; NOTE Posibly defer save to a later point.
-         ;; That would allow better asyncronous preformance.
+  ;; save-event sets -X-HNH-FILENAME from the UID. This is fine
+  ;; since the two events are guaranteed to have the same UID.
+  (unless ((@ (vcomponent formats vdir save-delete) save-event) old-event)
+    (throw 'misc-error "Saving event to disk failed."))
 
-         ;; save-event sets -X-HNH-FILENAME from the UID. This is fine
-         ;; since the two events are guaranteed to have the same UID.
-         (unless ((@ (vcomponent formats vdir save-delete) save-event) event)
-           (throw 'misc-error (_ "Saving event to disk failed.")))
 
+  (unless (eq? calendar (parent old-event))
+    ;; change to a new calendar
+    (format (current-error-port)
+            "Unlinking old event from ~a~%"
+            (prop old-event '-X-HNH-FILENAME))
+    ;; NOTE that this may fail, leading to a duplicate event being
+    ;; created (since we save beforehand). This is just a minor problem
+    ;; which either a better atomic model, or a propper error
+    ;; recovery log would solve.
+    ((@ (vcomponent formats vdir save-delete) remove-event) old-event))
 
-         (unless (eq? calendar (parent old-event))
-           ;; change to a new calendar
-           (format (current-error-port)
-                   (_ "Unlinking old event from ~a~%")
-                   (prop old-event '-X-HNH-FILENAME))
-           ;; NOTE that this may fail, leading to a duplicate event being
-           ;; created (since we save beforehand). This is just a minor problem
-           ;; which either a better atomic model, or a propper error
-           ;; recovery log would solve.
-           ((@ (vcomponent formats vdir save-delete) remove-event) old-event))
 
+  (format (current-error-port)
+          "Event updated ~a~%" (prop old-event 'UID)))
 
-         (format (current-error-port)
-                 (_ "Event updated ~a~%") (prop event 'UID)))]
 
-   [else
-    (add-event this calendar event)
+;; Add a new event, which isn't already in the event object
+(define-method (add-new-event (this <events>) calendar event)
+  (add-event this calendar event)
 
-    (set! (prop event 'LAST-MODIFIED) (current-datetime))
+  (set! (prop event 'LAST-MODIFIED) (current-datetime))
 
-    ;; NOTE Posibly defer save to a later point.
-    ;; That would allow better asyncronous preformance.
-    (unless ((@ (vcomponent formats vdir save-delete) save-event) event)
-      (throw 'misc-error (_ "Saving event to disk failed.")))
+  ;; NOTE Posibly defer save to a later point.
+  ;; That would allow better asyncronous preformance.
+  (unless ((@ (vcomponent formats vdir save-delete) save-event) event)
+    (throw 'misc-error "Saving event to disk failed."))
 
-    (format (current-error-port)
-            (_ "Event inserted ~a~%") (prop event 'UID))]))
+  (format (current-error-port)
+          "Event inserted ~a~%" (prop event 'UID))
+  )
+
+(define-method (add-and-save-event (this <events>) calendar event)
+  (cond
+   [(get-event-by-uid this (prop event 'UID))
+    => (lambda (old-event) (update-and-save-event this calendar old-event))]
+   [else (add-new-event this calendar event)]))
diff --git a/static/components/vevent-edit.ts b/static/components/vevent-edit.ts
index ee368296..22e6409a 100644
--- a/static/components/vevent-edit.ts
+++ b/static/components/vevent-edit.ts
@@ -118,9 +118,16 @@ class ComponentEdit extends ComponentVEvent {
         }
 
         let submit = this.querySelector('form') as HTMLFormElement
+        /* TODO If start or end DATE is changed, only allow THIS */
+        /* if only time component was changed, allow all */
         submit.addEventListener('submit', (e) => {
             console.log(submit, e);
-            create_event(vcal_objects.get(this.uid)!);
+            // submit button pressed (e.submitter);
+            let submit_type = 'all';
+            if (e.submitter) {
+                submit_type = e.submitter.dataset.key!;
+            }
+            create_event(submit_type, vcal_objects.get(this.uid)!);
 
             e.preventDefault();
             return false;
diff --git a/static/server_connect.ts b/static/server_connect.ts
index 61eb4f30..1d181837 100644
--- a/static/server_connect.ts
+++ b/static/server_connect.ts
@@ -54,7 +54,7 @@ async function remove_event(uid: uid) {
 //     ];
 // }
 
-async function create_event(event: VEvent) {
+async function create_event(submit_type: string, event: VEvent) {
 
     // let xml = event.getElementsByTagName("icalendar")[0].outerHTML
     let calendar = event.calendar;
@@ -66,6 +66,9 @@ async function create_event(event: VEvent) {
     console.log('calendar=', calendar/*, xml*/);
 
     let data = new URLSearchParams();
+
+    data.append('submit_type', submit_type);
+
     data.append("cal", calendar);
     // data.append("data", xml);