diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-06-23 01:39:08 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-06-23 01:39:08 +0200 |
commit | 327b322b9583f760cd02ddad7a2a8890df26cc8b (patch) | |
tree | d0a73d5df0011233f3eaa5d9a54d1317fad50bbc /module/calp/server/routes.scm | |
parent | Minor cleanup in recurrence generate. (diff) | |
download | calp-327b322b9583f760cd02ddad7a2a8890df26cc8b.tar.gz calp-327b322b9583f760cd02ddad7a2a8890df26cc8b.tar.xz |
workuid-stuff-2
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 3d90cc04..37111c71 100644 --- a/module/calp/server/routes.scm +++ b/module/calp/server/routes.scm @@ -32,6 +32,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)) @@ -207,7 +213,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) @@ -269,8 +275,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)) |