;;; Protol buffers model classes
-(defvar *all-protobufs* (make-hash-table :test #'equal)
- "A table mapping names to 'protobuf' schemas.")
+(defvar *all-schemas* (make-hash-table :test #'equal)
+ "A table mapping names to 'protobuf-schema' objects.")
+
+(defgeneric find-schema (name)
+ (:documentation
+ "Given a name (a symbol or string), return the 'protobuf-schema' object having that name."))
+
+(defmethod find-schema ((name symbol))
+ (values (gethash (keywordify name) *all-schemas*)))
+
+(defmethod find-schema ((name string))
+ (values (gethash (string-upcase name) *all-schemas*)))
+
+(defmethod find-schema ((path pathname))
+ "Given a pathname, return the 'protobuf-schema' object that came from that path."
+ (values (gethash (make-pathname :type nil :defaults (truename path)) *all-schemas*)))
+
+
+(defvar *all-messages* (make-hash-table :test #'equal)
+ "A table mapping Lisp class names to 'protobuf-message' objects.")
+
+(defgeneric find-message-for-class (class)
+ (:documentation
+ "Given a class or class name, return the message that globally has that name."))
+
+(defmethod find-message-for-class (class)
+ "Given the name of a class (a symbol or string), return the 'protobuf-message' for the class."
+ (values (gethash class *all-messages*)))
+
+(defmethod find-message-for-class ((class class))
+ (values (gethash (class-name class) *all-messages*)))
-(defun find-protobuf (name)
- "Given a name (a string or a symbol), return the 'protobuf' schema having that name."
- (gethash name *all-protobufs*))
;; A few things (the pretty printer) want to keep track of the current schema
-(defvar *protobuf* nil)
+(defvar *protobuf* nil) ;this can be schema, a message, ...
(defvar *protobuf-package* nil)
(defclass abstract-protobuf () ())
(defclass base-protobuf (abstract-protobuf)
- ((name :type (or null string) ;the name of this .proto file/enum/message, etc
+ ((class :type (or null symbol) ;the Lisp name for this object
+ :accessor proto-class ;this often names a type or class
+ :initarg :class
+ :initform nil)
+ (name :type (or null string) ;the Protobufs name for this enum, message, etc
:reader proto-name
:initarg :name
:initform nil)
- (class :type (or null symbol) ;a Lisp "class name" for this object
- :accessor proto-class
- :initarg :class
- :initform nil)
(options :type (list-of protobuf-option) ;options, mostly just passed along
:accessor proto-options
:initarg :options
"The base class for all Protobufs model classes."))
-;; The protobuf, corresponds to one .proto file
-(defclass protobuf (base-protobuf)
+;; A protobuf schema, corresponds to one .proto file
+(defclass protobuf-schema (base-protobuf)
((syntax :type (or null string) ;syntax, passed on but otherwise ignored
:accessor proto-syntax
:initarg :syntax
:initform "proto2")
- (package :type (or null string) ;the package
+ (package :type (or null string) ;the Protobufs package
:accessor proto-package
:initarg :package
:initform nil)
- ;;---*** We need to support 'import' properly
- (imports :type (list-of string) ;any imports
+ (lisp-pkg :type (or null string) ;the Lisp package, from 'option lisp_package = ...'
+ :accessor proto-lisp-package
+ :initarg :lisp-package
+ :initform nil)
+ (imports :type (list-of string) ;the names of schemas to be imported
:accessor proto-imports
:initarg :imports
:initform ())
- (optimize :type (member nil :space :speed)
- :accessor proto-optimize
- :initarg :optimize
- :initform nil)
+ (schemas :type (list-of protobuf-schema) ;the schemas that were successfully imported
+ :accessor proto-imported-schemas ;this gets used for chasing namespaces
+ :initform ())
(enums :type (list-of protobuf-enum) ;the set of enum types
:accessor proto-enums
:initarg :enums
:initform ())
- (messages :type (list-of protobuf-message) ;the set of messages
+ (messages :type (list-of protobuf-message) ;all the messages within this protobuf
:accessor proto-messages
:initarg :messages
:initform ())
+ (extenders :type (list-of protobuf-message) ;the 'extend' messages in this protobuf
+ :accessor proto-extenders ;these precede unextended messages in 'find-message'
+ :initarg :extenders
+ :initform ())
(services :type (list-of protobuf-service)
:accessor proto-services
:initarg :services
(:documentation
"The model class that represents a Protobufs schema, i.e., one .proto file."))
-(defmethod print-object ((p protobuf) stream)
- (print-unprintable-object (p stream :type t :identity t)
- (format stream "~@[~A~]~@[ (package ~A)~]"
- (proto-name p) (proto-package p))))
+(defmethod make-load-form ((s protobuf-schema) &optional environment)
+ (with-slots (class name) s
+ (multiple-value-bind (constructor initializer)
+ (make-load-form-saving-slots s :environment environment)
+ (values `(let ((s ,constructor))
+ (record-protobuf s ',class ',name nil)
+ s)
+ initializer))))
+
+(defmethod record-protobuf ((schema protobuf-schema) &optional symbol name type)
+ "Record all the names by which the Protobufs schema might be known."
+ (declare (ignore type))
+ (let ((symbol (or symbol (proto-class schema)))
+ (name (or name (proto-name schema))))
+ (when symbol
+ (setf (gethash (keywordify symbol) *all-schemas*) schema))
+ (when name
+ (setf (gethash (string-upcase name) *all-schemas*) schema))
+ (let ((path (or *compile-file-pathname* *load-pathname*)))
+ (when path
+ ;; Record the file from which the Protobufs schema came, sans file type
+ (setf (gethash (make-pathname :type nil :defaults (truename path)) *all-schemas*) schema)))))
+
+(defmethod print-object ((s protobuf-schema) stream)
+ (print-unreadable-object (s stream :type t :identity t)
+ (format stream "~@[~S~]~@[ (package ~A)~]"
+ (proto-class s) (proto-package s))))
(defgeneric find-message (protobuf type)
(:documentation
"Given a protobuf schema or message and a type name or class name,
- returns the protobuf message corresponding to the type."))
-
-(defmethod find-message ((protobuf protobuf) (type symbol))
- (or (find type (proto-messages protobuf) :key #'proto-class)
- (find type (proto-messages protobuf) :key #'proto-alias-for)
- (some #'(lambda (msg) (find-message msg type)) (proto-messages protobuf))))
-
-(defmethod find-message ((protobuf protobuf) (type class))
- (find-message protobuf (class-name type)))
-
-(defmethod find-message ((protobuf protobuf) (type string))
- (or (find type (proto-messages protobuf) :key #'proto-name :test #'string=)
- (some #'(lambda (msg) (find-message msg type)) (proto-messages protobuf))))
+ returns the Protobufs message corresponding to the type."))
+
+(defmethod find-message ((schema protobuf-schema) (type symbol))
+ ;; Extended messages "shadow" non-extended ones
+ (labels ((find-it (schema)
+ (let ((message (or (find type (proto-extenders schema) :key #'proto-class)
+ (find type (proto-messages schema) :key #'proto-class))))
+ (when message
+ (return-from find-message message))
+ (map () #'find-it (proto-imported-schemas schema)))))
+ (find-it schema)))
+
+(defmethod find-message ((schema protobuf-schema) (type class))
+ (find-message schema (class-name type)))
+
+(defmethod find-message ((schema protobuf-schema) (name string))
+ (labels ((find-it (schema)
+ (let ((message (or (find name (proto-extenders schema) :key #'proto-name :test #'string=)
+ (find name (proto-messages schema) :key #'proto-name :test #'string=))))
+ (when message
+ (return-from find-message message))
+ (map () #'find-it (proto-imported-schemas schema)))))
+ (find-it schema)))
(defgeneric find-enum (protobuf type)
(:documentation
"Given a protobuf schema or message and the name of an enum type,
- returns the protobuf enum corresponding to the type."))
-
-(defmethod find-enum ((protobuf protobuf) type)
- (or (find type (proto-enums protobuf) :key #'proto-class)
- (find type (proto-enums protobuf) :key #'proto-alias-for)
- (some #'(lambda (msg) (find-enum msg type)) (proto-messages protobuf))))
-
-(defmethod find-enum ((protobuf protobuf) (type string))
- (or (find type (proto-enums protobuf) :key #'proto-name :test #'string=)
- (some #'(lambda (msg) (find-enum msg type)) (proto-messages protobuf))))
-
-
-;;--- For now, we support only the built-in options
-;;--- We will want to extend this to customizable options as well
+ returns the Protobufs enum corresponding to the type."))
+
+(defmethod find-enum ((schema protobuf-schema) type)
+ (labels ((find-it (schema)
+ (let ((enum (find type (proto-enums schema) :key #'proto-class)))
+ (when enum
+ (return-from find-enum enum))
+ (map () #'find-it (proto-imported-schemas schema)))))
+ (find-it schema)))
+
+(defmethod find-enum ((schema protobuf-schema) (name string))
+ (labels ((find-it (schema)
+ (let ((enum (find name (proto-enums schema) :key #'proto-name :test #'string=)))
+ (when enum
+ (return-from find-enum enum))
+ (map () #'find-it (proto-imported-schemas schema)))))
+ (find-it schema)))
+
+
+;; We accept and store any option, but only act on a few: default, packed,
+;; optimize_for, lisp_package, lisp_name, lisp_alias
(defclass protobuf-option (abstract-protobuf)
((name :type string ;the key
:reader proto-name
:initarg :name)
- (value :type (or null string) ;the value
- :accessor proto-value
+ (value :accessor proto-value ;the (untyped) value
:initarg :value
- :initform nil))
+ :initform nil)
+ (type :type (or null symbol) ;(optional) Lisp type,
+ :reader proto-type ; one of string, integer, sybol (for now)
+ :initarg :type
+ :initform 'string))
(:documentation
"The model class that represents a Protobufs options, i.e., a keyword/value pair."))
+(defmethod make-load-form ((o protobuf-option) &optional environment)
+ (make-load-form-saving-slots o :environment environment))
+
(defmethod print-object ((o protobuf-option) stream)
- (print-unprintable-object (o stream :type t :identity t)
+ (print-unreadable-object (o stream :type t :identity t)
(format stream "~A~@[ = ~S~]" (proto-name o) (proto-value o))))
-(defun cl-user::protobuf-option (stream option colon-p atsign-p)
- (cond (colon-p ;~:/protobuf-option/ -- .proto format
- (format stream "~A~@[ = ~S~]" (proto-name option) (proto-value option)))
- (atsign-p ;~@/protobuf-option/ -- .lisp format
- (format stream "~S ~S" (proto-name option) (proto-value option)))
- (t ;~/protobuf-option/ -- keyword/value format
- (format stream "~(:~A~) ~S" (proto-name option) (proto-value option)))))
+(defgeneric find-option (protobuf name)
+ (:documentation
+ "Given a protobuf schema, message, enum, etc and the name of an option,
+ returns the value of the option and its (Lisp) type."))
(defmethod find-option ((protobuf base-protobuf) (name string))
- (let ((option (find name (proto-options protobuf) :key #'proto-name :test #'string=)))
- (and option (proto-value option))))
+ (let ((option (find name (proto-options protobuf) :key #'proto-name :test #'option-name=)))
+ (and option
+ (values (proto-value option) (proto-type option)))))
(defmethod find-option ((options list) (name string))
- (let ((option (find name options :key #'proto-name :test #'string=)))
- (and option (proto-value option))))
+ (let ((option (find name options :key #'proto-name :test #'option-name=)))
+ (and option
+ (values (proto-value option) (proto-type option)))))
+
+(defgeneric remove-option (protobuf names)
+ (:documentation
+ "Given a protobuf schema, message, enum, etc and a set of option names,
+ remove all of those options from the set of options."))
+
+(defmethod remove-options ((protobuf base-protobuf) &rest names)
+ (dolist (name names)
+ (let ((option (find name (proto-options protobuf) :key #'proto-name :test #'option-name=)))
+ (when option
+ ;; This side-effects 'proto-options'
+ (setf (proto-options protobuf) (remove option (proto-options protobuf)))))))
+
+(defmethod remove-options ((options list) &rest names)
+ (dolist (name names)
+ (let ((option (find name options :key #'proto-name :test #'option-name=)))
+ (when option
+ ;; This does not side-effect the list of options
+ (remove option options)))))
+
+(defun option-name= (name1 name2)
+ (let* ((name1 (string name1))
+ (name2 (string name2))
+ (start1 (if (eql (char name1 0) #\() 1 0))
+ (start2 (if (eql (char name2 0) #\() 1 0))
+ (end1 (if (eql (char name1 0) #\() (- (length name1) 1) (length name1)))
+ (end2 (if (eql (char name2 0) #\() (- (length name2) 1) (length name2))))
+ (string= name1 name2 :start1 start1 :end1 end1 :start2 start2 :end2 end2)))
;; A protobuf enumeration
(:documentation
"The model class that represents a Protobufs enumeration type."))
+(defmethod make-load-form ((e protobuf-enum) &optional environment)
+ (make-load-form-saving-slots e :environment environment))
+
(defmethod print-object ((e protobuf-enum) stream)
- (print-unprintable-object (e stream :type t :identity t)
- (format stream "~A~@[ (~S)~]"
- (proto-name e) (or (proto-alias-for e) (proto-class e)))))
+ (print-unreadable-object (e stream :type t :identity t)
+ (format stream "~S~@[ (alias for ~S)~]"
+ (proto-class e) (proto-alias-for e))))
;; A protobuf value within an enumeration
(:documentation
"The model class that represents a Protobufs enumeration value."))
+(defmethod make-load-form ((v protobuf-enum-value) &optional environment)
+ (make-load-form-saving-slots v :environment environment))
+
(defmethod print-object ((v protobuf-enum-value) stream)
- (print-unprintable-object (v stream :type t :identity t)
- (format stream "~A = ~D~@[ (~S)~]"
- (proto-name v) (proto-index v) (proto-value v))))
+ (print-unreadable-object (v stream :type t :identity t)
+ (format stream "~A = ~D"
+ (proto-name v) (proto-index v))))
;; A protobuf message
(defclass protobuf-message (base-protobuf)
- ((conc :type (or null string) ;the conc-name used for Lisp accessors
+ ((parent :type (or protobuf-schema protobuf-message)
+ :accessor proto-parent
+ :initarg :parent)
+ (conc :type (or null string) ;the conc-name used for Lisp accessors
:accessor proto-conc-name
:initarg :conc-name
:initform nil)
:accessor proto-enums
:initarg :enums
:initform ())
- (messages :type (list-of protobuf-message) ;the embedded messages
+ (messages :type (list-of protobuf-message) ;all the messages embedded in this one
:accessor proto-messages
:initarg :messages
:initform ())
- (fields :type (list-of protobuf-field) ;the fields
- :accessor proto-fields
+ (extenders :type (list-of protobuf-message) ;the 'extend' messages embedded in this one
+ :accessor proto-extenders ;these precede unextended messages in 'find-message'
+ :initarg :extenders
+ :initform ())
+ (fields :type (list-of protobuf-field) ;all the fields of this message
+ :accessor proto-fields ;this includes local ones and extended ones
:initarg :fields
:initform ())
- (extensions :type (list-of protobuf-extension) ;any extensions
+ (extended-fields :type (list-of protobuf-field) ;the extended fields defined in this message
+ :accessor proto-extended-fields
+ :initform ())
+ (extensions :type (list-of protobuf-extension) ;any extension ranges
:accessor proto-extensions
:initarg :extensions
- :initform ()))
+ :initform ())
+ ;; :message is an ordinary message
+ ;; :group is a (deprecated) group (kind of an "implicit" message)
+ ;; :extends is an 'extends' to an existing message
+ (message-type :type (member :message :group :extends)
+ :accessor proto-message-type
+ :initarg :message-type
+ :initform :message))
(:documentation
"The model class that represents a Protobufs message."))
+(defmethod make-load-form ((m protobuf-message) &optional environment)
+ (with-slots (class name message-type) m
+ (multiple-value-bind (constructor initializer)
+ (make-load-form-saving-slots m :environment environment)
+ (values (if (eq message-type :extends)
+ constructor
+ `(let ((m ,constructor))
+ (record-protobuf m ',class ',name ',message-type)
+ m))
+ initializer))))
+
+(defmethod record-protobuf ((message protobuf-message) &optional class name type)
+ ;; No need to record an extension, it's already been recorded
+ (let ((class (or class (proto-class message)))
+ (name (or name (proto-name message)))
+ (type (or type (proto-message-type message))))
+ (unless (eq type :extends)
+ (when class
+ (setf (gethash class *all-messages*) message))
+ (when name
+ (setf (gethash name *all-messages*) message)))))
+
(defmethod print-object ((m protobuf-message) stream)
- (print-unprintable-object (m stream :type t :identity t)
- (format stream "~A~@[ (~S)~]"
- (proto-name m) (or (proto-alias-for m) (proto-class m)))))
+ (print-unreadable-object (m stream :type t :identity t)
+ (format stream "~S~@[ (alias for ~S)~]~@[ (group~*)~]~@[ (extended~*)~]"
+ (proto-class m) (proto-alias-for m)
+ (eq (proto-message-type m) :group)
+ (eq (proto-message-type m) :extends))))
(defmethod find-message ((message protobuf-message) (type symbol))
- (or (find type (proto-messages message) :key #'proto-class)
- (find type (proto-messages message) :key #'proto-alias-for)))
+ ;; Extended messages "shadow" non-extended ones
+ (or (find type (proto-extenders message) :key #'proto-class)
+ (find type (proto-messages message) :key #'proto-class)
+ (find-message (proto-parent message) type)))
(defmethod find-message ((message protobuf-message) (type class))
(find-message message (class-name type)))
-(defmethod find-message ((message protobuf-message) (type string))
- (find type (proto-messages message) :key #'proto-name :test #'string=))
+(defmethod find-message ((message protobuf-message) (name string))
+ (or (find name (proto-extenders message) :key #'proto-name :test #'string=)
+ (find name (proto-messages message) :key #'proto-name :test #'string=)
+ (find-message (proto-parent message) name)))
(defmethod find-enum ((message protobuf-message) type)
(or (find type (proto-enums message) :key #'proto-class)
- (find type (proto-enums message) :key #'proto-alias-for)))
+ (find-enum (proto-parent message) type)))
-(defmethod find-enum ((message protobuf-message) (type string))
- (find type (proto-enums message) :key #'proto-name :test #'string=))
+(defmethod find-enum ((message protobuf-message) (name string))
+ (or (find name (proto-enums message) :key #'proto-name :test #'string=)
+ (find-enum (proto-parent message) name)))
+
+(defgeneric find-field (message name)
+ (:documentation
+ "Given a protobuf message and a slot name or field name,
+ returns the Protobufs field having that name."))
+
+(defmethod find-field ((message protobuf-message) (name symbol))
+ (find name (proto-fields message) :key #'proto-value))
+
+(defmethod find-field ((message protobuf-message) (name string))
+ (find name (proto-fields message) :key #'proto-name :test #'string=))
+
+;; Extensions protocol
+(defgeneric get-extension (object slot)
+ (:documentation
+ "Returns the value of the extended slot 'slot' in 'object'"))
+
+(defgeneric set-extension (object slot value)
+ (:documentation
+ "Sets the value of the extended slot 'slot' to 'value' in 'object'"))
+
+(defgeneric has-extension (object slot)
+ (:documentation
+ "Returns true iff the there is an extended slot named 'slot' in 'object'")
+ ;; The only default method is for 'has-extension'
+ ;; It's an error to call the other three functions on a non-extendable object
+ (:method ((object standard-object) slot)
+ (declare (ignore slot))
+ nil))
+
+(defgeneric clear-extension (object slot)
+ (:documentation
+ "Clears the value of the extended slot 'slot' from 'object'"))
;; A protobuf field within a message
-;;--- Support the 'deprecated' option (should serialization ignore such fields?)
+;;--- Support the 'deprecated' option (have serialization ignore such fields?)
(defclass protobuf-field (base-protobuf)
((type :type string ;the name of the Protobuf type for the field
:accessor proto-type
:accessor proto-index
:initarg :index)
(value :type (or null symbol) ;the Lisp slot holding the value within an object
- :accessor proto-value
+ :accessor proto-value ;this also serves as the Lisp field name
:initarg :value
:initform nil)
(reader :type (or null symbol) ;a reader that is used to access the value
:accessor proto-reader ;if it's supplied, it's used instead of 'value'
:initarg :reader
:initform nil)
- (default :type (or null string) ;default value, pulled out of the options
- :accessor proto-default
+ (writer :type (or null symbol list) ;a writer that is used to set the value
+ :accessor proto-writer ;when it's a list, it's something like '(setf title)'
+ :initarg :writer
+ :initform nil)
+ (default :accessor proto-default ;default value (untyped), pulled out of the options
:initarg :default
:initform nil)
(packed :type (member t nil) ;packed, pulled out of the options
:accessor proto-packed
:initarg :packed
- :initform nil))
+ :initform nil)
+ ;; Copied from 'proto-message-type' of the field
+ (message-type :type (member :message :group :extends)
+ :accessor proto-message-type
+ :initarg :message-type
+ :initform :message))
(:documentation
"The model class that represents one field within a Protobufs message."))
(assert (not (<= 19000 (proto-index field) 19999)) ()
"Protobuf field indexes between 19000 and 19999 are not allowed")))
+(defmethod make-load-form ((f protobuf-field) &optional environment)
+ (make-load-form-saving-slots f :environment environment))
+
(defmethod print-object ((f protobuf-field) stream)
- (print-unprintable-object (f stream :type t :identity t)
- (format stream "~A ~A~:[~*~*~; (~S~@[ :: ~S~])~] = ~D"
- (proto-type f) (proto-name f)
- (or (proto-value f) (proto-class f)) (proto-value f) (proto-class f)
- (proto-index f))))
+ (print-unreadable-object (f stream :type t :identity t)
+ (format stream "~S :: ~S = ~D~@[ (group~*)~]~@[ (extended~*)~]"
+ (proto-value f) (proto-class f) (proto-index f)
+ (eq (proto-message-type f) :group)
+ (eq (proto-message-type f) :extends))))
-;; An extension within a message
-;;---*** We need to support 'extends', which depends on supporting 'import'
+;; An extension range within a message
(defclass protobuf-extension (abstract-protobuf)
((from :type (integer 1 #.(1- (ash 1 29))) ;the index number for this field
:accessor proto-extension-from
:accessor proto-extension-to
:initarg :to))
(:documentation
- "The model class that represents an extension with a Protobufs message."))
+ "The model class that represents an extension range within a Protobufs message."))
+
+(defmethod make-load-form ((e protobuf-extension) &optional environment)
+ (make-load-form-saving-slots e :environment environment))
(defmethod print-object ((e protobuf-extension) stream)
- (print-unprintable-object (e stream :type t :identity t)
+ (print-unreadable-object (e stream :type t :identity t)
(format stream "~D - ~D"
(proto-extension-from e) (proto-extension-from e))))
;; A protobuf service
(defclass protobuf-service (base-protobuf)
- ((rpcs :type (list-of protobuf-rpc) ;the RPCs in the service
- :accessor proto-rpcs
- :initarg :rpcs
- :initform ()))
+ ((methods :type (list-of protobuf-method) ;the methods in the service
+ :accessor proto-methods
+ :initarg :methods
+ :initform ()))
(:documentation
"The model class that represents a Protobufs service."))
+(defmethod make-load-form ((s protobuf-service) &optional environment)
+ (make-load-form-saving-slots s :environment environment))
+
(defmethod print-object ((s protobuf-service) stream)
- (print-unprintable-object (s stream :type t :identity t)
+ (print-unreadable-object (s stream :type t :identity t)
(format stream "~A"
(proto-name s))))
-;; A protobuf RPC within a service
-(defclass protobuf-rpc (base-protobuf)
- ((itype :type (or null string) ;the name of the input message type
- :accessor proto-input-type
- :initarg :input-type
- :initform nil)
- (iclass :type (or null symbol) ;the name of the input message Lisp class
- :accessor proto-input-class
- :initarg :input-class
+;; A protobuf method within a service
+(defclass protobuf-method (base-protobuf)
+ ((itype :type (or null symbol) ;the Lisp type name of the input
+ :accessor proto-input-type
+ :initarg :input-type
:initform nil)
- (otype :type (or null string) ;the name of the output message type
- :accessor proto-output-type
- :initarg :output-type
+ (iname :type (or null string) ;the Protobufs name of the input
+ :accessor proto-input-name
+ :initarg :input-name
:initform nil)
- (oclass :type (or null symbol) ;the name of the output message Lisp class
- :accessor proto-output-class
- :initarg :output-class
- :initform nil))
+ (otype :type (or null symbol) ;the Lisp type name of the output
+ :accessor proto-output-type
+ :initarg :output-type
+ :initform nil)
+ (oname :type (or null string) ;the Protobufs name of the output
+ :accessor proto-output-name
+ :initarg :output-name
+ :initform nil))
(:documentation
- "The model class that represents one RPC with a Protobufs service."))
+ "The model class that represents one method with a Protobufs service."))
+
+(defmethod make-load-form ((m protobuf-method) &optional environment)
+ (make-load-form-saving-slots m :environment environment))
-(defmethod print-object ((r protobuf-rpc) stream)
- (print-unprintable-object (r stream :type t :identity t)
- (format stream "~A (~@[~A~]) => (~@[~A~])"
- (or (proto-function r) (proto-name r))
- (or (proto-input-class r) (proto-input-type r))
- (or (proto-output-class r) (proto-output-type r)))))
+(defmethod print-object ((m protobuf-method) stream)
+ (print-unreadable-object (m stream :type t :identity t)
+ (format stream "~S (~S) => (~S)"
+ (proto-function m) (proto-input-type m) (proto-output-type m))))
;; The 'class' slot really holds the name of the function,
;; so let's give it a better name
-(defmethod proto-function ((rpc protobuf-rpc))
- (proto-class rpc))
+(defmethod proto-function ((method protobuf-method))
+ (proto-class method))
-(defmethod (setf proto-function) (function (rpc protobuf-rpc))
- (setf (proto-function rpc) function))
+(defmethod (setf proto-function) (function (method protobuf-method))
+ (setf (proto-function method) function))
projects / cl-protobufs.git / blobdiff