diff --git a/ningle-fbr-test.asd b/ningle-fbr-test.asd index 32ff098..47b744e 100644 --- a/ningle-fbr-test.asd +++ b/ningle-fbr-test.asd @@ -1,7 +1,6 @@ (defsystem "ningle-fbr-test" - :defsystem-depends-on ("fiveam-asdf") - :class :package-inferred-fiveam-tester-system + :class :package-inferred-system :pathname "tests" - :depends-on () - :test-names () - :num-checks 0) + :depends-on ("rove" + "ningle-fbr-test/router") + :perform (test-op (o c) (symbol-call :rove :run c :style :dot))) diff --git a/ningle-fbr.asd b/ningle-fbr.asd index 083f795..a567398 100644 --- a/ningle-fbr.asd +++ b/ningle-fbr.asd @@ -1,9 +1,10 @@ (defsystem "ningle-fbr" :version "0.1.0" - :description "Plugin for ningle to enable file-based routing" + :description "File-based router for Ningle" :long-description #.(uiop:read-file-string (uiop:subpathname *load-pathname* "README.md")) - :author "skyizwhite " + :author "skyizwhite" + :maintainer "skyizwhite " :license "MIT" :class :package-inferred-system :pathname "src" diff --git a/qlfile b/qlfile index 567dbb8..048c828 100644 --- a/qlfile +++ b/qlfile @@ -1,3 +1,5 @@ -ql fiveam-asdf ql ningle ql cl-ppcre +ql alexandria +github rove fukamachi/rove +github dissect shinmera/dissect diff --git a/qlfile.lock b/qlfile.lock index 57bf0bf..56722c8 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -2,10 +2,6 @@ (:class qlot/source/dist:source-dist :initargs (:distribution "https://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest) :version "2023-10-21")) -("fiveam-asdf" . - (:class qlot/source/ql:source-ql - :initargs (:%version :latest) - :version "ql-2023-10-21")) ("ningle" . (:class qlot/source/ql:source-ql :initargs (:%version :latest) @@ -14,3 +10,15 @@ (:class qlot/source/ql:source-ql :initargs (:%version :latest) :version "ql-2023-10-21")) +("alexandria" . + (:class qlot/source/ql:source-ql + :initargs (:%version :latest) + :version "ql-2024-10-12")) +("rove" . + (:class qlot/source/github:source-github + :initargs (:repos "fukamachi/rove" :ref nil :branch nil :tag nil) + :version "github-cacea7331c10fe9d8398d104b2dfd579bf7ea353")) +("dissect" . + (:class qlot/source/github:source-github + :initargs (:repos "shinmera/dissect" :ref nil :branch nil :tag nil) + :version "github-a70cabcd748cf7c041196efd711e2dcca2bbbb2c")) diff --git a/src/main.lisp b/src/main.lisp index 995b04d..8236432 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -1,68 +1,6 @@ (uiop:define-package :ningle-fbr (:nicknames #:ningle-fbr/main) - (:use #:cl) - (:import-from #:cl-ppcre) - (:import-from #:ningle) - (:export #:assign-routes)) + (:use #:cl + #:ningle-fbr/router) + (:export #:set-routes)) (in-package :ningle-fbr) - -(defun remove-file-type (namestr) - (cl-ppcre:regex-replace ".lisp" namestr "")) - -(defun remove-index (url) - (if (string= url "/index") - "/" - (cl-ppcre:regex-replace "/index" url ""))) - -(defun replace-dynamic-annotation (url) - (cl-ppcre:regex-replace "=" url ":")) - -(defun format-url (url) - (replace-dynamic-annotation (remove-index url))) - -(defun pathname->url (pathname dir-namestring) - (format-url - (cl-ppcre:regex-replace dir-namestring - (remove-file-type (namestring pathname)) - ""))) - -(defun pathname->package (pathname system-path-namestring system-prefix) - (string-upcase - (cl-ppcre:regex-replace system-path-namestring - (remove-file-type (namestring pathname)) - system-prefix))) - -(defun dir->pathnames (dir) - (directory (concatenate 'string - dir - "/**/*.lisp"))) - -(defun dir->urls-and-packages (dir system) - (let ((dir-namestring (namestring - (asdf:system-relative-pathname system dir))) - (system-path-namestring (namestring - (asdf/component:component-relative-pathname - (asdf/find-system:find-system system)))) - (system-prefix (concatenate 'string system "/"))) - (mapcar (lambda (pathname) - (cons (pathname->url pathname dir-namestring) - (pathname->package pathname system-path-namestring system-prefix))) - (dir->pathnames dir-namestring)))) - -(defparameter *http-request-methods* - '(:GET :POST :PUT :DELETE :HEAD :CONNECT :OPTIONS :PATCH)) - -(defun assign-routes (app &key directory system) - (loop - :for (url . pkg) :in (dir->urls-and-packages directory system) - :do (ql:quickload pkg) - (if (string= url "/not-found") - (let ((handler (find-symbol "HANDLE-NOT-FOUND" pkg))) - (defmethod ningle:not-found ((app ningle:app)) - (funcall handler)))) - (loop - :for method :in *http-request-methods* - :do (let ((handler (find-symbol (concatenate 'string "HANDLE-" (string method)) - pkg))) - (when handler - (setf (ningle:route app url :method method) handler)))))) diff --git a/src/router.lisp b/src/router.lisp new file mode 100644 index 0000000..3c75566 --- /dev/null +++ b/src/router.lisp @@ -0,0 +1,67 @@ +(defpackage #:ningle-fbr/router + (:use #:cl) + (:import-from #:alexandria + #:make-keyword) + (:import-from #:cl-ppcre + #:quote-meta-chars + #:regex-replace + #:regex-replace-all) + (:import-from #:ningle) + (:export #:pathname->path + #:path->uri + #:path-package + #:set-routes)) +(in-package #:ningle-fbr/router) + +(defun pathname->path (pathname target-dir-pathname) + (let* ((full (namestring pathname)) + (prefix (quote-meta-chars (namestring target-dir-pathname)))) + (regex-replace (format nil "^~A(.*?).lisp$" prefix) full "/\\1"))) + +(defun detect-paths (system target-dir-path) + (let ((target-dir-pathname + (merge-pathnames (concatenate 'string + target-dir-path + "/") + (asdf:component-pathname (asdf:find-system system))))) + (mapcar (lambda (pathname) + (pathname->path pathname target-dir-pathname)) + (directory (merge-pathnames "**/*.lisp" target-dir-pathname))))) + +(defun remove-index (path) + (if (string= path "/index") + "/" + (regex-replace "/index$" path ""))) + +(defun bracket->colon (path) + (regex-replace-all "\\[(.*?)\\]" path ":\\1")) + +(defun path->uri (path) + (bracket->colon (remove-index path))) + +(defun path->package (path system target-dir-path) + (make-keyword (string-upcase (concatenate 'string + (string system) + "/" + target-dir-path + path)))) + +(defparameter *http-request-methods* + '(:GET :POST :PUT :DELETE :HEAD :CONNECT :OPTIONS :PATCH)) + +(defmethod set-routes ((app ningle:app) &key system target-dir-path) + (loop + :for path :in (detect-paths system target-dir-path) + :for uri := (path->uri path) + :for pkg := (path->package path system target-dir-path) + :do (ql:quickload pkg) + (if (string= uri "/not-found") + (let ((handler (find-symbol "HANDLE-NOT-FOUND" pkg))) + (defmethod ningle:not-found ((app ningle:app)) + (funcall handler)))) + (loop + :for method :in *http-request-methods* + :do (let ((handler (find-symbol (concatenate 'string "HANDLE-" (string method)) + pkg))) + (when handler + (setf (ningle:route app uri :method method) handler)))))) diff --git a/tests/.keep b/tests/.keep deleted file mode 100644 index e69de29..0000000 diff --git a/tests/router.lisp b/tests/router.lisp new file mode 100644 index 0000000..0196212 --- /dev/null +++ b/tests/router.lisp @@ -0,0 +1,34 @@ +(defpackage #:ningle-fbr-test/router + (:use #:cl + #:rove) + (:import-from #:ningle-fbr/router + #:pathname->path + #:path->uri + #:path->package)) +(in-package #:ningle-fbr-test/router) + +(deftest router-test + (testing "pathname->path" + (ok (string= (pathname->path #P"/home/app/src/routes/foo.lisp" + #P"/home/app/src/routes/") + "/foo")))) + +(deftest uri-test + (testing "normal path" + (ok (string= (path->uri "/foo") "/foo")) + (ok (string= (path->uri "/foo/bar") "/foo/bar"))) + + (testing "index path" + (ok (string= (path->uri "/index") "/")) + (ok (string= (path->uri "/nested/index") "/nested"))) + + (testing "dynamic path" + (ok (string= (path->uri "/user/[id]") "/user/:id")) + (ok (string= (path->uri "/location/[country]/[city]") "/location/:country/:city" )))) + +(deftest package-test + (testing "normal case" + (ok (eq (path->package "/foo" :app "routes") + :app/routes/foo)) + (ok (eq (path->package "/foo" :app "somedir/routes") + :app/somedir/routes/foo))))