Testing : precheckin --full --strict-errors
Reviewer: Fare (please)
JTB impact: No
Ops impact: No
Change to config : No
Change to XML schema : No
Change to DB schema : No
Change to transport (timeouts, headers) : No
Any change (or new use) of OAQs : No
Change to inter-component transactions : No
Depends on any other checkin / bug : No
Tests that will verify:
I extended the CL-Protobufs tests
Description:
Add support for a 'streams' type in Protobufs RPC methods.
- Add a few slots to 'protobufs-method'
- Add '&key streams' to the method arglists in 'define-service'
- Extend the parser to handle "streams" in addition to the
'streams_type' option
- Extend the printer
- Change a test to use a 'streams' type
- While we're in the neighborhood, allow an optional '=>'
between the input and output methods in 'define-service';
it makes it a bit more readable
- Update the documentation
git-svn-id: http://svn.internal.itasoftware.com/svn/ita/trunk/qres/lisp/libs/cl-protobufs@560147
f8382938-511b-0410-9cdd-
bb47b084005c
(color :type color))
(proto:define-service color-wheel ()
(get-color (get-color-request color)
- :options ("deadline" "1.0"))
+ :options (:deadline 1.0))
(add-color (add-color-request color)
- :options ("deadline" "1.0"))))
+ :options (:deadline 1.0))))
This will create the Protobufs model objects, Lisp classes and enum
types that correspond to the model. The .proto file of the same schema
service ColorWheel {
rpc GetColor (GetColorRequest) returns (Color) {
- option deadline = "1.0";
+ option deadline = 1.0;
}
rpc AddColor (AddColorRequest) returns (Color) {
- option deadline = "1.0";
+ option deadline = 1.0;
}
}
in the .proto file.
The body is a set of method specs of the form
-``(name (input-type output-type) &key options documentation)``.
-*name* is a symbol naming the RPC method. *input-type* and
-*output-type* may either be symbols or a list of the form ``(type &key name)``.
+``(name (input-type [=>] output-type &key streams) &key options documentation)``.
+
+For each method spec, *name* is a symbol naming the RPC method.
+*input-type* and *output-type* give the input and output types of the method;
+they may either be symbols or a list of the form ``(type &key name)``.
+You can optionally include the symbol ``=>`` between the input and
+output types; this seems to improve readability.
+
+*streams* is also the name of a type, and provides a hook to RPC
+implementations that implement "streaming".
``proto:define-service`` can only be used within ``proto:define-schema``.
'name' can be used to override the defaultly generated Protobufs service name.
'options' is a set of keyword/value pairs, both of which are strings.
- The body is a set of method specs of the form (name (input-type output-type) &key options).
+ The body is a set of method specs of the form (name (input-type [=>] output-type) &key options).
'input-type' and 'output-type' may also be of the form (type &key name)."
(let* ((name (or name (class-name->proto type)))
(options (loop for (key val) on options by #'cddr
(index 0))
(with-collectors ((forms collect-form))
(dolist (method method-specs)
- (destructuring-bind (function (input-type output-type)
+ (destructuring-bind (function (&rest types)
&key name options documentation source-location) method
- (let* ((input-name (and (listp input-type)
+ (let* ((input-type (first types))
+ (output-type (if (string= (string (second types)) "=>") (third types) (second types)))
+ (streams-type (if (string= (string (second types)) "=>")
+ (getf (cdddr types) :streams)
+ (getf (cddr types) :streams)))
+ (input-name (and (listp input-type)
(getf (cdr input-type) :name)))
(input-type (if (listp input-type) (car input-type) input-type))
(output-name (and (listp output-type)
(getf (cdr output-type) :name)))
(output-type (if (listp output-type) (car output-type) output-type))
+ (streams-name (and (listp streams-type)
+ (getf (cdr streams-type) :name)))
+ (streams-type (if (listp streams-type) (car streams-type) streams-type))
(options (loop for (key val) on options by #'cddr
collect (make-instance 'protobuf-option
:name (if (symbolp key) (slot-name->proto key) key)
:input-name (or input-name (class-name->proto input-type))
:output-type output-type
:output-name (or output-name (class-name->proto output-type))
+ :streams-type streams-type
+ :streams-name (and streams-type
+ (or streams-name (class-name->proto streams-type)))
:index (iincf index)
:options options
:documentation documentation
(defgeneric ensure-method (trace service method)
(:method (trace service (method protobuf-method))
(ensure-type trace service method (proto-input-type method))
- (ensure-type trace service method (proto-output-type method))))
+ (ensure-type trace service method (proto-output-type method))
+ (ensure-type trace service method (proto-streams-type method))))
;; 'message' and 'field' can be a message and a field or a service and a method
(defun ensure-type (trace message field type)
(wheel :type color-wheel)
(color :type color))
(proto:define-service color-wheel ()
- (get-color (get-color-request color)
- :options ("deadline" 1.0)
+ (get-color (get-color-request => color)
+ :options (:deadline 1.0)
:documentation "Look up a color by name")
- (add-color (add-color-request color)
- :options ("deadline" 1.0)
+ (add-color (add-color-request => color)
+ :options (:deadline 1.0)
:documentation "Add a new color to the wheel")))
(proto:write-schema *color-wheel*)
:initarg :value
:initform nil)
(type :type (or null symbol) ;(optional) Lisp type,
- :reader proto-type ; one of string, integer, sybol (for now)
+ :reader proto-type ; one of string, integer, float, symbol (for now)
:initarg :type
:initform 'string))
(:documentation
:accessor proto-output-name
:initarg :output-name
:initform nil)
+ (stype :type (or symbol null) ;the Lisp type name of the "streams" type
+ :accessor proto-streams-type
+ :initarg :streams-type
+ :initform nil)
+ (sname :type (or null string) ;the Protobufs name of the "streams" type
+ :accessor proto-streams-name
+ :initarg :streams-name
+ :initform nil)
(index :type (unsigned-byte 32) ;an identifying index for this method
:accessor proto-index ; (used by the RPC implementation)
:initarg :index))
(in (prog2 (expect-char stream #\( () "service")
(parse-token stream)
(expect-char stream #\) () "service")))
- (ret (parse-token stream))
+ (ret (parse-token stream)) ;should be "=>"
(out (prog2 (expect-char stream #\( () "service")
(parse-token stream)
(expect-char stream #\) () "service")))
+ (strm (parse-token stream)) ;might be "streams"
+ (strm (and strm (string= strm "streams")
+ (prog2 (expect-char stream #\( () "service")
+ (parse-token stream)
+ (expect-char stream #\) () "service"))))
(opts (let ((opts (parse-proto-method-options stream)))
(when (or (null opts) (eql (peek-char nil stream nil) #\;))
(expect-char stream #\; () "service"))
:input-name in
:output-type (proto->class-name out *protobuf-package*)
:output-name out
+ :streams-type (and strm (proto->class-name strm *protobuf-package*))
+ :streams-name strm
:index index
:options opts
:source-location (make-source-location stream loc (i+ loc (length name))))))
+ (assert (string= ret "returns") ()
+ "Syntax error in 'message' at position ~D" (file-position stream))
(let* ((name (find-option method "lisp_name"))
(stub (or (and name (make-lisp-symbol name))
stub)))
(setf (proto-class method) stub
(proto-client-stub method) stub
(proto-server-stub method) (intern (format nil "~A-~A" 'do stub) *protobuf-package*)))
- (assert (string= ret "returns") ()
- "Syntax error in 'message' at position ~D" (file-position stream))
(setf (proto-methods service) (nconc (proto-methods service) (list method)))
method))
"PROTO-SERVICES"
"PROTO-SLOT"
"PROTO-SOURCE-LOCATION"
+ "PROTO-STREAMS-NAME"
+ "PROTO-STREAMS-TYPE"
"PROTO-SYNTAX"
"PROTO-TYPE"
"PROTO-VALUE"
("deprecated" symbol)
("optimize_for" symbol)
("packed" boolean)
+ ("protocol" symbol)
("stream_type" string)
;; Keep the rest of these in alphabetical order
("cc_api_version" integer)
((boolean) "~A~@[ = ~(~A~)~]")
(otherwise "~A~@[ = ~S~]"))))))
(format stream fmt-control (proto-name option) (proto-value option))))
- (atsign-p ;~@/protobuf-option/ -- .lisp format
+ (atsign-p ;~@/protobuf-option/ -- string/value format
(let ((fmt-control (if (eq type 'symbol) "~(~S~) ~A" "~(~S~) ~S")))
(format stream fmt-control (proto-name option) (proto-value option))))
(t ;~/protobuf-option/ -- keyword/value format
&key (indentation 0) more)
(declare (ignore more))
(with-prefixed-accessors
- (name documentation input-name output-name options) (proto- method)
+ (name documentation input-name output-name streams-name options) (proto- method)
(let* ((imsg (find-message *protobuf* input-name))
(omsg (find-message *protobuf* output-name))
+ (smsg (find-message *protobuf* streams-name))
(iname (maybe-qualified-name imsg))
- (oname (maybe-qualified-name omsg)))
+ (oname (maybe-qualified-name omsg))
+ (sname (maybe-qualified-name smsg)))
(when documentation
(write-schema-documentation type documentation stream :indentation indentation))
- (format stream "~&~@[~VT~]rpc ~A (~@[~A~])~@[ returns (~A)~]"
+ (format stream "~&~@[~VT~]rpc ~A (~@[~A~])~@[ streams (~A)~]~@[ returns (~A)~]"
(and (not (zerop indentation)) indentation)
- name iname oname)
+ name iname sname oname)
(cond (options
(format stream " {~%")
(dolist (option options)
(terpri stream))
(setq spaces " "))
(when options
- (format stream "~A:options (~{~@/protobuf-option/~^ ~})" spaces options)
+ (format stream "~A:options (~{~/protobuf-option/~^ ~})" spaces options)
(when documentation
(terpri stream))
(setq spaces " "))
;; Keyword class means a primitive type, print default with ~S
"~&~@[~VT~](~A :type ~(~S~)~:[~*~; :default ~S~]~
~@[ :reader ~(~S~)~]~@[ :writer ~(~S~)~]~@[ :packed ~(~S~)~]~
- ~@[ :options (~{~@/protobuf-option/~^ ~})~])~
+ ~@[ :options (~{~/protobuf-option/~^ ~})~])~
~:[~*~*~;~VT; ~A~]"
;; Non-keyword class means an enum type, print default with ~(~S~)
"~&~@[~VT~](~A :type ~(~S~)~:[~*~; :default ~(~S~)~]~
~@[ :reader ~(~S~)~]~@[ :writer ~(~S~)~]~@[ :packed ~(~S~)~]~
- ~@[ :options (~{~@/protobuf-option/~^ ~})~])~
+ ~@[ :options (~{~/protobuf-option/~^ ~})~])~
~:[~*~*~;~VT; ~A~]")
(and (not (zerop indentation)) indentation)
slot-name type defaultp default reader writer packed options
(defmethod write-schema-as ((type (eql :lisp)) (method protobuf-method) stream
&key (indentation 0) more)
(declare (ignore more))
- (with-prefixed-accessors (class input-type output-type options
+ (with-prefixed-accessors (class input-type output-type streams-type options
documentation source-location) (proto- method)
(when documentation
(write-schema-documentation type documentation stream :indentation indentation))
- (format stream "~&~@[~VT~](~(~S~) (~(~S~) ~(~S~))"
+ (format stream "~&~@[~VT~](~(~S~) (~(~S~) => ~(~S~)~@[ :streams ~(~S~)~])"
(and (not (zerop indentation)) indentation)
- class input-type output-type)
+ class input-type output-type streams-type)
(when options
- (format stream "~%~VT:options (~{~@/protobuf-option/~^ ~})"
+ (format stream "~%~VT:options (~{~/protobuf-option/~^ ~})"
(+ indentation 2) options))
(format stream ")")))
(proto:define-message buy-car-response ()
(price :type (or null uint32)))
(proto:define-service buy-car ()
- (buy-car (buy-car-request buy-car-response)
+ (buy-car (buy-car-request => buy-car-response)
:options (:deadline 1.0))))
(define-test extension-serialization ()
(wheel :type stable-color-wheel)
(color :type stable-color))
(proto:define-service stable-color-wheel ()
- (get-stable-color (string stable-color))
- (set-stable-color (stable-color stable-color)
+ (get-stable-color (string => stable-color))
+ (set-stable-color (stable-color => stable-color)
:options (:deadline 1.0))))
(defvar *color-wheel-proto*
projects / cl-protobufs.git / commitdiff