minor improvements on message handling, server response, echo handler
This commit is contained in:
parent
9c3f68740c
commit
797b291262
4 changed files with 19 additions and 15 deletions
|
@ -105,10 +105,13 @@
|
|||
;;;; some simple predefined actions
|
||||
|
||||
(defun echo (ctx msg)
|
||||
(let ((resp (message:sender msg)))
|
||||
(if (null resp)
|
||||
(log:warn "sender missing: ~s" msg)
|
||||
(send resp msg))))
|
||||
(let ((sndr (message:sender msg)))
|
||||
(if sndr
|
||||
(let* ((h (message:head-as-list msg))
|
||||
(new-msg (message:create `(:scopes :echo ,@(cddr h))
|
||||
:data (message:data msg))))
|
||||
(send sndr new-msg))
|
||||
(log:warn "sender missing: ~s" msg))))
|
||||
|
||||
(defun do-print (ctx msg)
|
||||
(declare (ignore ctx))
|
||||
|
|
|
@ -2,8 +2,9 @@
|
|||
|
||||
(defpackage :scopes/core/message
|
||||
(:use :common-lisp)
|
||||
(:export #:message #:make-message #:simple-message
|
||||
#:head #:data #:sender #:head-as-list))
|
||||
(:export #:message #:create #:make-message #:simple-message
|
||||
#:head #:head-as-list
|
||||
#:data #:sender))
|
||||
|
||||
(in-package :scopes/core/message)
|
||||
|
||||
|
@ -24,6 +25,9 @@
|
|||
(data :accessor data :initarg :data :initform nil)))
|
||||
|
||||
(defun make-message (head-vals &key data sender)
|
||||
(create head-vals :data data :sender sender))
|
||||
|
||||
(defun create (head-vals &key data sender)
|
||||
(let ((h (make-instance 'message-head)))
|
||||
(dolist (sl '(domain action class item))
|
||||
(setf (slot-value h sl) (pop head-vals)))
|
||||
|
|
|
@ -57,14 +57,14 @@
|
|||
(lack/component:call file-app env))))
|
||||
|
||||
(defun message-handler (ctx env)
|
||||
(let* ((resp (make-response ctx))
|
||||
(msg (message:make-message
|
||||
(let* ((resp (make-instance 'response))
|
||||
(msg (message:create
|
||||
(head env) :data (plist (post-data env)) :sender resp)))
|
||||
(log:debug "msg ~s" msg)
|
||||
(if (core:handle-message ctx msg)
|
||||
;(render-response ctx resp)
|
||||
(list 200 (headers resp) (list (body resp)))
|
||||
'(404 (:content-type "text/plain") ("Not found")))))
|
||||
(list 404 '(:content-type "text/plain") '("Not found")))))
|
||||
;(render-not-found ctx)
|
||||
|
||||
(defun select-app (ctx env)
|
||||
|
@ -85,18 +85,15 @@
|
|||
;;;; server response - provice response body and headers
|
||||
|
||||
(defclass response ()
|
||||
((ctx :reader ctx :initarg :ctx)
|
||||
(message :accessor message :initform nil)
|
||||
((message :accessor message :initform nil)
|
||||
(headers :accessor headers :initform '(:content-type "text/plain"))))
|
||||
|
||||
(defun make-response (ctx)
|
||||
(make-instance 'response :ctx ctx))
|
||||
|
||||
(defgeneric body (r)
|
||||
(:method ((r response))
|
||||
(getf (message:data (message r)) :info)))
|
||||
|
||||
(defmethod core:send ((r response) msg)
|
||||
(log:debug "receiving ~s" msg)
|
||||
(setf (message r) msg))
|
||||
|
||||
(defmethod print-object ((r response) s)
|
||||
|
|
Loading…
Add table
Reference in a new issue