diff --git a/core/core.lisp b/core/core.lisp index f613f2d..887d34a 100644 --- a/core/core.lisp +++ b/core/core.lisp @@ -4,6 +4,7 @@ (:use :common-lisp) (:local-nicknames (:config :scopes/config) (:message :scopes/core/message) + (:shape :scopes/shape) (:alx :alexandria)) (:export #:*root* #:default-setup #:default-actions #:find-service #:setup-services @@ -20,7 +21,7 @@ (handlers :accessor handlers :initarg :handlers))) (defun select (msg acts) - (let ((h (message:head msg)) + (let ((h (shape:head msg)) (hdlrs nil)) (dolist (a acts) (if (match (pattern a) h) @@ -107,9 +108,9 @@ (defun echo (ctx msg) (let ((sndr (message:sender msg))) (if sndr - (let* ((h (message:head msg)) + (let* ((h (shape:head msg)) (new-msg (message:create `(:scopes :echo ,@(cddr h)) - :data (message:data msg)))) + :data (shape:data msg)))) (send sndr new-msg)) (log:warn "sender missing: ~s" msg)))) diff --git a/core/message.lisp b/core/message.lisp index 779c3a3..162b6bd 100644 --- a/core/message.lisp +++ b/core/message.lisp @@ -2,6 +2,7 @@ (defpackage :scopes/core/message (:use :common-lisp) + (:local-nicknames (:shape :scopes/shape)) (:export #:message #:create #:head #:data #:sender)) @@ -9,14 +10,14 @@ ;;;; message -(defclass message () - ((head :reader head :initarg :head) +(defclass message (shape:record) + ((shape:head-fields :initform '(:domain :action :class :item)) (sender :reader sender :initarg :sender :initform nil) - (timestamp) - (data :accessor data :initarg :data :initform nil))) + (timestamp))) (defun create (head &key data sender) (make-instance 'message :head head :data data :sender sender)) (defmethod print-object ((msg message) stream) - (format stream ">" (head msg) (sender msg) (data msg))) + (format stream ">" + (shape:head msg) (sender msg) (shape:data msg))) diff --git a/frontend/cs-hx.lisp b/frontend/cs-hx.lisp index 024b496..d9e95ed 100644 --- a/frontend/cs-hx.lisp +++ b/frontend/cs-hx.lisp @@ -7,6 +7,7 @@ (:local-nicknames (:dom :scopes/web/dom) (:message :scopes/core/message) (:response :scopes/web/response) + (:shape :scopes/shape) (:util :scopes/util)) (:import-from :scopes/web/dom #:div #:label) (:export #:render-content #:response)) @@ -16,9 +17,9 @@ (defclass response (response:html-response) ()) (defmethod response:render-content ((resp response) msg) - ;(dom:render (dom:dlist nil (message:data msg)))) + ;(dom:render (dom:dlist nil (shape:data msg)))) (dom:render - (div nil (util:loop-plist (message:data msg) k v collect (view-field k v))))) + (div nil (util:loop-plist (shape:data msg) k v collect (view-field k v))))) (defun view-field (label value) (div nil (label nil label) ": " value)) diff --git a/shape/shape.lisp b/shape/shape.lisp index c7c9417..4350b69 100644 --- a/shape/shape.lisp +++ b/shape/shape.lisp @@ -10,8 +10,8 @@ (defclass record () ((head-fields :reader head-fields :initarg :head-fields :initform '(:taskid :username) :allocation :class) - (head :accessor head :initarg :head) - (data :accessor data :initform nil))) + (head :reader head :initarg :head) + (data :accessor data :initarg :data :initform nil))) (defun head-plist (track) (let (pl (hv (head track))) diff --git a/test/test-core.lisp b/test/test-core.lisp index dab25be..f5caeef 100644 --- a/test/test-core.lisp +++ b/test/test-core.lisp @@ -7,6 +7,7 @@ (:core :scopes/core) (:logging :scopes/logging) (:message :scopes/core/message) + (:shape :scopes/shape) (:util :scopes/util) (:t :scopes/testing)) (:export #:run #:user #:password) @@ -24,18 +25,18 @@ (core:default-setup cfg 'test-receiver)) (defun check-message (ctx msg) - (let ((key (message:head msg))) + (let ((key (shape:head msg))) (multiple-value-bind (val found) (gethash key (expected ctx)) (if found (progn - (if (not (equalp (message:data msg) val)) + (if (not (equalp (shape:data msg) val)) (t:failure "data mismatch: ~s, expected: ~s" msg val)) (remhash key (expected ctx))) (t:failure "unexpected: ~s" msg))))) (defun expect (ctx msg) - (setf (gethash (message:head msg) (expected ctx)) - (message:data msg))) + (setf (gethash (shape:head msg) (expected ctx)) + (shape:data msg))) (defun check-expected () (let ((exp (alx:hash-table-keys (expected (receiver t:*test-suite*))))) diff --git a/web/client.lisp b/web/client.lisp index dd3120c..9fba359 100644 --- a/web/client.lisp +++ b/web/client.lisp @@ -5,6 +5,7 @@ (:local-nicknames (:config :scopes/config) (:core :scopes/core) (:message :scopes/core/message) + (:shape :scopes/shape) (:alx :alexandria)) (:export #:config #:base-url #:api-path #:doc-path #:get-page #:send-message)) @@ -22,7 +23,7 @@ (defun get-page (ctx msg) (let* ((cfg (core:config ctx)) - (path (getf (message:data msg) :path)) + (path (getf (shape:data msg) :path)) (url (str:concat (base-url cfg) (doc-path cfg) path))) (dex:get url :headers '(("Accept". "text/html"))))) @@ -30,11 +31,11 @@ (let* ((cfg (core:config ctx)) (url (str:concat (base-url cfg) (api-path cfg) (msgpath msg)))) (dex:post url - :content (data-as-alist (message:data msg)) + :content (data-as-alist (shape:data msg)) :headers `(("Accept" . ,(accept cfg)))))) (defun msgpath (msg) - (str:join "/" (loop for p in (message:head msg) + (str:join "/" (loop for p in (shape:head msg) when p collect (string-downcase p)))) (defun data-as-alist (data) diff --git a/web/response.lisp b/web/response.lisp index cbd1f44..f483f9f 100644 --- a/web/response.lisp +++ b/web/response.lisp @@ -3,7 +3,8 @@ (defpackage :scopes/web/response (:use :common-lisp) (:local-nicknames (:dom :scopes/web/dom) - (:message :scopes/core/message)) + (:message :scopes/core/message) + (:shape :scopes/shape)) (:export #:setup #:html-response #:render #:render-content #:render-not-found)) @@ -31,7 +32,7 @@ ((ctype :initform "text/html"))) (defmethod render-content ((resp html-response) msg) - (dom:render (dom:dlist nil (message:data msg)))) + (dom:render (dom:dlist nil (shape:data msg)))) ;;;; common definitions