diff options
Diffstat (limited to 'module/calp/server/routes.scm')
| -rw-r--r-- | module/calp/server/routes.scm | 67 |
1 files changed, 65 insertions, 2 deletions
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)) |