reply-message reply-message-wait
ez-run-hive
- hive-bootstrap-message))
+ hive-bootstrap-message
+
+ serialize-message write-message
+ serialize-message-pretty pprint-message
+ read-message read-message-from-string))
;; For ids
(define %random-state
;; change), and using existing tooling (though adding new tooling
;; would be negligible in implementation effort.)
-(define* (message-ref message key #:optional dflt)
+;; This cons cell is immutable and unique (for eq? tests)
+(define %nothing-provided (cons 'nothing 'provided))
+
+(define* (message-ref message key #:optional (dflt %nothing-provided))
"Extract KEY from body of MESSAGE.
-Optionally set default with [DFLT]"
+Optionally set default with [DFLT]
+If key not found and DFLT not provided, throw an error."
(let ((result (assoc key (message-body message))))
(if result (cdr result)
- dflt)))
+ (if (eq? dflt %nothing-provided)
+ (throw 'message-missing-key
+ "Message body does not contain key and no default provided"
+ #:key key
+ #:message message)
+ dflt))))
(define (kwarg-list-to-alist args)
(message-action message)
(message-body message)
(message-in-reply-to message)
+ (message-wants-reply message)
(message-replied message)
(message-deferred-reply message)))
-(define (write-message message port)
+(define* (write-message message #:optional (port (current-output-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
(action ,(message-action message))
(body ,(message-body message))
(in-reply-to ,(message-in-reply-to message))
+ (wants-reply ,(message-wants-reply 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)))
+
+(define* (read-message #:optional (port (current-input-port)))
+ "Read a message serialized via serialize-message from PORT"
+ (match (read port)
+ ((id to from action body in-reply-to wants-reply replied deferred-reply)
+ (make-message-intern
+ id to from action body
+ in-reply-to wants-reply replied deferred-reply))
+ (anything-else
+ (throw 'message-read-bad-structure
+ "Could not read message from structure"
+ anything-else))))
+
+(define (read-message-from-string message-str)
+ "Read message from MESSAGE-STR"
+ (with-input-from-string message-str
+ (lambda ()
+ (read-message (current-input-port)))))