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

Reduce arguments

Browse source
This commit is contained in:
paku 2024-02-25 14:06:22 +09:00
parent 523c6ed582
commit bc01c7b5c7
2 changed files with 13 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
README.md
View file

@ -31,9 +31,8 @@ To use ningle-fbr, you must use [package-inferred-system](https://asdf.common-li
(defun update-routes () (defun update-routes ()
(ningle-fbr:enable-file-based-routing (ningle-fbr:enable-file-based-routing
*app* *app*
:dir "src/routes" :directory "src/routes"
:system "example" :system "example"))
:system-pathname "src"))
(update-routes) (update-routes)
``` ```

24
src/main.lisp
View file

@ -21,31 +21,27 @@
(defun format-url (url) (defun format-url (url)
(replace-dynamic-annotation (remove-index url))) (replace-dynamic-annotation (remove-index url)))
(defun pathname->url (pathname dir) (defun pathname->url (pathname dir system)
(format-url (format-url
(re:regex-replace (concatenate 'string (re:regex-replace (namestring (asdf:system-relative-pathname system dir))
(namestring (uiop/os:getcwd))
dir)
(remove-file-type (namestring pathname)) (remove-file-type (namestring pathname))
""))) "")))
(defun pathname->package (pathname system system-pathname) (defun pathname->package (pathname system system-pathname)
(alx:make-keyword (alx:make-keyword
(string-upcase (string-upcase
(re:regex-replace (concatenate 'string (re:regex-replace (namestring system-pathname)
(namestring (uiop/os:getcwd))
system-pathname)
(remove-file-type (namestring pathname)) (remove-file-type (namestring pathname))
system)))) (concatenate 'string system "/")))))
(defun dir->pathnames (dir) (defun dir->pathnames (dir)
(directory (concatenate 'string (directory (concatenate 'string
dir dir
"/**/*.lisp"))) "/**/*.lisp")))
(defun dir->urls (dir) (defun dir->urls (dir system)
(mapcar (lambda (pathname) (mapcar (lambda (pathname)
(pathname->url pathname dir)) (pathname->url pathname dir system))
(dir->pathnames dir))) (dir->pathnames dir)))
(defun dir->packages (dir system system-pathname) (defun dir->packages (dir system system-pathname)
@ -56,9 +52,11 @@
(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 dir system system-pathname) (defun enable-file-based-routing (app &key directory system)
(let ((urls (dir->urls dir)) (let* ((system-pathname (asdf/component:component-relative-pathname
(packages (dir->packages dir system system-pathname))) (asdf/find-system:find-system system)))
(urls (dir->urls directory system))
(packages (dir->packages directory system system-pathname)))
(ql:quickload packages) (ql:quickload packages)
(loop (loop
:for url :in urls :for url :in urls