;;;; 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))))

(defun get-checkboxes-from-body (name &optional (mapper #'object-with-uid))
  (loop :for (key val) :on (lzb:request-body) :by #'cddr
        :when (string-equal key name)
          :collect (funcall mapper val)))

;;; 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)