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

get rid of make-message

Browse source
This commit is contained in:
Helmut Merz 2024-07-07 15:06:50 +02:00
parent 797b291262
commit 48e2fde93a
3 changed files with 5 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
core/message.lisp
View file

@ -2,7 +2,7 @@
(defpackage :scopes/core/message (defpackage :scopes/core/message
(:use :common-lisp) (:use :common-lisp)
(:export #:message #:create #:make-message #:simple-message (:export #:message #:create
#:head #:head-as-list #:head #:head-as-list
#:data #:sender)) #:data #:sender))
@ -24,18 +24,12 @@
(timestamp) (timestamp)
(data :accessor data :initarg :data :initform nil))) (data :accessor data :initarg :data :initform nil)))
(defun make-message (head-vals &key data sender)
(create head-vals :data data :sender sender))
(defun create (head-vals &key data sender) (defun create (head-vals &key data sender)
(let ((h (make-instance 'message-head))) (let ((h (make-instance 'message-head)))
(dolist (sl '(domain action class item)) (dolist (sl '(domain action class item))
(setf (slot-value h sl) (pop head-vals))) (setf (slot-value h sl) (pop head-vals)))
(make-instance 'message :head h :data data :sender sender))) (make-instance 'message :head h :data data :sender sender)))
(defun simple-message (&rest head-vals)
(make-message head-vals))
(defmethod print-object ((msg message) stream) (defmethod print-object ((msg message) stream)
(with-slots (domain action class item) (head msg) (with-slots (domain action class item) (head msg)
(format stream (format stream

4
test/test-core.lisp
View file

@ -67,8 +67,8 @@
(deftest test-send () (deftest test-send ()
(let ((rcvr (receiver t:*test-suite*)) (let ((rcvr (receiver t:*test-suite*))
(msg (message:make-message '(:test :dummy) :data "dummy payload")) (msg (message:create '(:test :dummy) :data "dummy payload"))
(msg-exp (message:make-message '(:test :dummy) :data "dummy payload"))) (msg-exp (message:create '(:test :dummy) :data "dummy payload")))
(expect rcvr msg-exp) (expect rcvr msg-exp)
(== (core:name rcvr) :test-receiver) (== (core:name rcvr) :test-receiver)
(core:send rcvr msg) (core:send rcvr msg)

4
test/test-web.lisp
View file

@ -36,10 +36,10 @@
(== (parse-integer (server:port (core:config server))) 8899)) (== (parse-integer (server:port (core:config server))) 8899))
(deftest test-fileserver (client) (deftest test-fileserver (client)
(let ((msg (message:make-message '(:test :get-page) :data '(:path "demo.html")))) (let ((msg (message:create '(:test :get-page) :data '(:path "demo.html"))))
(== (client:base-url (core:config client)) "http://localhost:8899") (== (client:base-url (core:config client)) "http://localhost:8899")
(has-prefix (client:get-page client msg) "Hello Fileserver!"))) (has-prefix (client:get-page client msg) "Hello Fileserver!")))
(deftest test-message (client) (deftest test-message (client)
(let ((msg (message:make-message '(:test :data) :data '(:info "test data")))) (let ((msg (message:create '(:test :data) :data '(:info "test data"))))
(== (client:send-message client msg) "test data"))) (== (client:send-message client msg) "test data")))