From feebf252b4a51467863ccba5d25b180548f79ef2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Wed, 6 Apr 2022 01:09:31 +0200 Subject: work --- module/calp/html/vcomponent.scm | 35 +++--------- module/calp/html/view/calendar.scm | 13 +++-- module/calp/html/view/calendar/month.scm | 4 +- module/calp/html/view/calendar/week.scm | 7 ++- module/calp/server/routes.scm | 67 +++++++++++++++++++++- module/vcomponent/util/instance/methods.scm | 89 +++++++++++++++-------------- static/components/vevent-edit.ts | 9 ++- static/server_connect.ts | 5 +- 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 . ;; @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 ) calendar event) - (cond - [(get-event-by-uid this (prop event 'UID)) - => (lambda (old-event) +(define-method (update-and-save-event (this ) 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 ) 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 ) 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); -- cgit v1.2.3