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

actor:message: provide base class with customer slot

Browse source
This commit is contained in:
Helmut Merz 2025-07-04 10:41:22 +02:00
parent 37b39c596f
commit 0bc84cc02e
4 changed files with 12 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
core/actor.lisp
View file

@ -6,7 +6,7 @@
(:shape :scopes/shape) (:shape :scopes/shape)
(:util :scopes/util)) (:util :scopes/util))
(:export #:start #:stop #:create #:send #:become (:export #:start #:stop #:create #:send #:become
#:message #:content #:customer #:set-content #:customer-message #:message #:content #:customer #:set-content
#:*logger* #:*root* #:*logger* #:*root*
#:echo #:inc #:lgi #:echo #:inc #:lgi
#:calculator #:plus #:minus #:show)) #:calculator #:plus #:minus #:show))
@ -21,14 +21,18 @@
(defgeneric customer (msg) (defgeneric customer (msg)
(:method (msg) nil)) (:method (msg) nil))
(defclass message () (defclass customer-message ()
((content :reader content :initarg :content :initform nil) ((customer :reader customer :initarg :customer :initform nil)))
(customer :reader customer :initarg :customer :initform nil)))
(defclass message (customer-message)
((content :reader content :initarg :content :initform nil)))
(defun message (content &optional customer) (defun message (content &optional customer)
(make-instance 'message :content content :customer customer)) (make-instance 'message :content content :customer customer))
(defgeneric set-content (msg fn) (defgeneric set-content (msg fn)
(:documentation "Create a new message with content returned by calling `fn`
with the content of the input `msg`.")
(:method (msg fn) (funcall fn msg)) (:method (msg fn) (funcall fn msg))
(:method ((msg message) fn) (:method ((msg message) fn)
(message (funcall fn (content msg)) (customer msg)))) (message (funcall fn (content msg)) (customer msg))))

2
core/message.lisp
View file

@ -15,7 +15,7 @@
(defun message-meta () (defun message-meta ()
(make-instance 'shape:record-meta :head-fields '(:domain :action :class :item))) (make-instance 'shape:record-meta :head-fields '(:domain :action :class :item)))
(defclass message (shape:record actor:message) (defclass message (shape:record actor:customer-message)
((shape:meta :initform (message-meta) :allocation :class))) ((shape:meta :initform (message-meta) :allocation :class)))
(defun create (head &key data customer) (defun create (head &key data customer)

2
csys/csys.lisp
View file

@ -56,7 +56,7 @@
(setf (gethash key *sensors*) tsks)) (setf (gethash key *sensors*) tsks))
(util:lgw "no action selected" msg)))))) (util:lgw "no action selected" msg))))))
;;;; neurons (= behavior generators) and synapses (connection generators) ;;;; neurons (= behavior factories) and synapses (connection factories)
(defun neuron (proc &optional state syns (env *environment*)) (defun neuron (proc &optional state syns (env *environment*))
(lambda (msg) (lambda (msg)

3
web/server.lisp
View file

@ -85,6 +85,7 @@
(let* ((rel-path (str:join "/" message-head)) (let* ((rel-path (str:join "/" message-head))
(file-app (make-instance 'lack/app/file:lack-app-file (file-app (make-instance 'lack/app/file:lack-app-file
:file rel-path :root doc-root))) :file rel-path :root doc-root)))
;(request:process message-head ctx env)
(lack/component:call file-app env)))) (lack/component:call file-app env))))
(defun message-handler (ctx env &key html-responder) (defun message-handler (ctx env &key html-responder)
@ -93,7 +94,7 @@
:data (plist (post-data env)) :data (plist (post-data env))
:customer (core:mailbox resp)))) :customer (core:mailbox resp))))
;(util:lgd msg) ;(util:lgd msg)
; (check-auth ctx msg env) => (response:render-unauthorized resp) ;(request:process msg ctx env :response resp)
(if (core:handle-message ctx msg) (if (core:handle-message ctx msg)
(response:render resp) (response:render resp)
(response:render-not-found resp)))) (response:render-not-found resp))))