Have Emacs - Will Hack

Compile-time intra-application URI link checking

Topic: Lisp

Here is a neat hack I came up with to do compile-time intra-application link checking for a web application that I wrote. The mechanism is based on eval-when facility of Common Lisp, and also uses the *compile-file-pathname* and *load-pathname* variables to provide the names of the files where the offending links reside.

The ASDF definition of the application looks like:

(asdf:defsystem :cct
  :serial t
  :components ((:file "resource-definition")

               ;; other files

               ;; link checker (goes last)
               (:file "uri-reference-checker"))

Where resource-definition.lisp defines the page-definition and link-reference macros:

(in-package :cct)

(eval-when (:compile-toplevel :load-toplevel)
  (defparameter *defined-uri-list* ())
  (defparameter *referenced-uri-list* ()))

(defmacro/ps resolve-resource (resource-identifier)
  (pushnew (cons resource-identifier
                 (or *compile-file-pathname* *load-pathname*))
           *referenced-uri-list*
           :test #'equal)
  (symbol-to-uri resource-identifier))

(set-dispatch-macro-character #\# #\/
  (lambda (stream subchar arg)
    (declare (ignore subchar arg))
    (let* ((base-uri
             (with-output-to-string (collector)
               (loop until (member
                            (peek-char nil stream nil #\Space t)
                            '(#\Space #\Newline #\Tab #\? #\) #\{))
                     do (princ (read-char stream) collector))))
           (page (read-from-string base-uri)))
      `(concat-url (resolve-resource ,page)
                   ,@(uri-template:read-uri-template stream)))))

(defmacro concat-url (&rest fragments)
  `(format nil "~@{~A~}" ,@fragments))

(defpsmacro concat-url (&rest fragments)
  `(+ ,@fragments))

(defmacro define-page (page-name
                       (&key parameters (default-request-type :both))
                       &body body)
  (flet ((process-parameter (p)
           (if (atom p)
               p
             (list (first p)
                   :parameter-type (list 'quote (second p))))))
    `(progn
       (eval-when (:compile-toplevel :load-toplevel :execute)
         (pushnew '(,page-name) *defined-uri-list* :test #'equal))
       (define-easy-handler (,page-name
                             :uri ,(symbol-to-uri page-name)
                             :default-request-type ,default-request-type)
           ,(mapcar #'process-parameter parameters)
         (if (and ,@(mapcar (lambda (x)
                              (if (atom x)
                                  x
                                (car x)))
                            parameters))
             (progn ,@body)
           (redirect "/cct"))))))

The link-reference mechanism is implemented as a macro character which builds on the uri-template facility. You certainly do not need to do it this way, but I find URI templates to be quite convenient. The only thing I dislike is the special-casing of the termination symbols (whitespace, closing paren). If you know of a better way, please let me know.

Note the defpsmacro - this is a Parenscript macro definition, which lets the same link-checking mechanism (and uri-template, which is Parenscript-compatible) work with Parenscript code, which is transformed into JavaScript and can then construct (compile-time checked) URIs dynamically in the browser.

uri-reference-checker.lisp runs after all the page definitions have been made and consists of:

(in-package :cct)

(eval-when (:compile-toplevel :load-toplevel)
  (dolist (unreferenced-uri
           (set-difference *referenced-uri-list*
                           *defined-uri-list*
                           :key #'car))
    (warn
     "Reference warning: referencing unknown URI resource ~a in file ~a"
    (car unreferenced-uri) (cdr unreferenced-uri))))

You could also provide warnings for defined URIs that have no references.

The actual application code then looks something like:

(loop for date in dates do
      (htm (:li (:a :href #/bank-rec-report?date={date} (str date)))))

This is a pattern that I think can be applied to most web applications.