get rid of 'head-as-list'
This commit is contained in:
parent
b6f09c8f04
commit
32c4f5ced1
6 changed files with 10 additions and 14 deletions
|
@ -20,7 +20,7 @@
|
|||
(handlers :accessor handlers :initarg :handlers)))
|
||||
|
||||
(defun select (msg acts)
|
||||
(let ((h (message:head-as-list msg))
|
||||
(let ((h (message:head msg))
|
||||
(hdlrs nil))
|
||||
(dolist (a acts)
|
||||
(if (match (pattern a) h)
|
||||
|
@ -107,7 +107,7 @@
|
|||
(defun echo (ctx msg)
|
||||
(let ((sndr (message:sender msg)))
|
||||
(if sndr
|
||||
(let* ((h (message:head-as-list msg))
|
||||
(let* ((h (message:head msg))
|
||||
(new-msg (message:create `(:scopes :echo ,@(cddr h))
|
||||
:data (message:data msg))))
|
||||
(send sndr new-msg))
|
||||
|
|
|
@ -3,8 +3,7 @@
|
|||
(defpackage :scopes/core/message
|
||||
(:use :common-lisp)
|
||||
(:export #:message #:create
|
||||
#:head #:head-as-list
|
||||
#:data #:sender))
|
||||
#:head #:data #:sender))
|
||||
|
||||
(in-package :scopes/core/message)
|
||||
|
||||
|
@ -21,6 +20,3 @@
|
|||
|
||||
(defmethod print-object ((msg message) stream)
|
||||
(format stream "<message ~s ~s <data ~s>>" (head msg) (sender msg) (data msg)))
|
||||
|
||||
(defun head-as-list (msg)
|
||||
(head msg))
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
:version "0.0.1"
|
||||
:homepage "https://www.cyberconcepts.org"
|
||||
:description "Core packages of the scopes project."
|
||||
:depends-on (:alexandria :chanl :cl-dotenv :com.inuoe.jzon
|
||||
:depends-on (:alexandria :cl-dotenv :com.inuoe.jzon
|
||||
:local-time :log4cl :str)
|
||||
:components ((:file "config" :depends-on ("util"))
|
||||
(:file "core/core"
|
||||
|
|
|
@ -8,13 +8,13 @@
|
|||
(in-package :scopes/shape)
|
||||
|
||||
(defclass record ()
|
||||
((head-fields :reader head-fields :initarg :head-fields :initform '(:taskid :username))
|
||||
((head-fields :reader head-fields :initarg :head-fields
|
||||
:initform '(:taskid :username) :allocation :class)
|
||||
(head :accessor head :initarg :head)
|
||||
(data :accessor data :initform nil)))
|
||||
|
||||
(defun head-plist (track)
|
||||
(let (pl (hv (head track)))
|
||||
(dolist (hf (head-fields track))
|
||||
(setf (getf pl hf) (if (car hv) (car hv) ""))
|
||||
(setf hv (cdr hv)))
|
||||
(setf (getf pl hf) (or (pop hv) "")))
|
||||
pl))
|
||||
|
|
|
@ -24,7 +24,7 @@
|
|||
(core:default-setup cfg 'test-receiver))
|
||||
|
||||
(defun check-message (ctx msg)
|
||||
(let ((key (message:head-as-list msg)))
|
||||
(let ((key (message:head msg)))
|
||||
(multiple-value-bind (val found) (gethash key (expected ctx))
|
||||
(if found
|
||||
(progn
|
||||
|
@ -34,7 +34,7 @@
|
|||
(t:failure "unexpected: ~s" msg)))))
|
||||
|
||||
(defun expect (ctx msg)
|
||||
(setf (gethash (message:head-as-list msg) (expected ctx))
|
||||
(setf (gethash (message:head msg) (expected ctx))
|
||||
(message:data msg)))
|
||||
|
||||
(defun check-expected ()
|
||||
|
|
|
@ -34,7 +34,7 @@
|
|||
:headers `(("Accept" . ,(accept cfg))))))
|
||||
|
||||
(defun msgpath (msg)
|
||||
(str:join "/" (loop for p in (message:head-as-list msg)
|
||||
(str:join "/" (loop for p in (message:head msg)
|
||||
when p collect (string-downcase p))))
|
||||
|
||||
(defun data-as-alist (data)
|
||||
|
|
Loading…
Add table
Reference in a new issue