88 lines
3.7 KiB
Common Lisp
88 lines
3.7 KiB
Common Lisp
;;;; templates.lisp
|
|
|
|
(defpackage :lspx.template
|
|
(:use :cl)
|
|
(:local-nicknames (:a :alexandria))
|
|
(:export *custom-tags* deftemplate maybe-render-template maybe-defragment-html))
|
|
|
|
(in-package :lspx.template)
|
|
|
|
(declaim (inline deftemplate))
|
|
|
|
(a:define-constant +attr-scanner+
|
|
'(:register
|
|
(:sequence (:register (:non-greedy-repetition 1 nil :word-char-class)) "=\""
|
|
(:register (:non-greedy-repetition 0 nil :everything)) #\"))
|
|
:test 'equal)
|
|
|
|
(defparameter *custom-tags*
|
|
(make-hash-table :test 'equal))
|
|
|
|
(defun parse-attributes (tag)
|
|
(loop :for (key attr) :on (str:split "=" tag) :by #'cddr
|
|
:collect (list (intern (string-upcase key) :keyword)
|
|
(str:trim attr :char-bag "\""))
|
|
:into attrs
|
|
|
|
:finally
|
|
(log:trace "parsed the following attributes: ~A" (a:flatten attrs))
|
|
(return (a:flatten attrs))))
|
|
|
|
(defun maybe-defragment-html (html)
|
|
(if (or (str:starts-with-p "<html" html)
|
|
(str:starts-with-p "<!DOCTYPE" html :ignore-case t))
|
|
html
|
|
(str:concat "<!DOCTYPE html><html>"
|
|
(unless (str:starts-with-p "<body" html)
|
|
"<body>")
|
|
html
|
|
(unless (str:starts-with-p "<body" html)
|
|
"</body>")
|
|
"</html>")))
|
|
|
|
(defmacro deftemplate (tag lambda-list &body body)
|
|
"defines a new template denoted with TAG."
|
|
(let ((inner (gensym "INNER"))
|
|
(arg (gensym "ARG"))
|
|
(has-rest (member '&rest lambda-list))
|
|
(has-keys (search '(&key) lambda-list)))
|
|
`(progn
|
|
(log:info "defining new template for tag ~A" ,tag)
|
|
(setf (gethash ,tag *custom-tags*)
|
|
(lambda ,(if lambda-list
|
|
(if has-rest lambda-list
|
|
(if has-keys `(,@(subseq lambda-list 0 has-keys)
|
|
&rest ,arg
|
|
,@(subseq lambda-list has-keys))
|
|
(append lambda-list (list '&rest arg))))
|
|
`(,inner &rest ,arg))
|
|
,@(typecase (car body)
|
|
(string `((declare (ignore ,arg))
|
|
(format nil ,(car body) ,inner)))
|
|
(list (if has-rest body
|
|
(append `((declare (ignore ,arg))) body)))))))))
|
|
|
|
(defun maybe-render-template (template raw-input &rest data)
|
|
"checks for TEMPLATE in *custom-tags*
|
|
|
|
if found it applies RAW-INPUT and DATA to the function, parsing out any attributes in the custom tag
|
|
if TEMPLATE does not specify a custom tag we just apply format to RAW-INPUT with DATA being the rest"
|
|
(if (gethash template *custom-tags*)
|
|
(let ((attributes (car (ppcre:all-matches-as-strings
|
|
+attr-scanner+
|
|
(car (ppcre:all-matches-as-strings
|
|
`(:sequence #\< ,template
|
|
(:non-greedy-repetition 0 nil :everything) #\>)
|
|
raw-input)))))
|
|
(cleaned (ppcre:regex-replace-all
|
|
`(:sequence #\< (:greedy-repetition 0 1 #\/) ,template
|
|
(:non-greedy-repetition 0 nil :everything) #\>)
|
|
raw-input "")))
|
|
(log:trace "found template for tag: ~A. processing attributes: ~A" template attributes)
|
|
(apply (gethash template *custom-tags*)
|
|
`(,(apply #'format `(nil ,cleaned ,@data))
|
|
,@(when attributes
|
|
(parse-attributes (str:trim attributes)))
|
|
:allow-other-keys t)))
|
|
(apply #'format `(nil ,raw-input ,@data))))
|