jennex

Our Wedding Site
git clone git://git.alexkarle.com.com/jennex
Log | Files | Refs | README | LICENSE

commit bbec2b171c5f5bb2b47c9c64146ed8b917c920d6 (patch)
parent c712cabb72dbf53844f61ff31dadde617b18e644
Author: Alex Karle <alex@alexkarle.com>
Date:   Mon, 14 Nov 2022 20:37:04 -0500

rsvp: Overhaul party and plus1 system (now with notes!)

I hadn't implemented any of the "plus1" for individuals, and I think a
cleaner route will just be to plug each plus1 in as a "Guest" for the
party with the name "Foo Bar's Plus 1" and then just allow the party
members to update their names.

The main meat of this change was updating the code to handle a party
instead of individuals. Fetching a whole party is a nice way to handle
the form.

Finally, this patch updates the form to have a textarea for party-notes,
which will be important for misc. things guests need us to know!

Diffstat:
Msrc/db.scm | 68+++++++++++++++++++++++++++++++-------------------------------------
Msrc/handler.scm | 99+++++++++++++++++++++++++++++++++++++++++++++++++------------------------------
Msrc/main.scm | 2+-
Msrc/setup.sql | 24+++++++++++++-----------
Mstyle.css | 17+++++++++++++++++
5 files changed, 124 insertions(+), 86 deletions(-)

