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) (:shape :scopes/shape)
(:util :scopes/util) (:util :scopes/util)
(:alx :alexandria)) (:alx :alexandria))
(:export #:*root* #:default-setup #:default-actions (:export #:action-spec
#:*root* #:default-setup #:default-actions
#:find-service #:setup-services #:find-service #:setup-services
#:context #:add-action #:config #:name #:send #:shutdown #:base-context #:context #:add-action #:config #:name #:send #:shutdown
#:handle-message #:handle-message
#:do-print #:echo)) #:do-print #:echo))
@ -47,13 +48,12 @@
(defvar *root* nil) (defvar *root* nil)
(defclass base-context () (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) ((config :reader config :initarg :config)
(name :reader name :initarg :name) (name :reader name :initarg :name)
(actions :accessor actions :initform nil)
(default-actions :reader default-actions :initform nil)
(services :reader services :initform (make-hash-table)))) (services :reader services :initform (make-hash-table))))
(defun default-setup (cfg &optional (cls 'context) &rest args &key &allow-other-keys) (defun default-setup (cfg &optional (cls 'context) &rest args &key &allow-other-keys)
@ -90,11 +90,11 @@
(setf (gethash (config:name cfg) services) child))))) (setf (gethash (config:name cfg) services) child)))))
(defgeneric send (rcvr msg) (defgeneric send (rcvr msg)
(:method ((rcvr context) msg) (:method ((rcvr base-context) msg)
(handle-message rcvr msg))) (handle-message rcvr msg)))
(defgeneric handle-message (ctx msg) (defgeneric handle-message (ctx msg)
(:method ((ctx context) msg) (:method ((ctx base-context) msg)
(cond (cond
((do-actions ctx msg) t) ((do-actions ctx msg) t)
((do-actions ctx msg #'default-actions) 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 ;;;; server interaction - receive response message from action processing chain
(defclass interaction () (defclass interaction (core:base-context)
((response :reader response :initarg :response) ((core:default-actions :initform
(list (make-instance 'core:action-spec :handlers (list #'store-msg))))
(response :reader response :initarg :response)
(messages :accessor messages :initform nil))) (messages :accessor messages :initform nil)))
(defmethod print-object ((ia interaction) s) (defmethod print-object ((ia interaction) s)
(shape:print-fields ia s 'messages)) (shape:print-fields ia s 'messages))
(defmethod core:send ((ia interaction) msg) (defun store-msg (ia msg)
(util:lgd msg)
;(handle-message ia msg)
(push msg (messages ia))) (push msg (messages ia)))
(defun add-cookies (iact) (defun add-cookies (iact)