make html-responder (HTML response class) configurable; use cs-hx:response in demo app

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)

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)

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

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

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

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)