commit 11f6e0210495c6cd99125b53b501990d7ec76a09 (patch)
parent e874e4a5f3b08c2d9f3af879b85b642af3b6c2e1
Author: Alex Karle <alex@alexkarle.com>
Date: Sat, 12 Nov 2022 00:28:55 -0500
rsvp: Add beginnings of a CHICKEN Scheme RSVP backend
The plan is to host this at rsvp.jennex.org (separately from the
static site) and have it act as a dynamic server for the RSVP form.
It will have to:
* Fetch and display existing RSVP's
* Group guests
* Allow updating RSVP's
The plan is to do this all in Scheme for the fun and the learnings.
It's already proven educational getting my dev environment set up :)
Diffstat:
4 files changed, 119 insertions(+), 0 deletions(-)
diff --git a/src/README b/src/README
@@ -0,0 +1,14 @@
+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/dev.scm b/src/dev.scm
@@ -0,0 +1,10 @@
+;; dev.scm -- "dev mode" (runs main as thread for REPL development)
+(import srfi-18
+ (chicken process-context))
+
+(include "main.scm")
+
+(define thread
+ (begin
+ (thread-start!
+ (make-thread (lambda () (main '()))))))
diff --git a/src/handler.scm b/src/handler.scm
@@ -0,0 +1,73 @@
+;; handler.scm -- define the routes for Spiffy
+(import
+ spiffy
+ uri-common
+ intarweb
+ sxml-serializer)
+
+(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 "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 (@ (action "/rsvp"))
+ (label "Name:"
+ (input (@ (name "rsvp-name"))))
+ (button "Lookup"))
+ (p "Please let us know by DATE whether you can make it!")))))
+
+(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
+ ;; TODO: look up name in database!
+ (if 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."))
+ `((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") ".")))))))
+
+(define (route-post-rsvp c) (send-response status: 'ok body: "hello!"))
diff --git a/src/main.scm b/src/main.scm
@@ -0,0 +1,22 @@
+#!/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 `(("localhost" . ,(uri-match/spiffy routes))))
+
+(define (main args)
+ (print (format "Starting up! Listening on port ~A..." (server-port)))
+ (start-server))
