summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--dnd.lisp3
-rw-r--r--init.lisp13
-rw-r--r--model.lisp2
-rw-r--r--pages.lisp9
-rw-r--r--routes.lisp21
5 files changed, 30 insertions, 18 deletions
diff --git a/dnd.lisp b/dnd.lisp
index 3c80f2b..9cb4702 100644
--- a/dnd.lisp
+++ b/dnd.lisp
@@ -6,6 +6,7 @@
"The instance of the HTTP server")
(defun conjure-arena ()
+ (init-db)
(setf *dnd-arena* (lzb:create-server))
- (lzb:install-app *dnd-arena* (lzb:app))
+ (lzb:install-app *dnd-arena* (lzb:app 'dnd))
(lzb:start-server *dnd-arena*))
diff --git a/init.lisp b/init.lisp
index 535da6c..6585ea9 100644
--- a/init.lisp
+++ b/init.lisp
@@ -3,9 +3,10 @@
(in-package #:dnd)
(defun init-db (&optional config)
- (if config
- nil
- (make-instance
- 'db:mp-store
- :directory (merge-pathnames "dnd-store/" (user-homedir-pathname))
- :subsystems (list (make-instance 'db:store-object-subsystem)))))
+ (unless (boundp 'db:*store*)
+ (if config
+ nil
+ (make-instance
+ 'db:mp-store
+ :directory (merge-pathnames "dnd-store/" (user-homedir-pathname))
+ :subsystems (list (make-instance 'db:store-object-subsystem))))))
diff --git a/model.lisp b/model.lisp
index 46bf4e3..273b10c 100644
--- a/model.lisp
+++ b/model.lisp
@@ -1,7 +1,5 @@
;;;; model.lisp -- bknr.datastore class definitions for dnd
-
-
(in-package :dnd)
(deftype title ()
diff --git a/pages.lisp b/pages.lisp
index 72291e5..6d26565 100644
--- a/pages.lisp
+++ b/pages.lisp
@@ -1,5 +1,7 @@
;;;; pages.lisp -- html generation functions for dnd
+(in-package :dnd)
+
(defmacro with-page ((&key title) &body body)
`(with-html-string
(:doctype)
@@ -15,7 +17,7 @@
(:form :method "POST" :action "/godess-shrine"
(:label :for "NAME" "Enter the epithet thy hero shall be called:")
(:input :name "NAME")
- (:button :type "submit"))))
+ (:button :type "submit" "Pry To The Goddess"))))
(defun doorkeeper ()
(with-page (:title "Tavern Door")
@@ -23,11 +25,10 @@
(:form :method "POST" :action "/tavern-door"
(:label :for "NAME" "Thy Hero's Appelation:")
(:input :name "NAME")
- (:button :type "submit"))
+ (:button :type "submit" "Enter"))
(:h2 "Eh? Ye need to birth a new hero?")
(:a :href "/godess-shrine" "Follow me...")))
(defun tavern (hero)
(with-page (:title "A Bustling Tavern")
- (:h1 "Aye! Welcome " (hero-name hero))
- ()))
+ (:h1 "Aye! Welcome " (hero-name hero))))
diff --git a/routes.lisp b/routes.lisp
index b0b81ac..f737c80 100644
--- a/routes.lisp
+++ b/routes.lisp
@@ -13,10 +13,20 @@
(setf (lzb:response-header :location) location
(lzb:response-code) "303"))
-(defmacro with-session (&body body)
- `(a:if-let ((sesh (session-with-id (lzb:request-cookie +session-cookie-name+))))
- ,@body
- (redirect-to "/tavern-door")))
+(defun current-session ()
+ "Get the session associated with the current request. Will throw an
+error if lazybones:*request* is not currently bound. It will return
+NIL if there is no session for the current request.
+
+I.e. It should be called within the scope of a request handler."
+ (session-with-id (lzb:request-cookie +session-cookie-name+ )))
+
+(defmacro with-hero-session ((hero &key session (redirect "/tavern-door")) &body body)
+ (let ((session (or session (gensym "SESSION"))))
+ `(a:if-let (,session (current-session))
+ (let ((,hero (session-hero ,session)))
+ ,@body)
+ (redirect-to ,redirect))))
(defendpoint* :get "/godess-shrine" () ()
(godess-shrine))
@@ -39,4 +49,5 @@
(redirect-to "/tavern-door"))))
(defendpoint* :get "/tavern" () ()
- (with-session (tavern (session-hero sesh))))
+ (with-hero-session (hero)
+ (tavern hero)))