commit 200e5b0ce98880148edd5618b4e51e1319d5670e (patch)
parent e4d31c172398040a6c1690a94c3859481e7c2171
Author: Alex Karle <alex@alexkarle.com>
Date: Sat, 13 May 2023 10:49:17 -0400
rsvp: Remove rsvp program
We're going old-school with the invites; paper snail mail!
Diffstat:
10 files changed, 1 insertion(+), 376 deletions(-)
diff --git a/Makefile b/Makefile
@@ -2,7 +2,7 @@ HTML != for f in *.tmpl; do echo $$(basename $$f tmpl)html; done
SCHEME != find . -name '*.scm'
.PHONY: build
-build: build-html rsvp
+build: build-html
# Standalone target for Netlify, which doesn't have chicken-csc
@@ -18,6 +18,3 @@ clean:
(cat header.html; cat $<; cat footer.html) > $@
$(HTML): header.html footer.html Makefile
-
-rsvp: $(SCHEME)
- (cd src; chicken-csc prod.scm -o ../$@)
diff --git a/README.md b/README.md
@@ -8,13 +8,6 @@ I'm putting this together for our wedding (:tada:) in 2023 after a
quick survey of the common choices for hosted sites (The Knot, Minted,
etc).
-The goals are to have:
-
-1. A public wedding portfolio / information site for guests (mostly
- done, just static HTML)
-2. A lightweight RSVP system (likely the more interesting bit from a
- code perspective)
-
## License
All code is MIT Licensed. The cursive font used in the header (Allure)
diff --git a/src/.gitignore b/src/.gitignore
@@ -1 +0,0 @@
-rsvp.sqlite3
-\ No newline at end of file
diff --git a/src/README b/src/README
@@ -1,14 +0,0 @@
-jennex/src
-==========
-
-This directory contains all the code for the RSVP system,
-which is (hopefully) small app to fetch, display, and
-allow updates to RSVPs using simple server-side rendered
-HTML and basic elements like HTML Forms.
-
-Totally for fun and the learnings, I've chosen to use
-Spiffy, a CHICKEN Scheme Egg (library):
-
- http://wiki.call-cc.org/eggref/5/spiffy
-
-We'll see how far I get!
diff --git a/src/db.scm b/src/db.scm
@@ -1,83 +0,0 @@
-(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)
-(set-record-printer! guest
- (lambda (x o)
- (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
-"SELECT
- id,
- name,
- party_id,
- going,
- meal_choice
-FROM guests WHERE name = $name" name)))
-
-(define (get-guest-by-id id)
- (apply make-guest
- (first-row conn
-"SELECT
- id,
- name,
- party_id,
- going,
- meal_choice
-FROM guests WHERE id = $name" id)))
-
-(define (get-guests-in-party pid)
- (map-row make-guest conn
-"SELECT
- id,
- name,
- party_id,
- going,
- meal_choice
-FROM guests WHERE party_id = $pid" pid))
-
-(define (get-party-by-id pid)
- (let ((res (first-row conn "SELECT id, notes FROM parties WHERE id = $pid" pid)))
- (make-party (car res) (cadr res) '())))
-
-(define (get-party-by-name name)
- ;; 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
- WHERE id = $4"
- (guest-name g)
- (guest-going g)
- (guest-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/dev.scm b/src/dev.scm
@@ -1,17 +0,0 @@
-;; dev.scm -- "dev mode" (runs main as thread for REPL development)
-(import srfi-18
- spiffy
- (chicken process-context))
-
-(include "main.scm")
-
-(access-log "/tmp/rsvp-access.log")
-(error-log "/tmp/rsvp-error.log")
-
-(print "Logging access to " (access-log))
-(print "Logging error to " (error-log))
-
-(define thread
- (begin
- (thread-start!
- (make-thread (lambda () (main '()))))))
diff --git a/src/handler.scm b/src/handler.scm
@@ -1,194 +0,0 @@
-;; handler.scm -- define the routes for Spiffy
-(import
- spiffy
- uri-common
- intarweb
- sxml-serializer
- sql-null
- (chicken string)
- (chicken condition))
-
-(include "db.scm")
-
-(define email '(a (@ (href "mailto:rsvp@jennex.org")) "rsvp@jennex.org"))
-
-(define routes
- ;; See uri-match for format: http://wiki.call-cc.org/eggref/5/uri-match#routes-format
- ;;
- ;; NOTE: wrap the route handlers in lambdas so that the REPL picks up
- ;; changes on re-definition.
- `(((/ "") (GET ,(lambda (c) (route-get-index c))))
- ((/ "rsvp")
- (GET ,(lambda (c) (route-get-rsvp c)))
- (POST ,(lambda (c) (route-post-rsvp c))))))
-
-(define (send-sxml sxml)
- (send-response status: 'ok body: (serialize-sxml sxml)))
-
-(define (template-page sxml)
- `(html
- (head (title "Alex and Jennie's Wedding")
- (meta (@ (charset "utf-8")))
- (meta (@ (name "viewport") (content "width=device-width, initial-scale=1")))
- (link (@ (rel "icon") (type "image/png") (sizes "32x32") (href "/static/favicon-32x32.png")))
- (link (@ (rel "icon") (type "image/png") (sizes "16x16") (href "/static/favicon-16x16.png")))
- (link (@ (rel "stylesheet") (href "/style.css"))))
- (body
- (h1 (@ (class "index-title")) "Alex " (small "&") " Jennie")
- (p (@ (class "subtitle")) "Tie the Knot")
- (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"))
- ,@sxml
- (footer "Copyright 2022, Alex Karle (" (a (@ (href "https://jennex.org/license.html")) "License") ")"))))
-
-
-(define (route-get-index c)
- (send-sxml
- (template-page
- '((h2 "RSVP")
- (p "Thanks for RSVP'ing! To start, please lookup the "
- "name on your invitation.")
- (form (@ (class "find-invite") (action "/rsvp"))
- (input (@ (class "find-invite") (name "rsvp-name")))
- (button (@ (class "find-invite")) "Find Invitation"))
- (p "Please let us know by DATE whether you can make it!")))))
-
-(define (guest-to-form g)
- (define (input-name key)
- `(name ,(conc (number->string (guest-id g)) "__" key)))
- (define (get-going-attrs val)
- `(,(input-name "going")
- (value ,val)
- (type "radio")
- (required "true")
- ,@(if (equal? (guest-going g) val) '((checked)) '())))
- (define (get-meal-attrs val)
- `((value ,val)
- ,@(if (equal? (guest-meal-choice g) val) '((selected)) '())))
- ;; TODO: add notes section for allergies, etc
- `((div (@ (class "guest"))
- (fieldset
- (legend ,(guest-name g))
- (label (strong "Name: ")
- (input (@ ,(input-name "name") (required "true") (value ,(guest-name g)))))
- (p (strong "Will You be Attending?"))
- (label (input (@ ,@(get-going-attrs 1))) "Yes!")
- (br)
- (label (input (@ ,@(get-going-attrs 0))) "No :(")
- (br)
- (label (@ (class "meal-choice"))
- (strong "Meal Choice:")
- (select (@ ,(input-name "meal-choice"))
- (option (@ ,@(get-meal-attrs "")) "-- Please Select if Attending --")
- (option (@ ,@(get-meal-attrs "chicken")) "Chicken")
- (option (@ ,@(get-meal-attrs "beef")) "Beef")
- (option (@ ,@(get-meal-attrs "vegetarian")) "Vegetarian")
- (option (@ ,@(get-meal-attrs "vegan")) "Vegan")))))))
-
-(define (route-get-rsvp c)
- ;; TODO: strip trailing spaces in names? (here and on save)
- (call/cc
- (lambda (c)
- (with-exception-handler
- (lambda (exn)
- (print-error-message exn)
- ;; TODO: only print stack trace if NOT a sqlite3 no-data exeption!
- (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))
- (h3 "Additional Information")
- (label (@ (for "notes"))
- "Anything else we should know? (Allergies, kids, ...)")
- (textarea (@ (class "party-notes")
- (name ,(conc (party-id party) "__notes"))
- (rows 5))
- ,(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!)
- ("name" . ,guest-name-set!)))
-
-(define (route-post-rsvp c)
- (call/cc
- (lambda (c)
- (with-exception-handler
- (lambda (exn)
- (print-error-message exn)
- (print-call-chain)
- (send-sxml
- (template-page
- `((h2 "RSVP")
- ;; TODO: log it better...
- (p "There was an error saving your response please try again "
- "and if it continues to fail, reach out to us at " ,email))))
- (c #f))
- (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)))
- (notes ""))
- (if (null? fdata) ;; Done parsing all our form data
- (begin
- ;; This will raise if update-guest fails (so we get an error page)
- (map update-guest (map cdr guests))
- (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")
- (p "Success! Thanks for RSVP-ing.")
- (p (a (@ (href ,edit-link))) "Edit your response")
- (p (a (@ (href "https://jennex.org")) "Read more about the event")))))))
- (let* ((input (car fdata))
- (name (car input))
- (value (cdr input))
- (split (string-split (symbol->string name) "__"))
- (id (string->number (car split)))
- (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
@@ -1,22 +0,0 @@
-#!/usr/local/bin/chicken-csi -ss
-;; main.scm -- configure and start the Spiffy web server
-(import
- srfi-18
- spiffy
- spiffy-uri-match
- (chicken process-context)
- (chicken format))
-
-(include "handler.scm") ;; contains 'routes'
-
-(access-log (current-output-port))
-(error-log (current-error-port))
-(root-path "../")
-
-;; Spiffy recommends using vhost-map to assign dynamic routes
-;; (even if we aren't using the vhost portion of it)
-(vhost-map `((".*" . ,(uri-match/spiffy routes))))
-
-(define (main args)
- (print (format "Starting up! Listening on port ~A..." (server-port)))
- (start-server))
diff --git a/src/prod.scm b/src/prod.scm
@@ -1,3 +0,0 @@
-;; prod.scm -- runs main from main.scm (for compiled binary)
-(include "main.scm")
-(main '())
diff --git a/src/setup.sql b/src/setup.sql
@@ -1,30 +0,0 @@
--- 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,
- notes TEXT
-);
-
--- Guests store individual preferences for meals, etc
-CREATE TABLE guests (
- id INTEGER PRIMARY KEY AUTOINCREMENT,
- name VARCHAR(255) NOT NULL,
- party_id INTEGER NOT NULL,
- going INTEGER,
- meal_choice VARCHAR(255),
-
- FOREIGN KEY(party_id) REFERENCES parties(id)
-);
-
-INSERT INTO parties (id) VALUES (1), (2), (3);
-
-INSERT INTO guests (name, party_id) VALUES
- ('Alex', 1),
- ('Jennie', 1),
- ('Matt', 2),
- ('Sarah', 3),
- ('Sarah''s plus 1', 3),
- ('Sammy', 2);
