templates have been implemented using DEFTEMPLATE
added CL-PPCRE as hard dependency reader macro rewritten to be less redundent and more clear added TRACE as log level
This commit is contained in:
parent
f23d6bd145
commit
d4ffec179b
3
lspx.asd
3
lspx.asd
|
|
@ -8,7 +8,7 @@
|
|||
:serial t
|
||||
:depends-on (#:clack #:unix-opts #:str #:with-user-abort
|
||||
#:trivial-mimes #:local-time #:trivial-backtrace
|
||||
#:alexandria #:log4cl
|
||||
#:alexandria #:log4cl #:cl-ppcre
|
||||
|
||||
(:feature :woo #:woo)
|
||||
(:feature :woo #:clack-handler-woo)
|
||||
|
|
@ -16,6 +16,7 @@
|
|||
(:feature (:not :woo) #:hunchentoot)
|
||||
(:feature (:not :woo) #:clack-handler-hunchentoot))
|
||||
:components ((:file "errors")
|
||||
(:file "templates")
|
||||
|
||||
(:file "package")
|
||||
(:file "util")
|
||||
|
|
|
|||
12
package.lisp
12
package.lisp
|
|
@ -2,17 +2,17 @@
|
|||
|
||||
(defpackage #:lspx
|
||||
(:use #:cl #:with-user-abort
|
||||
#:lspx.errors)
|
||||
#:lspx.errors
|
||||
#:lspx.template)
|
||||
(:local-nicknames (:a :alexandria))
|
||||
(:import-from :unix-opts
|
||||
:define-opts
|
||||
:get-opts)
|
||||
|
||||
(:export
|
||||
:deftemplate))
|
||||
:get-opts))
|
||||
|
||||
(defpackage #:lspx.user
|
||||
(:use #:cl #:lspx)
|
||||
(:use #:cl)
|
||||
(:import-from :lspx.errors
|
||||
:*http-errors*
|
||||
:generate-error-handlers)
|
||||
(:import-from :lspx.template
|
||||
:deftemplate))
|
||||
|
|
|
|||
122
reader.lisp
122
reader.lisp
|
|
@ -2,18 +2,50 @@
|
|||
|
||||
(in-package :lspx)
|
||||
|
||||
;; TODO: move this into a proper template package
|
||||
(defun render-base (value &key include-body)
|
||||
(apply #'str:concat
|
||||
(list "<!DOCTYPE html><html>"
|
||||
(when include-body "<body>")
|
||||
value
|
||||
(when include-body "</body>")
|
||||
"</html>")))
|
||||
(a:define-constant +sexp-regex+
|
||||
'(:sequence
|
||||
(:flags :single-line-mode-p)
|
||||
"{{"
|
||||
(:non-greedy-repetition 0 nil :everything)
|
||||
"}}")
|
||||
:test 'equal)
|
||||
|
||||
(defun read-lisp-sexp (stream)
|
||||
(prog1 (read-delimited-list #\} stream)
|
||||
(read-char stream)))
|
||||
(defun parse-lisp-sexp (str)
|
||||
"parses out all lisp expressions from STR
|
||||
|
||||
returns a plist with the cleaned HTML and the s-expressions"
|
||||
(let ((expressions (mapcar #'(lambda (s)
|
||||
(str:trim s :char-bag "{}"))
|
||||
(ppcre:all-matches-as-strings +sexp-regex+ str)))
|
||||
(cleaned (ppcre:regex-replace-all +sexp-regex+ str "~A")))
|
||||
(list :html cleaned :sexps (mapcar #'read-from-string expressions))))
|
||||
|
||||
(defun read-stream-until (stream end)
|
||||
"reads STREAM until buffer ends with END"
|
||||
(let ((end-val (typecase end
|
||||
(base-char (string end))
|
||||
(t end))))
|
||||
(loop :with buffer := (make-string 100 :initial-element #\Space)
|
||||
:with i := 0
|
||||
:with char
|
||||
|
||||
;; read the next character from the stream
|
||||
:do
|
||||
(setf char (read-char stream)
|
||||
(aref buffer i) char
|
||||
i (1+ i))
|
||||
|
||||
:when (>= i (length buffer))
|
||||
:do (let ((tmp (make-string (* 2 (length buffer)) :initial-element #\Space)))
|
||||
(setf (subseq tmp 0 i) buffer
|
||||
buffer tmp))
|
||||
|
||||
:until (str:ends-with-p end (str:trim buffer))
|
||||
|
||||
:finally
|
||||
(return (subseq (str:trim buffer)
|
||||
0 (- (length (str:trim buffer))
|
||||
(length end-val)))))))
|
||||
|
||||
;; TODO: this function should read until it finds the matching tag
|
||||
;; only THEN should it stop.
|
||||
|
|
@ -24,50 +56,28 @@
|
|||
|
||||
(let ((next-char (peek-char nil stream)))
|
||||
(if (alpha-char-p next-char)
|
||||
(loop :with buffer := (make-string 200 :initial-element #\Space)
|
||||
:with tag
|
||||
:with expressions := nil
|
||||
:with i := 0
|
||||
|
||||
:while (peek-char nil stream nil)
|
||||
|
||||
;; gets our tag, but it only gets the first one
|
||||
:when (and (not tag) (char= (peek-char nil stream nil) #\Space))
|
||||
:do (setf tag (str:trim buffer)
|
||||
i 0
|
||||
buffer (make-string 200 :initial-element #\Space))
|
||||
|
||||
;; ensures we increase our buffer length if needed
|
||||
:when (>= i (length buffer))
|
||||
:do (let ((tmp (make-string (* 2 (length buffer))
|
||||
:initial-element #\Space)))
|
||||
(setf (subseq tmp 0 i) buffer
|
||||
buffer tmp))
|
||||
|
||||
;; when we see a potential inline lisp expression we should handle it
|
||||
:when (char= (peek-char nil stream nil) #\{)
|
||||
:do (read-char stream)
|
||||
(if (and (char= (peek-char nil stream nil) #\{)
|
||||
(read-char stream))
|
||||
(progn
|
||||
(setf expressions (append expressions (read-lisp-sexp stream))
|
||||
(subseq buffer i (+ i 2)) "~A"
|
||||
i (+ i 2)))
|
||||
(unread-char #\{ stream))
|
||||
|
||||
;; keep reading our stream
|
||||
:do
|
||||
(setf (aref buffer i) (read-char stream)
|
||||
i (1+ i))
|
||||
|
||||
:finally
|
||||
(return
|
||||
(let ((inner-html (str:concat "<" tag " " (str:trim buffer))))
|
||||
`(defun ,(generate-page-function-name :intern t) ()
|
||||
(funcall #'format nil
|
||||
,(if (string= tag "html")
|
||||
inner-html
|
||||
(render-base inner-html :include-body (not (string= tag "body"))))
|
||||
,@expressions)))))
|
||||
(let* ((tag-and-attrs
|
||||
(progn
|
||||
(log:trace "reading HTML tag")
|
||||
(read-stream-until stream #\>)))
|
||||
(true-tag
|
||||
(progn
|
||||
(log:trace "teasing tag from potential attributes...")
|
||||
(car (str:split " " tag-and-attrs))))
|
||||
(closing-tag (str:concat "</" true-tag ">"))
|
||||
(html-string
|
||||
(progn
|
||||
(log:trace "reading rest of HTML element for tag ~A..." true-tag)
|
||||
(read-stream-until stream closing-tag)))
|
||||
(parsed
|
||||
(progn
|
||||
(log:trace "parsing full HTML string for sexps...")
|
||||
(parse-lisp-sexp (str:concat "<" tag-and-attrs "> " html-string)))))
|
||||
(let ((inner-html (str:concat (getf parsed :html) closing-tag)))
|
||||
`(defun ,(generate-page-function-name :intern t) ()
|
||||
(maybe-defragment-html
|
||||
(maybe-render-template ,true-tag
|
||||
,(str:concat (getf parsed :html) closing-tag)
|
||||
,@(getf parsed :sexps))))))
|
||||
(if (char= next-char #\Space)
|
||||
'< (intern (format nil "<~S" (read stream)))))))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,76 @@
|
|||
;;;; 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>")))
|
||||
|
||||
(defun deftemplate (tag format)
|
||||
"defines a new template denoted with TAG.
|
||||
FORMAT is either a format-compatible string or a function that accepts one parameter (the inner-html)
|
||||
|
||||
if additional configuration is desired, html attributes of the form attr=\"value\" are converted into :ATTR \"value\" and applied to the function at render time"
|
||||
(setf (gethash tag *custom-tags*)
|
||||
(typecase format
|
||||
(string (lambda (in &rest _)
|
||||
(declare (ignore _))
|
||||
(format nil format in)))
|
||||
(compiled-function format))))
|
||||
|
||||
(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))))))
|
||||
(apply #'format `(nil ,raw-input ,@data))))
|
||||
Loading…
Reference in New Issue