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

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