diff options
Diffstat (limited to 'src/app.lisp')
-rw-r--r-- | src/app.lisp | 81 |
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) + + + |