1 files changed, 81 insertions, 0 deletions
diff --git a/src/app.lisp b/src/app.lisp
new file mode 100644
index 0000000..14765c7
--- /dev/null
+++ b/src/app.lisp
@@ -0,0 +1,81 @@
+;;;; app.lisp -- lazybones application definition and helpers
+
+(in-package :dnd)
+
+(lzb:provision-app ()
+ :title "Dungeons & Deadlines"
+ :version "0.1.0"
+ :content-type "text/html")
+
+(defparameter +session-cookie-name+ "dnd-session")
+
+;;; UTILITIES
+
+(defun redirect-to (location)
+  "Set the lazybones response header and response code for redirecting to LOCATION.
+This procedure will error if lazybones:*request* is not currently bound."
+  (setf (lzb:response-header :location) location
+	(lzb:response-code) "303"))
+
+(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+ )))
+
+(defun text-browser-p (user-agent)
+  "Returns T if user agent string matches on a list of known text browsers."
+  (some (lambda (s) (search s user-agent)) '("Emacs" "Lynx" "w3m")))
+
+(defun page-render-mode (&optional user-agent)
+  "Given the USER-AGENT string from request headers, returns a symbol which
+indicates which render mode to use. For example if Emacs is the user-agent,
+return :text-12mode."
+  (let ((user-agent
+          (or user-agent
+              (lzb:request-header :user-agent))))
+    (cond ((text-browser-p user-agent) :text-page)
+          (t :page))))
+
+
+(defmacro with-checked-plist (typed-keys plist &rest body)
+  "Like WITH-PLIST, but allows you to pass a checking function to
+automatically tansform plist values into something you actually
+want. This is modelled after the way LAZYBONES allows for similar
+functions in url parameters in endpoint definitions."
+  (let* ((plist-var
+           (gensym))
+         (bindings
+           (loop :for (var key . pred) :in typed-keys
+                 :when pred
+                   :collect `(,var (funcall ,(first pred) (getf ,plist-var ',key)))
+                 :else
+                   :collect `(,var (getf ,plist-var ',key)))))
+    `(let ((,plist-var ,plist))
+       (let ,bindings ,@body))))
+
+;;; VALIDATOR TRANSFORMS
+
+(defmacro define-id-plucker (class)
+  (let ((function-name
+          (intern (format nil "~a-~a-WITH-ID"
+                          (if (starts-with-vowel-p (symbol-name class))
+                              "AN" "A")
+                          class)
+                  :dnd)))
+    `(defun ,function-name (id)
+       (let ((object (object-with-uid (string-upcase id))))
+         (unless (typep object ',class)
+           (lzb:http-err 404 (format nil "No ~a with id = ~a" ',class id)))
+         object))))
+
+
+(defun a-short-string (str)
+  (unless (and (stringp str) (< (length str) 50))
+    (lzb:http-err 400 "The value must be a string at most 50 characters long."))
+  str)
+
+
+