Refactor (#4)

* Update system info

* Update qlfile

* Organize code

* Add test

* Implement uri-mapper and package-mapper

* Change type of package from string to keyword

* Implement router

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)))

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 <paku@skyizwhite.dev>"
+  :author "skyizwhite"
+  :maintainer "skyizwhite <paku@skyizwhite.dev>"
   :license "MIT"
   :class :package-inferred-system
   :pathname "src"

qlfile

@@ -1,3 +1,5 @@
-ql fiveam-asdf
 ql ningle
 ql cl-ppcre
+ql alexandria
+github rove fukamachi/rove
+github dissect shinmera/dissect

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"))

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))))))

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))))))

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))))