prettified backtraces a little

added HTML-ENTITIES as a hard dependency
This commit is contained in:
a. fox 2024-01-23 21:11:35 -05:00
parent 221bcaba68
commit 9863048a4e
3 changed files with 35 additions and 6 deletions

View File

@ -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)))))))

View File

@ -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)

View File

@ -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*