From: Christopher Allan Webber <cwebber@dustycloud.org>
Date: Fri, 22 Apr 2016 14:17:44 +0000 (-0500)
Subject: actors: Write/pretty-print procedures for messages
X-Git-Tag: v0.2.0~64
X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=ebd8bf71b4734a850ca975207871bbd7a8bf81a4;p=8sync.git

actors: Write/pretty-print procedures for messages

* 8sync/systems/actors.scm (serialize-message, write-message):
  New procedures for writing out messages.
  (serialize-message-pretty, pprint-message): New procedures
  for pretty printing.
  (<address>): Update printer to look a little bit nicer.
---

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!
-;;  <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) "@"
@@ -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)))