(defvar *suppress-line-breaks* nil
"When true, don't generate line breaks in the text format")
-(defgeneric print-text-format (object &optional type &key stream suppress-line-breaks)
+(defgeneric print-text-format (object &optional type &key stream suppress-line-breaks print-name)
(:documentation
"Prints the object 'object' of type 'type' onto the stream 'stream' using the
textual format.
(defmethod print-text-format (object &optional type
&key (stream *standard-output*)
- (suppress-line-breaks *suppress-line-breaks*))
+ (suppress-line-breaks *suppress-line-breaks*) (print-name t))
(let* ((type (or type (type-of object)))
(message (find-message-for-class type)))
(assert message ()
(when (or slot reader)
(cond ((eq (proto-required field) :repeated)
(cond ((keywordp type)
- (map () #'(lambda (v)
- (print-prim v type field stream
- (or suppress-line-breaks indent)))
- (read-slot object slot reader)))
+ (doseq (v (read-slot object slot reader))
+ (print-prim v type field stream
+ (or suppress-line-breaks indent))))
((typep (setq msg (and type (or (find-message trace type)
(find-enum trace type)
(find-type-alias trace type))))
(if suppress-line-breaks
(format stream "~A { " (proto-name field))
(format stream "~&~VT~A {~%" indent (proto-name field)))
- (map () (curry #'do-field v msg indent)
- (proto-fields msg))
+ (dolist (f (proto-fields msg))
+ (do-field v msg indent f))
(if suppress-line-breaks
(format stream "} ")
(format stream "~&~VT}~%" indent)))))))
((typep msg 'protobuf-enum)
- (map () #'(lambda (v)
- (print-enum v msg field stream
- (or suppress-line-breaks indent)))
- (read-slot object slot reader)))
+ (doseq (v (read-slot object slot reader))
+ (print-enum v msg field stream
+ (or suppress-line-breaks indent))))
((typep msg 'protobuf-type-alias)
(let ((type (proto-proto-type msg)))
- (map () #'(lambda (v)
- (let ((v (funcall (proto-serializer msg) v)))
- (print-prim v type field stream
- (or suppress-line-breaks indent))))
- (read-slot object slot reader))))))
+ (doseq (v (read-slot object slot reader))
+ (let ((v (funcall (proto-serializer msg) v)))
+ (print-prim v type field stream
+ (or suppress-line-breaks indent))))))
+ (t
+ (undefined-field-type "While printing ~S to text format,"
+ object type field))))
(t
(cond ((eq type :bool)
(let ((v (cond ((or (eq (proto-required field) :required)
(or suppress-line-breaks indent)))))
((keywordp type)
(let ((v (read-slot object slot reader)))
- (when v
+ (when (and v (not (equal v (proto-default field))))
(print-prim v type field stream
(or suppress-line-breaks indent)))))
((typep (setq msg (and type (or (find-message trace type)
(if suppress-line-breaks
(format stream "~A { " (proto-name field))
(format stream "~&~VT~A {~%" indent (proto-name field)))
- (map () (curry #'do-field v msg indent)
- (proto-fields msg))
+ (dolist (f (proto-fields msg))
+ (do-field v msg indent f))
(if suppress-line-breaks
(format stream "} ")
(format stream "~&~VT}~%" indent))))))
((typep msg 'protobuf-enum)
(let ((v (read-slot object slot reader)))
- (when v
+ (when (and v (not (eql v (proto-default field))))
(print-enum v msg field stream
(or suppress-line-breaks indent)))))
((typep msg 'protobuf-type-alias)
(let ((v (funcall (proto-serializer msg) v))
(type (proto-proto-type msg)))
(print-prim v type field stream
- (or suppress-line-breaks indent)))))))))))))
+ (or suppress-line-breaks indent))))))
+ (t
+ (undefined-field-type "While printing ~S to text format,"
+ object type field)))))))))
(declare (dynamic-extent #'do-field))
- (if suppress-line-breaks
- (format stream "~A { " (proto-name message))
- (format stream "~&~A {~%" (proto-name message)))
- (map () (curry #'do-field object message 0) (proto-fields message))
+ (if print-name
+ (if suppress-line-breaks
+ (format stream "~A { " (proto-name message))
+ (format stream "~&~A {~%" (proto-name message)))
+ (format stream "{"))
+ (dolist (f (proto-fields message))
+ (do-field object message 0 f))
(if suppress-line-breaks
(format stream "}")
(format stream "~&}~%"))
;;; Parse objects that were serialized using the text format
-(defgeneric parse-text-format (type &key stream)
+(defgeneric parse-text-format (type &key stream parse-name)
(:documentation
"Parses an object of type 'type' from the stream 'stream' using the textual format."))
-(defmethod parse-text-format ((type symbol) &key (stream *standard-input*))
+(defmethod parse-text-format ((type symbol)
+ &key (stream *standard-input*) (parse-name t))
(let ((message (find-message-for-class type)))
(assert message ()
"There is no Protobuf message having the type ~S" type)
- (parse-text-format message :stream stream)))
+ (parse-text-format message :stream stream :parse-name parse-name)))
-(defmethod parse-text-format ((message protobuf-message) &key (stream *standard-input*))
- (let ((name (parse-token stream)))
- (assert (string= name (proto-name message)) ()
- "The message is not of the expected type ~A" (proto-name message)))
+(defmethod parse-text-format ((message protobuf-message)
+ &key (stream *standard-input*) (parse-name t))
+ (when parse-name
+ (let ((name (parse-token stream)))
+ (assert (string= name (proto-name message)) ()
+ "The message is not of the expected type ~A" (proto-name message))))
(labels ((deserialize (type trace)
(let* ((message (find-message trace type))
(object (and message
(when slot
(pushnew slot rslots)
(push (funcall (proto-deserializer msg) val)
- (slot-value object slot))))))))
+ (slot-value object slot))))))
+ (t
+ (undefined-field-type "While parsing ~S from text format,"
+ message type field))))
(t
(cond ((keywordp type)
(expect-char stream #\:)
(otherwise (parse-signed-int stream)))))
(when slot
(setf (slot-value object slot)
- (funcall (proto-deserializer msg) val))))))))))))))
- (skip-field (stream)
- ;; Skip either a token or a balanced {}-pair
- (ecase (peek-char nil stream nil)
- ((#\:)
- (read-char stream)
- (skip-whitespace stream)
- (parse-token-or-string stream))
- ((#\{)
- (let ((depth 0))
- (loop for ch = (read-char stream)
- do (cond ((eql ch #\")
- (loop for ch0 = (read-char stream)
- until (eql ch0 #\")))
- ((eql ch #\{)
- (iincf depth))
- ((eql ch #\})
- (idecf depth)))
- until (i= depth 0)))))))
- (declare (dynamic-extent #'deserialize #'skip-field))
+ (funcall (proto-deserializer msg) val))))))
+ (t
+ (undefined-field-type "While parsing ~S from text format,"
+ message type field)))))))))))
+ (declare (dynamic-extent #'deserialize))
(deserialize (proto-class message) message)))
+
+(defun skip-field (stream)
+ "Skip either a token or a balanced {}-pair."
+ (ecase (peek-char nil stream nil)
+ ((#\:)
+ (read-char stream)
+ (skip-whitespace stream)
+ (parse-token-or-string stream))
+ ((#\{)
+ (let ((depth 0))
+ (loop for ch = (read-char stream)
+ do (cond ((eql ch #\")
+ (loop for ch0 = (read-char stream)
+ until (eql ch0 #\")))
+ ((eql ch #\{)
+ (iincf depth))
+ ((eql ch #\})
+ (idecf depth)))
+ until (i= depth 0))))))
projects / cl-protobufs.git / blobdiff