diff --git a/core/core.lisp b/core/core.lisp index 9189a80..ef198a1 100644 --- a/core/core.lisp +++ b/core/core.lisp @@ -4,7 +4,6 @@ (:use :common-lisp) (:local-nicknames (:config :scopes/config)) (:export #:config #:service-config - #:message #:context #:name #:send #:printer)) @@ -18,17 +17,6 @@ (defclass service-config (config:base) (start)) -;;;; message - -(defclass message () - ((domain) - (action) - (class) - (item) - (sender) - (timestamp) - (data))) - ;;;; actions (defclass action-spec () @@ -44,9 +32,9 @@ (defgeneric send (rcvr msg) (:method ((rcvr context) msg) (let* ((acts (actions rcvr)) - (selected (car acts)) - (hdlr (car (handlers selected)))) - (funcall hdlr msg)))) + (selected (car acts))) + (dolist (hdlr (handlers selected)) + (funcall hdlr msg))))) (defvar *context* nil) diff --git a/core/message.lisp b/core/message.lisp new file mode 100644 index 0000000..ee7d33c --- /dev/null +++ b/core/message.lisp @@ -0,0 +1,33 @@ +;;;; cl-scopes/core/message + +(defpackage :scopes/core/message + (:use :common-lisp) + (:local-nicknames (:core :scopes/core)) + (:export #:message #:simple-message + #:data)) + +(in-package :scopes/core/message) + +(defclass message-head () + ((domain) + (action) + (class) + (item))) + +(defclass message () + ((head :reader head :initarg :head) + (sender) + (timestamp) + (data :accessor data :initform nil))) + +(defun simple-message (&rest head-vals) + (let ((h (make-instance 'message-head))) + (dolist (sl '(domain action class item)) + (setf (slot-value h sl) (pop head-vals))) + (make-instance 'message :head h))) + +(defmethod print-object ((msg message) stream) + (with-slots (domain action class item) (head msg) + (format stream + "~&>~%" + domain action class item (data msg)))) diff --git a/scopes-core.asd b/scopes-core.asd index 991af0d..033c7d3 100644 --- a/scopes-core.asd +++ b/scopes-core.asd @@ -9,6 +9,7 @@ :depends-on (:alexandria :cl-dotenv :com.inuoe.jzon :local-time :log4cl :str) :components ((:file "config" :depends-on ("util")) (:file "core/core" :depends-on ("config" "forge/forge" "util")) + (:file "core/message" :depends-on ("core/core")) (:file "forge/forge") (:file "util") (:file "testing" :depends-on ("util")) diff --git a/scopes.asd b/scopes.asd index ef5b889..0c1e5c1 100644 --- a/scopes.asd +++ b/scopes.asd @@ -10,6 +10,7 @@ :local-time :log4cl :str :sxql) :components ((:file "config" :depends-on ("util")) (:file "core/core" :depends-on ("config" "forge/forge" "util")) + (:file "core/message" :depends-on ("core/core")) (:file "forge/forge") (:file "storage/storage") (:file "storage/tracking" :depends-on ("storage/storage")) diff --git a/test/test-core.lisp b/test/test-core.lisp index e671983..59ef4f4 100644 --- a/test/test-core.lisp +++ b/test/test-core.lisp @@ -4,6 +4,7 @@ (:use :common-lisp) (:local-nicknames (:config :scopes/config) (:core :scopes/core) + (:message :scopes/core/message) (:util :scopes/util) (:t :scopes/testing)) (:export #:run #:user #:password) @@ -27,7 +28,8 @@ (t:deftest test-send () (let ((rcvr (receiver t:*test-suite*)) - (msg "dummy message")) + (msg (message:simple-message :test :dummy))) + (setf (message:data msg) "dummy payload") (== (core:name rcvr) :test-rcvr) (core:send rcvr msg) ))