html->string (Super simple HTML templating for Lisp)

html.lisp

(defvar *html-void-tags* '(:area :base :br :col :embed :hr :img :input :link
                              :meta :param :source :track :wbr)
  "String designators for self-closing/void tags.
https://html.spec.whatwg.org/multipage/syntax.html#void-elements")

(defvar *html-escapes*
  '(#\& "&"
    #\< "&lt;"
    #\> "&gt;"
    #\" "&quot;"))

(defun escape (str)
  (declare (string str))
  (with-output-to-string (stream)
    (loop for ch across str
       for escaped = (getf *html-escapes* ch)
       do (if escaped
              (write-string escaped stream)
              (write-char ch stream)))))

(defun html->string (html)
  "The argument should be of the form (tag-name (attr-name attr-val) child1
child2 ...). Attributes and children are optional.

(html->string
   '(html ()
        (head ()
            (title () \"My awesome website!\"))
        (body ()
            \"Hello! I'm Mark.\"
            ;; No attributes or children:
            (br)
            (a (href \"https://github.com/markasoftware\") \"My stuff\")
            (br)
            ;; No children:
            (img (src \"/cats.jpg\" alt \"My cute cats!\")))))

Since the argument must be quoted, you can use backquote notation to interleave
html and lisp:

    `(div ()
         \"My name is \" 
         ,*my-name*
         \", But you can call me:\"
         (br)
         (ul ()
             ,@(mapcar (lambda (name) `(li () ,name)) *my-nicknames*)))

All text and attribute values are escaped properly. You can use keyword symbols
for tag and attribute names if you'd like. There's a hardcoded list of
self-closing tags, such as br and img."
  (etypecase html
    (null "")
    (string (escape html))
    (number (write-to-string html))
    (cons
     ;; the &key business forces an odd number of arguments.
     (destructuring-bind
           (tag &optional ((&rest attrs &key &allow-other-keys)) &rest body)
         html
       (declare (symbol tag))
       ;; printf is a child's toy. Honestly, regex might be too!
       (format nil "<~A~:{ ~A=\"~A\"~}~:[/>~;>~A</~A>~]"
        (string-downcase tag)
        (loop for attr-name in attrs by #'cddr
           for attr-val in (cdr attrs) by #'cddr
           collect
             (list (string-downcase attr-name)
                   (escape (etypecase attr-val
                             ((or string symbol) (string attr-val))
                             (number (write-to-string attr-val))))))
        (not (member tag *html-void-tags* :test #'string=))
        (apply #'concatenate 'string (mapcar #'html->string body))
        (string-downcase tag))))))