Implement

qlfile

@@ -1 +1,3 @@
 ql ningle
+ql cl-ppcre
+ql alexandria

qlfile.lock

@@ -6,3 +6,11 @@
  (:class qlot/source/ql:source-ql
   :initargs (:%version :latest)
   :version "ql-2023-10-21"))
+("cl-ppcre" .
+ (: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-2023-10-21"))

src/main.lisp

@@ -1,9 +1,70 @@
 (uiop:define-package :ningle-fbr
   (:nicknames #:ningle-fbr/main)
-  (:use #:cl
+  (:use #:cl)
-        #:ningle)
+  (:local-nicknames (#:alx #:alexandria))
+  (:local-nicknames (#:re #:cl-ppcre))
+  (:local-nicknames (#:ng #:ningle))
   (:export #:enable-file-based-routing))
 (in-package :ningle-fbr)
 
-(defun enable-file-based-routing (app directory)
+(defun remove-file-type (namestr)
-  (declare (ignore app directory)))
+  (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 (ng:route app url :method method) handler)))))))