cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

web/response: make interaction subclass of new base-context class, store message = action

Browse source
This commit is contained in:
Helmut Merz 2024-08-30 11:26:40 +02:00
parent 1cc19753d4
commit 0bedb8ee33
2 changed files with 13 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
core/core.lisp
View file

@ -7,9 +7,10 @@
(:shape :scopes/shape)
(:util :scopes/util)
(:alx :alexandria))
(:export #:*root* #:default-setup #:default-actions
(:export #:action-spec
#:*root* #:default-setup #:default-actions
#:find-service #:setup-services
#:context #:add-action #:config #:name #:send #:shutdown
#:base-context #:context #:add-action #:config #:name #:send #:shutdown
#:handle-message
#:do-print #:echo))
@ -47,13 +48,12 @@
(defvar *root* nil)
(defclass base-context ()
())
((actions :accessor actions :initform nil)
(default-actions :reader default-actions :initform nil)))
(defclass context ()
(defclass context (base-context)
((config :reader config :initarg :config)
(name :reader name :initarg :name)
(actions :accessor actions :initform nil)
(default-actions :reader default-actions :initform nil)
(services :reader services :initform (make-hash-table))))
(defun default-setup (cfg &optional (cls 'context) &rest args &key &allow-other-keys)
@ -90,11 +90,11 @@
(setf (gethash (config:name cfg) services) child)))))
(defgeneric send (rcvr msg)
(:method ((rcvr context) msg)
(:method ((rcvr base-context) msg)
(handle-message rcvr msg)))
(defgeneric handle-message (ctx msg)
(:method ((ctx context) msg)
(:method ((ctx base-context) msg)
(cond
((do-actions ctx msg) t)
((do-actions ctx msg #'default-actions) t)

10
web/response.lisp
View file

@ -14,16 +14,16 @@
;;;; server interaction - receive response message from action processing chain
(defclass interaction ()
((response :reader response :initarg :response)
(defclass interaction (core:base-context)
((core:default-actions :initform
(list (make-instance 'core:action-spec :handlers (list #'store-msg))))
(response :reader response :initarg :response)
(messages :accessor messages :initform nil)))
(defmethod print-object ((ia interaction) s)
(shape:print-fields ia s 'messages))
(defmethod core:send ((ia interaction) msg)
(util:lgd msg)
;(handle-message ia msg)
(defun store-msg (ia msg)
(push msg (messages ia)))
(defun add-cookies (iact)