X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=8sync%2Fsystems%2Factors.scm;h=40c5c5712e5822df9a03f2b5bd7e81ce24cf7714;hp=39cd4528338233dcca73cf1b1342c1e88665e42a;hb=ebd8bf71b4734a850ca975207871bbd7a8bf81a4;hpb=9271382a4eda5d90e33ebe9a3f28316a9dd7f423
diff --git a/8sync/systems/actors.scm b/8sync/systems/actors.scm
index 39cd452..40c5c57 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
@@ -129,10 +130,11 @@
(actor-id address-actor-id)
(hive-id address-hive-id))
-;; (set-record-type-printer!
-;;
-;; (lambda (record port)
-;; (format port "< ~s>" (address->string record))))
+(set-record-type-printer!
+
+ (lambda (record port)
+ (format port ""
+ (address-actor-id record) (address-hive-id record))))
(define (address->string address)
(string-append (address-actor-id address) "@"
@@ -540,3 +542,37 @@ 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 (serialize-message message) port))
+
+(define (serialize-message-pretty message)
+ `(*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 (serialize-message-pretty message)))