From 587fa704f9763f3f6310d74880af0600427e4a67 Mon Sep 17 00:00:00 2001 From: Scott McKay Date: Fri, 9 Mar 2012 22:25:01 +0000 Subject: [PATCH] Simplify some things to make development using Protobufs easier git-svn-id: http://svn.internal.itasoftware.com/svn/ita/branches/qres/swm/borgify-1/qres/lisp/quux/protobufs@533338 f8382938-511b-0410-9cdd-bb47b084005c --- define-proto.lisp | 29 +++++++++++++++++----------- examples.lisp | 47 +++++++++++++++++++++++++++++++++++++++++----- model-classes.lisp | 4 ++++ proto-pkgdcl.lisp | 1 + 4 files changed, 65 insertions(+), 16 deletions(-) diff --git a/define-proto.lisp b/define-proto.lisp index fd061bf..0ad110f 100644 --- a/define-proto.lisp +++ b/define-proto.lisp @@ -49,23 +49,30 @@ ((define-service) (collect-svc model))))) ;;--- This should warn if the old one isn't upgradable to the new one - (let ((sname (fintern "*~A*" name)) + (let ((vname (fintern "*~A*" name)) + (pname (or proto-name (proto-class-name name))) + (cname name) (options (loop for (key val) on options by #'cddr collect `(make-instance 'protobuf-option :name ,key :value ,val)))) `(progn ,@forms - (defvar ,sname (make-instance 'protobuf - :name ,(or proto-name (proto-class-name name)) - :class ',name - :package ,(if (stringp package) package (string-downcase (string package))) - :imports ',(if (listp import) import (list import)) - :syntax ,syntax - :options (list ,@options) - :enums (list ,@enums) - :messages (list ,@msgs) - :services (list ,@svcs))))))) + (defvar ,vname nil) + (let ((protobuf (make-instance 'protobuf + :name ',pname + :class ',cname + :package ,(if (stringp package) package (string-downcase (string package))) + :imports ',(if (listp import) import (list import)) + :syntax ,syntax + :options (list ,@options) + :enums (list ,@enums) + :messages (list ,@msgs) + :services (list ,@svcs)))) + (setq ,vname protobuf) + (setf (gethash ',pname *all-protobufs*) protobuf) + (setf (gethash ',cname *all-protobufs*) protobuf) + protobuf))))) ;; Define an enum type named 'name' and a Lisp 'deftype' (defmacro define-enum (name (&key proto-name conc-name) &body values) diff --git a/examples.lisp b/examples.lisp index 5e8aca3..44d1778 100644 --- a/examples.lisp +++ b/examples.lisp @@ -13,6 +13,8 @@ ;;; Examples, for manual testing +;;--- Turn these into a test suite + #|| (setq cschema (proto:write-protobuf-schema-for-classes '(qres-core::legacy-pnr @@ -29,9 +31,10 @@ #|| (setq pschema (proto:write-protobuf-schema-for-classes - '(proto:protobuf - proto:protobuf-message proto:protobuf-field - proto:protobuf-enum proto:protobuf-enum-value))) + '(proto:protobuf proto:protobuf-option + proto:protobuf-enum proto:protobuf-enum-value + proto:protobuf-message proto:protobuf-field proto:protobuf-extension + proto:protobuf-service proto:protobuf-rpc))) (setq pser (proto:serialize-object-to-stream pschema pschema :stream nil)) (describe (proto:deserialize-object 'proto:protobuf pschema pser 0)) @@ -178,7 +181,9 @@ (make-instance 'proto:protobuf-rpc :name "SetColor" :input-type "Color" - :output-type "Color"))) + :output-type "Color" + :options (list (make-instance 'protobuf-option + :name "deadline" :value "1.0"))))) (svcs (list (make-instance 'proto:protobuf-service :name "ColorWheel" :rpcs rpcs))) @@ -193,7 +198,6 @@ ||# #|| -(makunbound '*color-wheel*) (proto:define-proto color-wheel (:package ita.color :import "descriptor.proto") (proto:define-enum color-name () @@ -291,3 +295,36 @@ (proto:print-text-format clr *color-wheel*) (proto:print-text-format (proto:deserialize-object 'color *color-wheel* cser 0) *color-wheel*) ||# + +#|| +(proto:define-proto read-air-reservation (:package qres-core) + (proto:define-message air-reservation-spec () + (locator :type (list-of pnr-locator)) + (customer :type (or null string)) + (contract-group-id :type (or null integer)) + (last-name :type (or null string)) + (first-name :type (or null string)) + (phone-number :type (or null string)) + (email-address :type (or null string)) + (cc-number :type (or null string)) + (ticket-number :type (or null string)) + (ff-account :type (or null ff-account)) + (flights :type (list-of flight-spec))) + (proto:define-message pnr-locator () + (system :type string) + (locator :type string)) + (proto:define-message ff-account () + (carrier :type string) + (number :type string)) + (proto:define-message flight-spec () + (carrier :type string) + (flight-number :type integer) + (suffix :type (or null string)) + (date :type string) + (origin :type (or null string)) + (destination :type (or null string)))) + +(proto:write-protobuf *read-air-reservation*) +(proto:write-protobuf *read-air-reservation* :type :lisp) +||# + diff --git a/model-classes.lisp b/model-classes.lisp index afcd179..b1bae16 100644 --- a/model-classes.lisp +++ b/model-classes.lisp @@ -13,6 +13,10 @@ ;;; Protol buffers model classes +(defvar *all-protobufs* (make-hash-table :test #'equal)) +(defun find-protobuf (name) + (gethash name *all-protobufs*)) + ;; A few things (the pretty printer) want to keep track of the current schema (defvar *protobuf* nil) diff --git a/proto-pkgdcl.lisp b/proto-pkgdcl.lisp index 6de5c4f..6c74bc7 100644 --- a/proto-pkgdcl.lisp +++ b/proto-pkgdcl.lisp @@ -28,6 +28,7 @@ "PROTOBUF-EXTENSION" "PROTOBUF-SERVICE" "PROTOBUF-RPC" + "FIND-PROTOBUF" ;; Printing "WRITE-PROTOBUF" -- 2.45.2