Maintaining state in a Lisp web app

Introduction
Example code
Testing it out

Introduction

Consider the following situation: A user visits your web app and enters some information. They then click a few links, visit a few other pages, and finally land on a page that needs the information they entered at the beginning. How can we store this information and retrieve it later when it's needed? This note shows one such possibility.

Example code

Here is the source code of state.lisp:

(require "hunchentoot")
(require "cl-who")
(use-package :cl-who)
(use-package :hunchentoot)

(defclass search-server (acceptor)
  ((dispatch-table
    :initform '()
    :accessor dispatch-table
    :documentation "List of dispatch functions")
   (ss-counter
    :initform 0
    :accessor ss-counter
    :documentation "Counter for anonymous dispatch")))

(defvar *mysrv* (make-instance 'search-server :port 80))

(defmethod gendisp ((srv search-server)) ;;called by anon-once
  (concatenate 'string
               "/AD-"
               (write-to-string (incf (ss-counter srv)))))

(defun find-not-nil (l p) ;;called by acceptor-dispatch-request
  (if (endp l)
      nil
    (or (funcall p (car l))
        (find-not-nil (cdr l) p))))

(defmethod acceptor-dispatch-request ((srv search-server) (req request))
  (let ((l (find-not-nil (dispatch-table srv)
                         (lambda (disp) (funcall disp req)))))
    (or l (call-next-method))))

(defmacro anon-static (&body body) ;;called by search-form
  `(anon-once (,(gensym)) ,@body))

(defmacro anon-once ((var) &body body) ;;called by search-form and anon-static
  `(let ((auri (gendisp *acceptor*)))
     (push-dispatcher srv
                      (my-prefix-disp auri (lambda (,var) ,@body)))
     auri))

(defmacro with-html ((var) &body body) ;;caled by dummy-dispatch
  `(with-html-output-to-string (,var)
                               ,@body))

(defmacro just-html (&body body) ;;called by search-form
  `(with-html-output-to-string (,(gensym))
                               ,@body))

(defun file-get-contents (filename)
  (with-open-file (stream filename)
                  (let ((contents (make-string (file-length stream))))
                    (read-sequence contents stream)
                          contents)))

(defun my-prefix-disp (prefix handler) ;;called by anon-once
  ;; Input #1: Prefix (i.e. part of a url like "/bob")
  ;; Input #2: handler (name of a function that takes a request object and returns html)
  ;; This returns a function that checks the request and then calls the handler if the request
  ;; matches the prefix (it only has to match the prefix - /bob will match /bobbie)
  (lambda (req)
    (let ((m (mismatch prefix (script-name* req))))
      (if (or (null m) (>= m (length prefix)))
          (funcall handler req)))))


(defun push-dispatcher (srv disp) ;;called by anon-once
  (push disp (dispatch-table srv)))

(load "info.lisp")

(push-dispatcher *mysrv*
                 (my-prefix-disp "/info" (quote dummy-dispatch)))


(start *mysrv*)

You'll see it references another file, info.lisp

(defun search-form (srv) ;;called by dummy-dispatch
  (just-html
   (:p
    (:form :name "form" :method :post
           :action (anon-once (req)
                              (just-html
                               (:html
                                (:body "Great. Follow this link for more info! &nbsp;"
                                       (:a :href (anon-static
                                                  (just-html
                                                   (:html
                                                    (:body "Welcome "
                                                           (str (parameter "name" req)))))) "Click" )))))
           "Name:&nbsp;"
           (:input :type :text :id "name" :name "name")
           (:input :type "submit")))))


(let ((counter 0))
  (defun dummy-dispatch (req)
    (with-html (s)
               (:html
                (:body
                 "Request Number:&nbsp;"
                 (str (incf counter))
                 (:br)
                 (str (search-form *acceptor*)))))))