diff --git a/app/demo/etc/config.lisp b/app/demo/etc/config.lisp index 83108f2..63459db 100644 --- a/app/demo/etc/config.lisp +++ b/app/demo/etc/config.lisp @@ -12,8 +12,7 @@ :port "8800" :address "0.0.0.0" :routes - `((("api") server:message-handler) + `((("api") server:message-handler :html-responder cs-hx:response) (() server:fileserver :doc-root - ;,(util:path-from-string (config:from-env :docroot "/var/www/html/"))))) ,(config:path "/var/www/html/" :env-key :docroot)))) (config:add-action '(:test :data) #'core:echo) diff --git a/app/demo/main.lisp b/app/demo/main.lisp index 54199f5..c3a66c4 100644 --- a/app/demo/main.lisp +++ b/app/demo/main.lisp @@ -3,6 +3,7 @@ (defpackage :scopes/app/demo (:use :common-lisp) (:local-nicknames (:config :scopes/config) + (:cs-hx :scopes/frontend/cs-hx) (:core :scopes/core) (:forge :scopes/forge) (:logging :scopes/logging) diff --git a/frontend/cs-hx.lisp b/frontend/cs-hx.lisp new file mode 100644 index 0000000..a9833d5 --- /dev/null +++ b/frontend/cs-hx.lisp @@ -0,0 +1,13 @@ +;;;; cl-scopes/frontend/cs-hx - frontend (http response) definitions +;;;; for embedding HTML fragments in pages generated by the `cyberscopes` Hugo theme +;;;; with dynamic elements handled by `HTMX`. + +(defpackage :scopes/frontend/cs-hx + (:use :common-lisp) + (:local-nicknames (:dom :scopes/web/dom) + (:response :scopes/web/response)) + (:export #:render-content #:response)) + +(in-package :scopes/frontend/cs-hx) + +(defclass response (response:html-response) ()) diff --git a/scopes-web.asd b/scopes-web.asd index 74b09ce..3f8400a 100644 --- a/scopes-web.asd +++ b/scopes-web.asd @@ -9,7 +9,8 @@ :depends-on (:clack :dexador :flexi-streams :lack :lack-component :lack-app-file :quri :scopes-core) - :components ((:file "web/client") + :components ((:file "frontend/cs-hx" :depends-on ("web/dom" "web/response")) + (:file "web/client") (:file "web/dom") (:file "web/response" :depends-on ("web/dom")) (:file "web/server" :depends-on ("web/response"))) diff --git a/web/response.lisp b/web/response.lisp index ab85b33..bc3d7ea 100644 --- a/web/response.lisp +++ b/web/response.lisp @@ -5,10 +5,13 @@ (:local-nicknames (:dom :scopes/web/dom) (:message :scopes/core/message)) (:export #:setup - #:render #:render-not-found)) + #:html-response + #:render #:render-content #:render-not-found)) (in-package :scopes/web/response) +(defvar *html-response-class* nil) + (defclass response () ((context :reader context :initarg :context) (env :reader env :initarg :env) @@ -32,18 +35,21 @@ ;;;; common definitions -(defun setup (ctx env) +(defun setup (ctx env &key html-responder) (let* ((headers (getf env :headers)) - (resp-class (select-response-class (gethash "accept" headers)))) + (resp-class (select-response-class (gethash "accept" headers) html-responder))) (make-instance resp-class :context ctx :env env))) -(defun select-response-class (accept) +(defun select-response-class (accept html-responder) (let ((accept (string-downcase accept))) (cond - ((str:containsp "html" accept) 'html-response) + ((str:containsp "html" accept) (html-response-class html-responder)) ((str:containsp "json" accept) 'json-response) ((str:containsp "plain" accept) 'plain-text-response) - (t 'html-response)))) + (t (html-response-class html-responder))))) + +(defun html-response-class (html-responder) + (or html-responder *html-response-class* 'html-response)) (defun render (resp msg) ; process special message heads, e.g. (:system :error ...) diff --git a/web/server.lisp b/web/server.lisp index 905253a..ffef7a1 100644 --- a/web/server.lisp +++ b/web/server.lisp @@ -76,17 +76,16 @@ (tail (last message-head))) (if (string= (car tail) "") (setf (car tail) "index.html")) - (log:debug "doc-root: ~s" doc-root) (let* ((rel-path (str:join "/" message-head)) (file-app (make-instance 'lack/app/file:lack-app-file :file rel-path :root doc-root))) (lack/component:call file-app env)))) -(defun message-handler (ctx env &key html-renderer) +(defun message-handler (ctx env &key html-responder) (let* ((iact (make-instance 'interaction)) (msg (message:create (head env) :data (plist (post-data env)) :sender iact)) - (resp (response:setup ctx env))) + (resp (response:setup ctx env :html-responder html-responder))) (log:debug "msg ~s" msg) ; (check-auth ctx msg env) => (response:render-unauthorized resp) (if (core:handle-message ctx msg)