Use ningle-fbr

This commit is contained in:
Akira Tempaku 2024-02-14 01:18:20 +09:00
commit 622252d0b5
4 changed files with 10 additions and 79 deletions

View file

@ -1,8 +1,8 @@
(uiop:define-package #:hp/app
(:use #:cl)
(:local-nicknames (#:jg #:jingle))
(:local-nicknames (#:fbr #:ningle-fbr))
(:import-from #:lack)
(:local-nicknames (#:utils #:hp/utils/*))
(:export #:*app*
#:update-routes))
(in-package #:hp/app)
@ -10,10 +10,10 @@
(defparameter *raw-app* (jg:make-app))
(defun update-routes ()
(utils:enable-file-based-routing *raw-app*
:dir "src/routes"
:system "hp"
:system-pathname "src"))
(fbr:enable-file-based-routing *raw-app*
:dir "src/routes"
:system "hp"
:system-pathname "src"))
(update-routes)

View file

@ -1,69 +0,0 @@
(uiop:define-package #:hp/utils/routes
(:use #:cl)
(:local-nicknames (#:alx #:alexandria))
(:local-nicknames (#:re #:cl-ppcre))
(:local-nicknames (#:jg #:jingle))
(:export #:enable-file-based-routing))
(in-package #:hp/utils/routes)
(defun remove-file-type (namestr)
(re:regex-replace ".lisp" namestr ""))
(defun remove-index (url)
(if (string= url "/index")
"/"
(re:regex-replace "/index" url "")))
(defun replace-dynamic-annotation (url)
(re:regex-replace "=" url ":"))
(defun format-url (url)
(replace-dynamic-annotation (remove-index url)))
(defun pathname->url (pathname dir)
(format-url
(re:regex-replace (concatenate 'string
(namestring (uiop/os:getcwd))
dir)
(remove-file-type (namestring pathname))
"")))
(defun pathname->package (pathname system system-pathname)
(alx:make-keyword
(string-upcase
(re:regex-replace (concatenate 'string
(namestring (uiop/os:getcwd))
system-pathname)
(remove-file-type (namestring pathname))
system))))
(defun dir->pathnames (dir)
(directory (concatenate 'string
dir
"/**/*.lisp")))
(defun dir->urls (dir)
(mapcar (lambda (pathname)
(pathname->url pathname dir))
(dir->pathnames dir)))
(defun dir->packages (dir system system-pathname)
(mapcar (lambda (pathname)
(pathname->package pathname system system-pathname))
(dir->pathnames dir)))
(defparameter *http-request-methods*
'(:GET :HEAD :POST :PUT :DELETE :CONNECT :OPTIONS :PATCH))
(defun enable-file-based-routing (app &key dir system system-pathname)
(let ((urls (dir->urls dir))
(packages (dir->packages dir system system-pathname)))
(ql:quickload packages)
(loop
:for url :in urls
:for pkg :in packages
:do (loop
:for method :in *http-request-methods*
:do (let ((handler (find-symbol (string (alx:symbolicate 'on- method)) pkg)))
(when handler
(setf (jg:route app url :method method) handler)))))))