move response setup and rendering to new package web/response

scopes-web.asd

@@ -10,7 +10,8 @@
                :lack :lack-component :lack-app-file :quri
                :scopes-core)
   :components ((:file "web/client")
-               (:file "web/server"))
+               (:file "web/response")
+               (:file "web/server" :depends-on ("web/response")))
   :long-description "scopes/web: Web server and web/API/REST client."
   :in-order-to ((test-op (test-op "scopes-web/test"))))
 

web/response.lisp

@@ -0,0 +1,43 @@
+;;;; cl-scopes/web/response - set up and render server response
+
+(defpackage :scopes/web/response
+  (:use :common-lisp)
+  (:local-nicknames (:message :scopes/core/message))
+  (:export #:setup
+           #:render #:render-not-found))
+
+(in-package :scopes/web/response)
+
+(defclass plain-text-response ()
+  ((context :initarg :context)
+   (env :initarg :env)))
+
+(defclass json-response (plain-text-response) ())
+
+(defclass html-response (plain-text-response) ())
+
+(defun setup (ctx env)
+  (let* ((headers (getf env :headers))
+         (resp-class (select-response-class (gethash "accept" headers))))
+    (make-instance resp-class :context ctx :env env)))
+
+(defun select-response-class (accept)
+  (cond 
+    ((null accept) 'html-response)
+    ((str:containsp "html" accept) 'html-response)
+    ((str:containsp "json" accept) 'json-response)
+    ((str:containsp "plain" accept) 'plain-text-response)
+    (t 'html-response)))
+
+(defun render (resp msg)
+  (let ((headers '(:content-type "text/plain"))
+        (rcode 200)
+        (content (getf (message:data msg) :info)))
+    ; process special message heads, e.g. (:system :error ...)
+    ;   => set status code, provide additional data elements
+    ; (gethash "accept" (getf env :headers)) => select output format
+    ; set headers, render body
+    (list rcode headers (list content))))
+
+(defun render-not-found(resp)
+  (list 404 '(:content-type "text/plain") '("Not found")))

web/server.lisp

@@ -5,6 +5,7 @@
   (:local-nicknames (:config :scopes/config)
                     (:core :scopes/core)
                     (:message :scopes/core/message)
+                    (:response :scopes/web/response)
                     (:util :scopes/util)
                     (:alx :alexandria))
   (:export #:config #:address #:port #:routes
@@ -83,14 +84,15 @@
 (defun message-handler (ctx env)
   (let* ((iact (make-instance 'interaction))
          (msg (message:create 
-                (head env) :data (plist (post-data env)) :sender iact)))
+                (head env) :data (plist (post-data env)) :sender iact))
+         (resp (response:setup ctx env)))
     (log:debug "msg ~s" msg)
-    ; (check-auth ctx msg env) => (render-unauthorized ctx msg env)
+    ; (check-auth ctx msg env) => (response:render-unauthorized resp)
     (if (core:handle-message ctx msg)
-      (render ctx (message iact) env)
-      (render-not-found ctx env))))
+      (response:render resp (message iact))
+      (response:render-not-found resp))))
 
-;;;; server interaction and response - provide response data and render body and headers
+;;;; server interaction - receive response message from action processing chain
 
 (defclass interaction ()
   ((message :accessor message :initform nil)))
@@ -102,19 +104,6 @@
   (log:debug "receiving ~s" msg)
   (setf (message ia) msg))
 
-(defun render (ctx msg env)
-  (let ((headers '(:content-type "text/plain"))
-        (rcode 200)
-        (content (getf (message:data msg) :info)))
-    ; process special message heads, e.g. (:system :error ...)
-    ;   => set status code, provide additional data elements
-    ; (gethash "accept" (getf env :headers)) => select output format
-    ; set headers, render body
-    (list rcode headers (list content))))
-
-(defun render-not-found(ctx env)
-  (list 404 '(:content-type "text/plain") '("Not found")))
-
 ;;;; helper functions
 
 (defun head (env)