diff options
Diffstat (limited to 'haunt/jakob/dynamic/capabilities/rsvp-form.scm')
| -rw-r--r-- | haunt/jakob/dynamic/capabilities/rsvp-form.scm | 135 |
1 files changed, 114 insertions, 21 deletions
diff --git a/haunt/jakob/dynamic/capabilities/rsvp-form.scm b/haunt/jakob/dynamic/capabilities/rsvp-form.scm index 8c97c58..853fa60 100644 --- a/haunt/jakob/dynamic/capabilities/rsvp-form.scm +++ b/haunt/jakob/dynamic/capabilities/rsvp-form.scm @@ -15,27 +15,28 @@ ;;; <http://www.gnu.org/licenses/>. (define-module (jakob dynamic capabilities rsvp-form) - ;; #:use-module (gcrypt base64) #:use-module (haunt html) - ;; #:use-module (ice-9 match) #:use-module (jakob dynamic capabilities rsvp) - ;; #:use-module (jakob dynamic captcha) - ;; #:use-module (jakob dynamic util) + #:use-module (jakob dynamic util) #:use-module (jakob theme) #:use-module (jakob utils sxml) - ;; #:use-module (json) + #:use-module (json) + #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) - ;; #:use-module (srfi srfi-11) + #:use-module (srfi srfi-11) + #:use-module (sxml simple) #:use-module (web request) - ;; #:use-module (web response) #:use-module (web uri) - #:export (get-rsvp-form)) + #:export (get-rsvp-form + get-rsvp-edit-form + post-rsvp-form + post-rsvp-edit-form)) (define (event-name invitation-code) (let ((event-info (event-info-internal invitation-code))) (assoc-ref event-info 'title))) -(define (render-rsvp-form invitation-code) +(define* (render-rsvp-form invitation-code #:optional edit) (let ((event-info (event-info-internal invitation-code))) `((div (@ (id "rsvp")) (div (@ (id "event-info")) @@ -46,31 +47,86 @@ '())) (p ,(assoc-ref event-info 'location)) (p ,(assoc-ref event-info 'date)) - (p ,(assoc-ref event-info 'description)) - (form (@ (id "rsvp-input")) + ,@(drop (call-with-input-string (assoc-ref event-info 'description) xml->sxml) 1) + (form (@ (id "rsvp-input") + (method "post") + (action ,(if edit + (format #f "/api/event/edit/~a" invitation-code) + (format #f "/api/event/~a" invitation-code)))) (fieldset + ,@(if edit + `((input (@ (hidden #t) (name "update") (value ,invitation-code)))) + `((input (@ (hidden #t) (name "id") (value ,invitation-code))))) (legend "Your Info") (label (@ (for "name")) "Name:") - (input (@ (type "text") (id "name") (name "name") (required #t) (size 24))) + (input (@ (type "text") + (id "name") + (name "name") + (value ,(if (and edit (assoc-ref event-info 'name)) + (assoc-ref event-info 'name) + "")) + (required #t) + (size 24))) (label (@ (for "email")) "Email:") - (input (@ (type "text") (id "email") (name "email") (required #t) (size 24)))) + (input (@ (type "text") + (id "email") + (name "email") + (value ,(if (and edit (assoc-ref event-info 'email)) + (assoc-ref event-info 'email) + "")) + (required #t) + (size 24)))) (fieldset (legend "RSVP Status") - (input (@ (type "radio") (id "attending") (name "rsvp"))) + (input (@ (type "radio") + (id "attending") + (name "rsvp") + (value "attending") + ,@(if (and edit + (assoc-ref event-info 'attending) + (string= "attending" (assoc-ref event-info 'attending))) + '((checked #t)) + '()))) (label (@ (for "attending")) "Attending") - (input (@ (type "radio") (id "tentative") (name "rsvp"))) + (input (@ (type "radio") + (id "tentative") + (name "rsvp") + (value "tentative") + ,@(if (and edit + (assoc-ref event-info 'attending) + (string= "tentative" (assoc-ref event-info 'attending))) + '((checked #t)) + '()))) (label (@ (for "tentative")) "Tentative") - (input (@ (type "radio") (id "not-attending") (name "rsvp"))) + (input (@ (type "radio") + (id "not-attending") + (name "rsvp") + (value "not-attending") + ,@(if (and edit + (assoc-ref event-info 'attending) + (string= "not-attending" (assoc-ref event-info 'attending))) + '((checked #t)) + '()))) (label (@ (for "not-attending")) "Not Attending")) (fieldset (legend "Guests") - (div (@ (id "guest-view"))) - (input (@ (type "button") (id "add-entry") (value "+"))) - (input (@ (type "button") (id "remove-entry") (value "-")))) + (div (@ (id "guest-view")) + (input (@ (type "text") (id "guest-list") (name "guests")))) + (input (@ (type "button") (id "add-entry") (value "+") (hidden #t))) + (input (@ (type "button") (id "remove-entry") (value "-") (hidden #t)))) (fieldset (legend "All Set?") - (input (@ (type "button") (id "submit-form") (value "Submit"))))) - (div (@ (id "rsvp-global")))))))) + (input (@ (type "submit") (id "submit-form") (value "Submit"))))) + ,(script "rsvp-min.js")))))) + +(define* (render-receipt params) + (let ((receipt-url (format #f "https://jakob.space/api/event/edit/~a" + (assoc-ref params "receipt")))) + `((div (@ (id "rsvp")) + (p "Thanks for registering! Please bookmark or save the following link: " + ,(hyperlink receipt-url receipt-url) + ".") + (p "This will enable you to edit your RSVP later."))))) (define (get-rsvp-form request body) ;; TODO @@ -83,3 +139,40 @@ (theme #:title (format #f "You've Been Invited to ~a!" (event-name invitation-code)) #:content form))))) + +(define (get-rsvp-edit-form request body) + ;; TODO + (let* ((path-encoded (uri-path (request-uri request))) + (path (split-and-decode-uri-path path-encoded)) + (invitation-code (last path)) + (form (render-rsvp-form invitation-code #t))) + (values '((content-type . (text/html))) + (sxml->html-string + (theme + #:title (format #f "Edit Your Invitation to ~a" (event-name invitation-code)) + #:content form))))) + +(define (formdata->alist params) + (map (lambda (pair) + (cons (car pair) (cadr pair))) + params)) + +(define (post-rsvp-form request body) + ;; TODO + (let* ((params (formdata->alist (decode-form (utf8->string body))))) + (let-values (((_ json) (create-new-event-rsvp params))) + (values '((content-type . (text/html))) + (sxml->html-string + (theme + #:title (format #f "Thank you!") + #:content (render-receipt (json-string->scm json)))))))) + +(define (post-rsvp-edit-form request body) + ;; TODO + (let* ((params (formdata->alist (decode-form (utf8->string body))))) + (let-values (((_ json) (update-event-rsvp params))) + (values '((content-type . (text/html))) + (sxml->html-string + (theme + #:title (format #f "Thank you!") + #:content (render-receipt (json-string->scm json)))))))) |