simple message set-up, + print method

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)
 

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 
+            "~&<message (~a ~a ~a ~a) <data ~s>>~%" 
+            domain action class item (data msg))))

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"))

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"))

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)
     ))