X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=8sync%2Fsystems%2Factors.scm;h=0ae6e054c0c0eec3ea57f34f9d131f13efb0b023;hb=89dfbd6214e8e00bca235fd2974c0b343655d48f;hp=8f15feb8b9046258968039eb338d8a79953f3e1a;hpb=70b92d795a14d1328b90dd06f8c618b2ea09332d;p=8sync.git

diff --git a/8sync/systems/actors.scm b/8sync/systems/actors.scm
index 8f15feb..0ae6e05 100644
--- a/8sync/systems/actors.scm
+++ b/8sync/systems/actors.scm
@@ -24,6 +24,7 @@
   #:use-module (srfi srfi-9 gnu)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 pretty-print)
   #:use-module (8sync agenda)
   #:use-module (8sync repl)
   #:export (;; utilities... ought to go in their own module
@@ -37,7 +38,9 @@
             actor-hive
             actor-message-handler
 
-            <address>
+            ;;; Commenting out the <address> type for now;
+            ;;; it may be back when we have better serializers
+            ;; <address>
             make-address address?
             address-actor-id address-hive-id
 
@@ -107,7 +110,7 @@
 ;;; =========================
 
 (define-class <actor> ()
-  ;; An <address> object
+  ;; An address object
   (id #:init-thunk (require-slot "id")
       #:init-keyword #:id
       #:getter actor-id)
@@ -123,16 +126,31 @@
 (define-method (actor-message-handler (actor <actor>))
   (slot-ref actor 'message-handler))
 
-(define-record-type <address>
-  (make-address actor-id hive-id)  ; @@: Do we want the trailing -id?
-  address?
-  (actor-id address-actor-id)
-  (hive-id address-hive-id))
+;;; So these are the nicer representations of addresses.
+;;; However, they don't serialize so easily with scheme read/write, so we're
+;;; using the simpler cons cell version below for now.
 
+;; (define-record-type <address>
+;;   (make-address actor-id hive-id)  ; @@: Do we want the trailing -id?
+;;   address?
+;;   (actor-id address-actor-id)
+;;   (hive-id address-hive-id))
+;;
 ;; (set-record-type-printer!
 ;;  <address>
 ;;  (lambda (record port)
-;;    (format port "<<address> ~s>" (address->string record))))
+;;    (format port "<address: ~s@~s>"
+;;            (address-actor-id record) (address-hive-id record))))
+;;
+
+(define (make-address actor-id hive-id)
+  (cons actor-id hive-id))
+
+(define (address-actor-id address)
+  (car address))
+
+(define (address-hive-id address)
+  (cdr address))
 
 (define (address->string address)
   (string-append (address-actor-id address) "@"
@@ -423,7 +441,7 @@ Instead, actors should call create-actor."
   ;; Requiring mutation on message objects is clearly not great,
   ;; but it may be worth it...?  Investigate!
   (replied message-replied set-message-replied!)
-  (deferred-reply deferred-reply set-message-deferred-reply!))
+  (deferred-reply message-deferred-reply set-message-deferred-reply!))
 
 
 (define* (make-message id to from action body
@@ -540,3 +558,44 @@ an integer."
 (define (hive-bootstrap-message hive to-id action . message-body-args)
   (wrap
    (apply send-message hive to-id action message-body-args)))
+
+
+
+;;; Convenience procedures
+;;; ======================
+
+(define (serialize-message message)
+  "Serialize a message for read/write"
+  (list
+   (message-id message)
+   (address->string (message-to message))
+   (address->string (message-from message))
+   (message-action message)
+   (message-body message)
+   (message-in-reply-to message)
+   (message-replied message)
+   (message-deferred-reply message)))
+
+(define (write-message message port)
+  "Write out a message to a port for easy reading later.
+
+Note that if a sub-value can't be easily written to something
+Guile's `read' procedure knows how to read, this doesn't do anything
+to improve that.  You'll need a better serializer for that.."
+  (write (serialize-message message) port))
+
+(define (serialize-message-pretty message)
+  "Serialize a message in a way that's easy for humans to read."
+  `(*message*
+    (id ,(message-id message))
+    (to ,(message-to message))
+    (from ,(message-from message))
+    (action ,(message-action message))
+    (body ,(message-body message))
+    (in-reply-to ,(message-in-reply-to message))
+    (replied ,(message-replied message))
+    (deferred-reply ,(message-deferred-reply message))))
+
+(define (pprint-message message)
+  "Pretty print a message."
+  (pretty-print (serialize-message-pretty message)))