;;;; cl-scopes/core/message

(defpackage :scopes/core/message
  (:use :common-lisp)
  (:export #:message #:make-message #:simple-message
           #:head #:data #:sender #:head-as-list))

(in-package :scopes/core/message)

;;;; message-head

(defclass message-head ()
  ((domain)
   (action)
   (class)
   (item)))

;;;; message

(defclass message ()
  ((head :reader head :initarg :head)
   (sender :reader sender :initarg :sender :initform nil)
   (timestamp)
   (data :accessor data :initarg :data :initform nil)))

(defun make-message (head-vals &key data sender)
  (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 :data data :sender sender)))

(defun simple-message (&rest head-vals)
  (make-message head-vals))

(defmethod print-object ((msg message) stream)
  (with-slots (domain action class item) (head msg)
    (format stream 
            "<message (~a ~a ~a ~a) ~s <data ~s>>" 
            domain action class item (sender msg) (data msg))))

(defun head-as-list (msg)
  (with-slots (domain action class item) (head msg)
    (list domain action class item)))