prettified backtraces a little
added HTML-ENTITIES as a hard dependency
This commit is contained in:
parent
221bcaba68
commit
9863048a4e
37
errors.lisp
37
errors.lisp
|
@ -2,7 +2,12 @@
|
|||
|
||||
(defpackage :lspx.errors
|
||||
(:use :cl)
|
||||
(:local-nicknames (:a :alexandria))
|
||||
(:import-from :html-entities :encode-entities)
|
||||
(:import-from :trivial-backtrace :print-backtrace)
|
||||
(:import-from :lspx.template
|
||||
:deftemplate :maybe-render-template
|
||||
:maybe-defragment-html)
|
||||
(:export
|
||||
:generate-error-handlers
|
||||
:with-printable-backtrace
|
||||
|
@ -21,15 +26,39 @@
|
|||
if an element is a list, we assume CDR is an HTML string to return for the error
|
||||
otherwise, we just return an empty response"))
|
||||
|
||||
;; TODO: make this so that it wraps up the errors into a nicer HTML format.
|
||||
(a:define-constant +backtrace-html-style+
|
||||
"
|
||||
html {
|
||||
white-space: pre-line;
|
||||
background: #505A5B;
|
||||
color: #DCEDFF;
|
||||
font-family: Chalkboard, Calibri, Sans Serif;
|
||||
}
|
||||
|
||||
a {
|
||||
color: #94B0DA;
|
||||
}
|
||||
|
||||
p {
|
||||
padding: 2%;
|
||||
}"
|
||||
:test #'string=)
|
||||
|
||||
(deftemplate "Internal--BackTrace" (inner)
|
||||
(format nil "<!DOCTYPE html><head><style>~A</style></head><html><body><p>~A</p></body></html>"
|
||||
+backtrace-html-style+ inner))
|
||||
|
||||
(defmacro with-printable-backtrace (&body body)
|
||||
"quick macro to wrap up printing backtraces in case of a request error"
|
||||
`(handler-case ,@body
|
||||
(error (e)
|
||||
(if *html-backtrace*
|
||||
(list 500 nil (list (str:replace-all (string #\newline)
|
||||
"<br/>"
|
||||
(print-backtrace e :output nil))))
|
||||
(list 500 nil
|
||||
(list (maybe-render-template "Internal--BackTrace"
|
||||
"<Internal--BackTrace>~A</Internal--BackTrace>"
|
||||
(str:replace-all
|
||||
(string #\newline) "<br/>"
|
||||
(encode-entities (print-backtrace e :output nil))))))
|
||||
(prog1 (500-handler)
|
||||
(log:error "~%~A" (print-backtrace e :output nil)))))))
|
||||
|
||||
|
|
2
lspx.asd
2
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 #:cl-ppcre
|
||||
#:alexandria #:log4cl #:cl-ppcre #:html-entities
|
||||
|
||||
(:feature :woo #:woo)
|
||||
(:feature :woo #:clack-handler-woo)
|
||||
|
|
|
@ -55,7 +55,7 @@
|
|||
(string `((declare (ignore ,arg))
|
||||
(format nil ,(car body) ,inner)))
|
||||
(list (if has-rest body
|
||||
(append `(declare (ignore ,arg)) body))))))))
|
||||
(append `((declare (ignore ,arg))) body))))))))
|
||||
|
||||
(defun maybe-render-template (template raw-input &rest data)
|
||||
"checks for TEMPLATE in *custom-tags*
|
||||
|
|
Loading…
Reference in New Issue