paku/ningle-fbr
1
0
Fork 0
Code Issues Pull requests Projects Releases 1 Packages Activity Actions

Reduce calculations

Browse source
This commit is contained in:
paku 2024-03-11 12:33:53 +09:00
parent e772229b1d
commit 19d3d521f2
1 changed files with 13 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
src/main.lisp
View file

@ -39,34 +39,27 @@
dir dir
"/**/*.lisp"))) "/**/*.lisp")))
(defun dir->urls (dir system) (defun dir->urls-and-packages (dir system)
(let ((dir-namestring (namestring (let ((dir-namestring (namestring
(asdf:system-relative-pathname system dir)))) (asdf:system-relative-pathname system dir)))
(mapcar (lambda (pathname) (system-path-namestring (namestring
(pathname->url pathname dir-namestring))
(dir->pathnames dir))))
(defun dir->packages (dir system)
(let ((system-path-namestring (namestring
(asdf/component:component-relative-pathname (asdf/component:component-relative-pathname
(asdf/find-system:find-system system)))) (asdf/find-system:find-system system))))
(system-prefix (concatenate 'string system "/"))) (system-prefix (concatenate 'string system "/")))
(mapcar (lambda (pathname) (mapcar (lambda (pathname)
(pathname->package pathname system-path-namestring system-prefix)) (cons (pathname->url pathname dir-namestring)
(pathname->package pathname system-path-namestring system-prefix)))
(dir->pathnames dir)))) (dir->pathnames dir))))
(defparameter *http-request-methods* (defparameter *http-request-methods*
'(:GET :HEAD :POST :PUT :DELETE :CONNECT :OPTIONS :PATCH)) '(:GET :HEAD :POST :PUT :DELETE :CONNECT :OPTIONS :PATCH))
(defun enable-file-based-routing (app &key directory system) (defun enable-file-based-routing (app &key directory system)
(let ((urls (dir->urls directory system)) (loop
(packages (dir->packages directory system))) :for (url . pkg) :in (dir->urls-and-packages directory system)
(ql:quickload packages) :do (ql:quickload pkg)
(loop (loop
:for url :in urls :for method :in *http-request-methods*
:for pkg :in packages :do (let ((handler (find-symbol (string (alx:symbolicate 'on- method)) pkg)))
:do (loop (when handler
:for method :in *http-request-methods* (setf (ng:route app url :method method) handler))))))
:do (let ((handler (find-symbol (string (alx:symbolicate 'on- method)) pkg)))
(when handler
(setf (ng:route app url :method method) handler)))))))