;;;; cl-scopes/web/response - set up and render server response

(defpackage :scopes/web/response
  (:use :common-lisp)
  (:local-nicknames (:dom :scopes/web/dom)
                    (:message :scopes/core/message))
  (:export #:setup
           #:render #:render-not-found))

(in-package :scopes/web/response)

(defclass response ()
  ((context :reader context :initarg :context)
   (env :reader env :initarg :env)
   (ctype :reader ctype :allocation :class)))

(defgeneric render-content (resp msg))

(defclass plain-text-response (response) 
  ((ctype :initform "text/plain")))

(defclass json-response (response)
  ((ctype :initform "application/json")))

;;;; html response

(defclass html-response (response)
  ((ctype :initform "text/html")))

(defmethod render-content ((resp html-response) msg)
  (dom:render (dom:dlist nil (message:data msg))))

;;;; common definitions

(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)
  (let ((accept (string-downcase accept)))
    (cond 
      ((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)
  ; process special message heads, e.g. (:system :error ...)
  ;   => set status code, provide additional data elements
  ;      set additional headers
  (let ((headers (list :content-type (ctype resp)))
        (rcode 200)
        (content (render-content resp msg)))
    (list rcode headers (list content))))

(defun render-not-found(resp)
  (list 404 '(:content-type "text/plain") '("Not found")))