actors: Added docstrings to some message write procedures

[8sync.git] / 8sync / systems / actors.scm

diff --git a/8sync/systems/actors.scm b/8sync/systems/actors.scm
index 8f15feb8b9046258968039eb338d8a79953f3e1a..2d42897a03740c3be374473d192d9b463e289a71 100644 (file)
--- 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!
-;;  <address>
-;;  (lambda (record port)
-;;    (format port "<<address> ~s>" (address->string record))))
+(set-record-type-printer!
+ <address>
+ (lambda (record port)
+   (format port "<address: ~s@~s>"
+           (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)))
+
+
+\f
+;;; 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)))