Add file-based-routing

qlfile

@@ -6,3 +6,4 @@ ql lack
 ql clack
 ql cl-jingle
 git piccolo https://github.com/skyizwhite/piccolo.git
+ql cl-ppcre

qlfile.lock

@@ -34,3 +34,7 @@
  (:class qlot/source/git:source-git
   :initargs (:remote-url "https://github.com/skyizwhite/piccolo.git")
   :version "git-8f4a7c4907f2115f98ceb6dd111ac77f75d1be04"))
+("cl-ppcre" .
+ (:class qlot/source/ql:source-ql
+  :initargs (:%version :latest)
+  :version "ql-2023-10-21"))

src/app.lisp

@@ -1,15 +1,21 @@
-(defpackage #:hp/app
+(uiop:define-package #:hp/app
   (:use #:cl)
-  (:local-nicknames (#:routes #:hp/routes/*))
+  (:local-nicknames (#:jg #:jingle))
   (:import-from #:lack)
+  (:local-nicknames (#:utils #:hp/utils/*))
   (:export #:*app*))
 (in-package #:hp/app)
 
 (defparameter *app*
-  (lack:builder (:static
+  (let ((app (jg:make-app)))
-                 :path "/static/"
+    (utils:enable-file-based-routing app
-                 :root (asdf:system-relative-pathname :hp "static/"))
+                                     :dir "src/routes"
-                routes:*index-app*))
+                                     :system "hp"
+                                     :system-pathname "src")
+    (lack:builder (:static
+                   :path "/static/"
+                   :root (asdf:system-relative-pathname :hp "static/"))
+                  app)))
 
 ; for clackup cmd
 *app*

src/routes/index.lisp

@@ -3,63 +3,21 @@
   (:local-nicknames (#:pi #:piccolo))
   (:local-nicknames (#:jg #:jingle))
   (:local-nicknames (#:ui #:hp/ui/*))
-  (:local-nicknames (#:utils #:hp/utils/*))
+  (:export #:on-get))
-  (:export #:*index-app*))
 (in-package #:hp/routes/index)
 
 ;;; View
 
-(pi:define-element counter (value)
-  (pi:h
-    (div :id "counter" :class "h-10 w-20 text-4xl badge badge-neutral"
-       value)))
-
 (pi:define-element page ()
   (pi:h
     (ui:layout
       (section :class "h-full flex justify-center items-center"
-        (div :class "flex flex-col items-center gap-4"
+        (p :class "text-primary text-4xl"
-          (counter :value *counter*)
+          "Hello World!")))))
-          (button
-            :hx-target "#counter"
-            :hx-post   "/counter/decrease"
-            :hx-swap   "outerHTML"
-            :class     "btn btn-neutral-content"
-            "Decrease -")
-          (button
-            :hx-target "#counter"
-            :hx-post   "/counter/increase"
-            :hx-swap   "outerHTML"
-            :class     "btn btn-neutral-content"
-            "Increase +"))))))
 
 ;;; Controller
 
-(defparameter *counter* 0)
+(defun on-get (params)
-
-(defun index (params)
   (declare (ignore params))
   (jg:with-html-response
     (pi:element-string (page))))
-
-(defun increase (params)
-  (declare (ignore params))
-  (jg:with-html-response
-    (pi:element-string
-      (counter :value (incf *counter*)))))
-
-(defun decrease (params)
-  (declare (ignore params))
-  (jg:with-html-response
-    (pi:element-string
-      (counter :value (decf *counter*)))))
-
-;;; Routes
-
-(defparameter *index-app* (jg:make-app))
-
-(utils:register-routes
- *index-app*
- `((:method :GET  :path "/"                 :handler ,#'index)
-   (:method :POST :path "/counter/increase" :handler ,#'increase)
-   (:method :POST :path "/counter/decrease" :handler ,#'decrease)))

src/utils/routes.lisp

@@ -1,12 +1,63 @@
 (defpackage #:hp/utils/routes
   (:use #:cl)
+  (:local-nicknames (#:alx #:alexandria))
+  (:local-nicknames (#:re #:cl-ppcre))
   (:local-nicknames (#:jg #:jingle))
-  (:export #:register-routes))
+  (:export #:enable-file-based-routing))
 (in-package #:hp/utils/routes)
 
-(defun register-routes (app routes)
+(defun remove-file-type (namestr)
-  (loop :for item :in routes
+  (re:regex-replace ".lisp" namestr ""))
-        :for path    = (getf item :path)
+
-        :for handler = (getf item :handler)
+(defun remove-index (url)
-        :for method  = (getf item :method)
+  (if (string= url "/index")
-        :do (setf (jg:route app path :method method) handler)))
+      "/"
+      (re:regex-replace "/index" url "")))
+
+(defun pathname->url (pathname dir)
+  (remove-index
+   (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 (jg:route app url :method method) handler)))))))