X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=8sync%2Fsystems%2Factors.scm;h=2d42897a03740c3be374473d192d9b463e289a71;hp=8f15feb8b9046258968039eb338d8a79953f3e1a;hb=55bf40bbd2d7cd5f0f14f0e2de28f71dfe1a127e;hpb=70b92d795a14d1328b90dd06f8c618b2ea09332d
diff --git a/8sync/systems/actors.scm b/8sync/systems/actors.scm
index 8f15feb..2d42897 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) "@"
@@ -423,7 +425,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 +542,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)))