64 lines
2.3 KiB
Common Lisp
64 lines
2.3 KiB
Common Lisp
;;;; util.lisp
|
|
|
|
(in-package :lspx)
|
|
|
|
(declaim (inline static-asset-p generate-filepath set-logging-level))
|
|
|
|
(a:define-constant +valid-log-levels+
|
|
'(:info :debug :error :trace)
|
|
:test 'equal)
|
|
|
|
(defmacro handle-user-abort (body &rest signal-forms)
|
|
`(handler-case
|
|
(with-user-abort ,body)
|
|
(user-abort ())
|
|
,@signal-forms))
|
|
|
|
(defun static-asset-p (path)
|
|
"wrapper around PATHNAME-TYPE to make code more parsable"
|
|
(pathname-type path))
|
|
|
|
(defun generate-filepath (root path extension)
|
|
"generates a logical filepath given ROOT, PATH, and EXTENSION"
|
|
(str:concat "web:" root ";"
|
|
|
|
(str:join ";" (cdr (pathname-directory path)))
|
|
|
|
(when (cdr (pathname-directory path)) ";")
|
|
|
|
(or (pathname-name path) "index")
|
|
|
|
extension))
|
|
|
|
(defun getf-dir (place indicator &optional default-dir)
|
|
"getf that makes a lot of assumptions, namely that it will be only operating on namestrings"
|
|
(let ((value (str:ensure-suffix "/" (getf place indicator
|
|
(namestring default-dir)))))
|
|
(namestring
|
|
(if (uiop:relative-pathname-p value)
|
|
(loop :with normalized-path
|
|
:for d :in (cdr (pathname-directory
|
|
(str:ensure-prefix (namestring (uiop:getcwd)) value)))
|
|
|
|
:if (equal d :up)
|
|
:do (pop normalized-path)
|
|
:else
|
|
:do (push d normalized-path)
|
|
|
|
:finally
|
|
(return (apply #'make-pathname
|
|
`(:directory (:absolute ,@(reverse normalized-path))))))
|
|
value))))
|
|
|
|
(defun generate-page-function-name (&key path intern)
|
|
(let* ((relative-path (enough-namestring (or (and path (translate-logical-pathname path))
|
|
*compile-file-truename*)
|
|
(translate-logical-pathname "web:pages;")))
|
|
(func-name (format nil "~:@(render-~A~)"
|
|
(subseq (str:replace-all "/" "-" relative-path)
|
|
0 (- (length relative-path)
|
|
(1+ (length (pathname-type relative-path))))))))
|
|
(if intern
|
|
(intern func-name :lspx.user)
|
|
func-name)))
|