diff --git a/qlfile b/qlfile index 147aee5..ac01704 100644 --- a/qlfile +++ b/qlfile @@ -6,3 +6,4 @@ ql lack ql clack ql cl-jingle git piccolo https://github.com/skyizwhite/piccolo.git +ql cl-ppcre diff --git a/qlfile.lock b/qlfile.lock index 85624f6..8a3b068 100644 --- a/qlfile.lock +++ b/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")) diff --git a/src/app.lisp b/src/app.lisp index 03cc600..153e517 100644 --- a/src/app.lisp +++ b/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 - :path "/static/" - :root (asdf:system-relative-pathname :hp "static/")) - routes:*index-app*)) + (let ((app (jg:make-app))) + (utils:enable-file-based-routing app + :dir "src/routes" + :system "hp" + :system-pathname "src") + (lack:builder (:static + :path "/static/" + :root (asdf:system-relative-pathname :hp "static/")) + app))) ; for clackup cmd *app* diff --git a/src/routes/index.lisp b/src/routes/index.lisp index 81b66fa..b013f4e 100644 --- a/src/routes/index.lisp +++ b/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 #:*index-app*)) + (:export #:on-get)) (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" - (counter :value *counter*) - (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 +")))))) + (p :class "text-primary text-4xl" + "Hello World!"))))) ;;; Controller -(defparameter *counter* 0) - -(defun index (params) +(defun on-get (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))) diff --git a/src/utils/routes.lisp b/src/utils/routes.lisp index a713393..772a040 100644 --- a/src/utils/routes.lisp +++ b/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) - (loop :for item :in routes - :for path = (getf item :path) - :for handler = (getf item :handler) - :for method = (getf item :method) - :do (setf (jg:route app path :method method) handler))) +(defun remove-file-type (namestr) + (re:regex-replace ".lisp" namestr "")) + +(defun remove-index (url) + (if (string= url "/index") + "/" + (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)))))))