commit 91e8cae0fc4cc52057210662f1ba7c0b8ec17413 (patch)
parent 11f6e0210495c6cd99125b53b501990d7ec76a09
Author: Alex Karle <alex@alexkarle.com>
Date: Sun, 13 Nov 2022 15:38:16 -0500
rsvp: Add initial scaffolding for persistent rsvp storage
I should have broken this up into smaller changes, but I'm still
trying to learn emacs and REPL development and am out of my comfort
zone a bit.
This patch implements:
* The beginnings of a "fetch RSVP's from DB"
* The forms to dispaly the current RSVP state
The next step will be to persist these to the db on submit.
Diffstat:
4 files changed, 164 insertions(+), 6 deletions(-)
diff --git a/src/.gitignore b/src/.gitignore
@@ -0,0 +1 @@
+rsvp.sqlite3
+\ No newline at end of file
diff --git a/src/db.scm b/src/db.scm
@@ -0,0 +1,74 @@
+(import sqlite3
+ sql-null
+ (chicken condition)
+ (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 (get-guest-by-name name)
+ (apply make-guest
+ (first-row conn
+"SELECT
+ id,
+ name,
+ party_id,
+ going,
+ meal_choice,
+ has_plus1,
+ plus1_going,
+ plus1_meal_choice
+FROM guests WHERE name = $name" name)))
+
+(define (get-guests-in-party pid)
+ (map-row make-guest conn
+"SELECT
+ id,
+ name,
+ party_id,
+ going,
+ meal_choice,
+ has_plus1,
+ plus1_going,
+ plus1_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-name name)
+ ;; get-guest-by-name can throw if none found
+ (call/cc
+ (lambda (c)
+ (with-exception-handler
+ (lambda (x) (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))))))))
+
+(define (update-guest g)
+ (call/cc
+ (lambda (c)
+ (with-exception-handler
+ (lambda (x) (print x) (c #f))
+ (lambda ()
+ (update conn "
+UPDATE guests SET
+ name = $1,
+ going = $2,
+ meal_choice = $3,
+ plus1_going = $4,
+ plus1_meal_choice = $5
+WHERE id = $6"
+ (guest-name g)
+ (guest-going g)
+ (guest-meal-choice g)
+ (guest-plus1-going g)
+ (guest-plus1-meal-choice g)
+ (guest-id g)))))))
diff --git a/src/handler.scm b/src/handler.scm
@@ -3,7 +3,11 @@
spiffy
uri-common
intarweb
- sxml-serializer)
+ sxml-serializer
+ sql-null
+ (chicken string))
+
+(load "db.scm")
(define routes
;; See uri-match for format: http://wiki.call-cc.org/eggref/5/uri-match#routes-format
@@ -51,6 +55,47 @@
(button "Lookup"))
(p "Please let us know by DATE whether you can make it!")))))
+(define (guest-to-form g)
+ ;; Given a guest record, generate a SXML form for their settings
+ ;; TODO: expand plus-1's
+ (define (get-going-attrs val)
+ `((name ,(conc (number->string (guest-id g)) "__going"))
+ (value ,val)
+ (type "radio")
+ (required "true")
+ ,@(let ((going (guest-going g)))
+ (cond ((equal? val "no") (if (eq? going 0) '((checked)) '()))
+ ((equal? val "yes") (if (eq? going 1) '((checked)) '()))
+ ((equal? val "null") (if (sql-null? going) '((checked)) '()))
+ (else (error "Bad val"))))))
+
+ (define (get-meal-attrs val)
+ `((name ,(conc (number->string (guest-id g)) "__meal_choice"))
+ (value ,val)
+ (type "radio")
+ (required "true")
+ ,@(if (equal? (guest-meal-choice g) val)
+ '((checked))
+ '())))
+
+ ;; TODO: add notes section for allergies, etc
+ `((div (@ (class "guest"))
+ (h4 ,(guest-name g))
+ (fieldset
+ (legend "Will You be Attending?")
+ (label (input (@ ,@(get-going-attrs "yes"))) "Yes!")
+ (br)
+ (label (input (@ ,@(get-going-attrs "no"))) "No :(")
+ (br)
+ (label (input (@ ,@(get-going-attrs "null"))) "Not Sure Yet..."))
+ (fieldset
+ (legend "Meal Choice")
+ (label (input (@ ,@(get-meal-attrs "chicken"))) "Chicken")
+ (br)
+ (label (input (@ ,@(get-meal-attrs "beef"))) "Beef")
+ (br)
+ (label (input (@ ,@(get-meal-attrs "vegetarian"))) "Chicken")))))
+
(define (route-get-rsvp c)
;; TODO: consider a POST instead of GET to prevent people from sharing
;; their edit links?
@@ -58,16 +103,26 @@
(name (alist-ref 'rsvp-name q)))
(send-sxml
(template-page
- ;; TODO: look up name in database!
- (if name
+ (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."))
+ "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 "
- (a (@ (href "mailto:rsvp@jennex.org")) "rsvp@jennex.org") ".")))))))
+ (a (@ (href "mailto:rsvp@jennex.org")) "rsvp@jennex.org") "."))))))))
-(define (route-post-rsvp c) (send-response status: 'ok body: "hello!"))
+(define (route-post-rsvp c)
+ (let ((fdata (read-urlencoded-request-data (current-request))))
+ (send-sxml
+ (template-page
+ `((h2 "RSVP")
+ (p "Success! Thanks for RSVP-ing.")
+ (p (a (@ (href "/rsvp")) "Edit your response"))
+ (p (a (@ (href "https://jennex.org")) "Read more about the event")))))))
diff --git a/src/setup.sql b/src/setup.sql
@@ -0,0 +1,27 @@
+-- Parties just group a series of guests so they can RSVP for eachother
+CREATE TABLE parties (
+ id INTEGER PRIMARY KEY AUTOINCREMENT
+);
+
+-- Guests store individual preferences for meals, etc
+CREATE TABLE guests (
+ id INTEGER PRIMARY KEY AUTOINCREMENT,
+ name VARCHAR(255) NOT NULL,
+ party_id INTEGER,
+ 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 guests (name, party_id, has_plus1) VALUES
+ ('Alex', 1, False),
+ ('Jennie', 1, False),
+ ('Matt', 2, True),
+ ('Sarah', NULL, True),
+ ('Sammy', 2, True);