diff --git a/src/db.scm b/src/db.scm @@ -1,22 +1,27 @@ (import sqlite3 sql-null (chicken condition) + (chicken string) (chicken format)) (define conn (open-database "rsvp.sqlite3")) -(define-record guest - id name party-id going meal-choice - has-plus1 plus1-going plus1-meal-choice) - +(define-record guest id name party-id going meal-choice) (set-record-printer! guest (lambda (x o) - (fprintf o "(id: ~A name: ~A going: ~A meal: ~A)" + (fprintf o "(guest id: ~A name: ~A going: ~A meal: ~A)" (guest-id x) (guest-name x) (guest-going x) (guest-meal-choice x)))) +(define-record party id notes guests) +(set-record-printer! party + (lambda (x o) + (fprintf o "(party id: ~A guests: ~A)" + (party-id x) + (map (lambda (x) (guest-name x)) (party-guests x))))) + (define (get-guest-by-name name) (apply make-guest (first-row conn @@ -25,10 +30,7 @@ name, party_id, going, - meal_choice, - has_plus1, - plus1_going, - plus1_meal_choice + meal_choice FROM guests WHERE name = $name" name))) (define (get-guest-by-id id) @@ -39,10 +41,7 @@ FROM guests WHERE name = $name" name))) name, party_id, going, - meal_choice, - has_plus1, - plus1_going, - plus1_meal_choice + meal_choice FROM guests WHERE id = $name" id))) (define (get-guests-in-party pid) @@ -52,38 +51,33 @@ FROM guests WHERE id = $name" id))) name, party_id, going, - meal_choice, - has_plus1, - plus1_going, - plus1_meal_choice + meal_choice FROM guests WHERE party_id = $pid" pid)) -;(map guest-name (get-party-by-name "Alex")) -;(map guest-name (get-party-by-name "Sarah")) -;(map guest-name (get-party-by-name "Foo")) +(define (get-party-by-id pid) + (let ((res (first-row conn "SELECT id, notes FROM parties"))) + (make-party (car res) (cadr res) '()))) + (define (get-party-by-name name) - ;; get-guest-by-name can throw if none found - (call/cc - (lambda (c) - (with-exception-handler - (lambda (exn) (print-error-message exn) (c '())) - (lambda () - (let* ((guest (get-guest-by-name name)) - (party-id (guest-party-id guest))) - (if (not (sql-null? party-id)) - (get-guests-in-party party-id) - (list guest)))))))) + ;; Throws <sqlite3 exn> if any queries return empty fails + (let* ((guest (get-guest-by-name name)) + (party-id (guest-party-id guest)) + (guests (get-guests-in-party party-id)) + (party (get-party-by-id party-id))) + (party-guests-set! party guests) + party)) (define (update-guest g) (update conn " UPDATE guests SET + name = $1, going = $2, - meal_choice = $3, - plus1_going = $4, - plus1_meal_choice = $5 - WHERE id = $6" + meal_choice = $3 + WHERE id = $4" + (guest-name g) (guest-going g) (guest-meal-choice g) - (guest-plus1-going g) - (guest-plus1-meal-choice g) (guest-id g))) + +(define (update-party-notes pid notes) + (update conn "UPDATE parties SET notes = $1 WHERE id = $2" notes pid)) diff --git a/src/handler.scm b/src/handler.scm @@ -39,6 +39,7 @@ (nav (a (@ (href "https://jennex.org")) "Home") (a (@ (href "https://jennex.org/story.html")) "Our Story") + (a (@ (href "/")) "RSVP") (a (@ (href "https://jennex.org/event.html")) "Event") (a (@ (href "https://jennex.org/travel.html")) "Travel") (a (@ (href "https://jennex.org/registry.html")) "Registry")) @@ -68,8 +69,8 @@ (value ,val) (type "radio") (required "true") - ,@(let ((getter (assoc key key-to-getter))) - (if (and getter (equal? ((cdr getter) g) val)) + ,@(let ((getter (alist-ref key key-to-getter equal?))) + (if (and getter (equal? (getter g) val)) '((checked)) '())))) ;; TODO: add notes section for allergies, etc @@ -89,34 +90,51 @@ (label (input (@ ,@(get-attrs "meal-choice" "vegetarian"))) "Vegetarian"))))) (define (route-get-rsvp c) - ;; TODO: consider a POST instead of GET to prevent people from sharing - ;; their edit links? - (let* ((q (uri-query (request-uri (current-request)))) - (name (alist-ref 'rsvp-name q))) - (send-sxml - (template-page - (let ((guests (get-party-by-name name))) - (if (not (null? guests)) - `((h2 "RSVP") - (p "Great news! You're invited :) We can't wait to celebrate with you!") - (p "We've found the following guests under your name. For each, please " - "select whether you'll make it and your choice of meal.") - (form (@ (action "/rsvp") (method "POST")) - ,@(map guest-to-form guests) - (button "Save"))) - `((h2 "RSVP") - (p "Sorry! We can't find anyone under the name '" ,name - "'. Please double check the spelling and if it looks like a " - "mistake on our end email us at " ,email)))))))) - + (call/cc + (lambda (c) + (with-exception-handler + (lambda (exn) + (print-error-message exn) + (print-call-chain) + (send-sxml + (template-page + `((h2 "RSVP") + (p "Sorry! We can't find anyone under that name. " + "Please double check the spelling and if it looks like a " + "mistake on our end email us at " ,email) + (p (a (@ (href "/")) "Back"))))) + (c #f)) + (lambda () + ;; TODO: consider a POST instead of GET to prevent people from sharing + ;; their edit links? + (let* ((q (uri-query (request-uri (current-request)))) + (name (alist-ref 'rsvp-name q))) + (send-sxml + (template-page + (let ((party (get-party-by-name name))) + `((h2 "RSVP") + (p "Great news! You're invited :) We can't wait to celebrate with you!") + (p "We've found the following guests under your name. For each, please " + "select whether you'll make it and your choice of meal.") + (form (@ (action "/rsvp") (method "POST")) + ,@(map guest-to-form (party-guests party)) + (h4 "Additional Information") + (label (@ (for "notes")) "Anything else we should know? (Allergies, kids, ...)") + (textarea (@ (class "party-notes") + (name ,(conc (party-id party) "__notes")) + (rows 10)) + ,(let ((notes (party-notes party))) + (if (sql-null? notes) + "" + notes))) + (button (@ (class "party-update")) "Save")))))))))))) (define key-to-setter ;; Just an a-list of input names -> guest-setter functions ;; (allowing the request to specify any string is dangerous) - `((going . ,guest-going-set!) - (meal-choice . ,guest-meal-choice-set!) - (plus1-going . ,guest-plus1-going-set!) - (plus1-meal-choice . ,guest-plus1-meal-choice-set!))) + `(("going" . ,guest-going-set!) + ("meal-choice" . ,guest-meal-choice-set!) + ("name" . ,guest-name-set!))) (define (route-post-rsvp c) (call/cc @@ -124,6 +142,7 @@ (with-exception-handler (lambda (exn) (print-error-message exn) + (print-call-chain) (send-sxml (template-page `((h2 "RSVP") @@ -134,7 +153,9 @@ (lambda () ;; The data is in pairs of (ID__key . val), so the first thing to do ;; is to walk through that data and build up a view of each guest - (let loop ((guests '()) (fdata (read-urlencoded-request-data (current-request)))) + (let loop ((guests '()) + (fdata (read-urlencoded-request-data (current-request))) + (notes "")) (if (null? fdata) ;; Done parsing all our form data (begin ;; This will raise if update-guest fails (so we get an error page) @@ -142,6 +163,7 @@ (let* ((first-guest (cdadr guests)) (first-name (guest-name first-guest)) (edit-link (conc "/rsvp?rsvp-name=" (uri-encode-string first-name)))) + (update-party-notes (guest-party-id first-guest) notes) (send-sxml (template-page `((h2 "RSVP") @@ -153,13 +175,16 @@ (value (cdr input)) (split (string-split (symbol->string name) "__")) (id (string->number (car split))) - (cached-guest (assoc id guests)) - (key (string->symbol (cadr split))) - (setter! (cdr (assoc key key-to-setter)))) - (if cached-guest - (begin - (setter! (cdr cached-guest) value) - (loop guests (cdr fdata))) - (let ((guest (get-guest-by-id id))) - (setter! guest value) - (loop (cons (cons id guest) guests) (cdr fdata)))))))))))) + (cached-guest (alist-ref id guests)) + (key (cadr split)) + (setter! (alist-ref key key-to-setter equal?))) + ;; special case notes since it updates the party + (if (equal? key "notes") + (loop guests (cdr fdata) value) + (if cached-guest + (begin + (setter! cached-guest value) + (loop guests (cdr fdata) notes)) + (let ((guest (get-guest-by-id id))) + (setter! guest value) + (loop (cons (cons id guest) guests) (cdr fdata) notes)))))))))))) diff --git a/src/main.scm b/src/main.scm @@ -15,7 +15,7 @@ ;; Spiffy recommends using vhost-map to assign dynamic routes ;; (even if we aren't using the vhost portion of it) -(vhost-map `(("localhost" . ,(uri-match/spiffy routes)))) +(vhost-map `((".*" . ,(uri-match/spiffy routes)))) (define (main args) (print (format "Starting up! Listening on port ~A..." (server-port))) diff --git a/src/setup.sql b/src/setup.sql @@ -1,3 +1,7 @@ +-- Start fresh +DROP TABLE parties; +DROP TABLE guests; + -- Parties just group a series of guests so they can RSVP for eachother CREATE TABLE parties ( id INTEGER PRIMARY KEY AUTOINCREMENT, @@ -8,21 +12,19 @@ CREATE TABLE parties ( CREATE TABLE guests ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(255) NOT NULL, - party_id INTEGER, + party_id INTEGER NOT NULL, going INTEGER, meal_choice VARCHAR(255), - has_plus1 INTEGER NOT NULL, - plus1_going INTEGER, - plus1_meal_choice VARCHAR(255), FOREIGN KEY(party_id) REFERENCES parties(id) ); -INSERT INTO parties (id) VALUES (1), (2); +INSERT INTO parties (id) VALUES (1), (2), (3); -INSERT INTO guests (name, party_id, has_plus1) VALUES - ('Alex', 1, False), - ('Jennie', 1, False), - ('Matt', 2, True), - ('Sarah', NULL, True), - ('Sammy', 2, True); +INSERT INTO guests (name, party_id) VALUES + ('Alex', 1), + ('Jennie', 1), + ('Matt', 2), + ('Sarah', 3), + ('Sarah''s plus 1', 3), + ('Sammy', 2); diff --git a/style.css b/style.css @@ -81,3 +81,20 @@ footer { margin-top: 4em; font-size: .6em; } + +textarea.party-notes { + display: block; + width: 100%; +} + +button.party-update { + display: block; + margin: 16 auto; + font-size: 1.2em; + padding: 8px 48px; + color: #FFFFFF; + background-color: #198754; + border-color: #198754; + border-radius: 8px; + box-shadow: rgba(149, 157, 165, 0.2) 0px 8px 24px; +}