;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
-;;; Confidential and proprietary information of ITA Software, Inc. ;;;
+;;; Free Software published under an MIT-like license. See LICENSE ;;;
;;; ;;;
-;;; Copyright (c) 2012 ITA Software, Inc. All rights reserved. ;;;
+;;; Copyright (c) 2012 Google, Inc. All rights reserved. ;;;
;;; ;;;
;;; Original author: Scott McKay ;;;
;;; ;;;
#||
;; A pretty useful subset of geographic business data
(defclass geodata ()
- ((countries :type (proto:list-of qres-core::country) :initform () :initarg :countries)
- (regions :type (proto:list-of qres-core::region) :initform () :initarg :regions)
- (cities :type (proto:list-of qres-core::city) :initform () :initarg :cities)
- (airports :type (proto:list-of qres-core::airport) :initform () :initarg :airports)))
-
-(setq bizd-schema (proto:generate-schema-for-classes
- '(qres-core::country
- qres-core::region
- qres-core::region-key
- qres-core::city
- qres-core::airport
- qres-core::timezone
- qres-core::tz-variation
- qres-core::currency
- qres-core::country-currencies
- qres-core::carrier
- geodata)
- :install t))
-
-(proto:write-schema bizd-schema)
-(proto:write-schema bizd-schema :type :lisp)
+ ;; This one stores the data in lists
+ ((countries :type (proto:list-of qres-core::country)
+ :initform ()
+ :initarg :countries)
+ (regions :type (proto:list-of qres-core::region)
+ :initform ()
+ :initarg :regions)
+ (cities :type (proto:list-of qres-core::city)
+ :initform ()
+ :initarg :cities)
+ (airports :type (proto:list-of qres-core::airport)
+ :initform ()
+ :initarg :airports)))
+
+(defclass geodata-v ()
+ ;; This one stores the data in vectors
+ ((countries :type (proto:vector-of qres-core::country)
+ :initform #()
+ :initarg :countries)
+ (regions :type (proto:vector-of qres-core::region)
+ :initform #()
+ :initarg :regions)
+ (cities :type (proto:vector-of qres-core::city)
+ :initform #()
+ :initarg :cities)
+ (airports :type (proto:vector-of qres-core::airport)
+ :initform #()
+ :initarg :airports)))
+
+(setq *geodata* (proto:generate-schema-for-classes
+ '(qres-core::country
+ qres-core::region
+ qres-core::region-key
+ qres-core::city
+ qres-core::airport
+ qres-core::timezone
+ qres-core::tz-variation
+ qres-core::currency
+ qres-core::country-currencies
+ qres-core::carrier
+ geodata geodata-v)
+ :install t))
+
+(proto:write-schema *geodata*)
+(proto:write-schema *geodata* :type :lisp)
;; Load the data
(let* ((countries (loop for v being the hash-values of (qres-core::country-business-data) collect (car v)))
:countries countries
:regions regions
:cities cities
- :airports airports)))
+ :airports airports)
+ geodata-v (make-instance 'geodata-v
+ :countries (make-array (length countries) :fill-pointer t :initial-contents countries)
+ :regions (make-array (length regions) :fill-pointer t :initial-contents regions)
+ :cities (make-array (length cities) :fill-pointer t :initial-contents cities)
+ :airports (make-array (length airports) :fill-pointer t :initial-contents airports))))
(dolist (class '(qres-core::country
qres-core::region
qres-core::currency
qres-core::country-currencies
qres-core::carrier
- geodata))
- (let ((message (proto-impl:find-message bizd-schema class)))
+ geodata geodata-v))
+ (let ((message (proto:find-message *geodata* class)))
(eval (proto-impl:generate-object-size message))
(eval (proto-impl:generate-serializer message))
(eval (proto-impl:generate-deserializer message))))
-(time (progn (setq gser (proto:serialize-object-to-stream geodata 'geodata :stream nil)) nil))
+(time (progn (setq gser (proto:serialize-object-to-bytes geodata 'geodata)) nil))
(time (proto:deserialize-object 'geodata gser))
-(equalp gser (proto:serialize-object-to-stream
- (proto:deserialize-object 'geodata gser)
- 'geodata :stream nil))
+(equalp gser (proto:serialize-object-to-bytes
+ (proto:deserialize-object 'geodata gser) 'geodata))
+
+(time (progn (setq gser-v (proto:serialize-object-to-bytes geodata-v 'geodata-v)) nil))
+(time (proto:deserialize-object 'geodata-v gser-v))
+
+(equalp gser-v (proto:serialize-object-to-bytes
+ (proto:deserialize-object 'geodata-v gser-v) 'geodata-v))
+
+(equalp gser gser-v)
||#
(cdr x))
(let ((list '("this" "is" "a" ("nested" "test"))))
- (proto:serialize-object-to-stream list 'typed-list :stream nil)
+ (proto:serialize-object-to-bytes list 'typed-list)
(proto:print-text-format list 'typed-list)
(proto:print-text-format list 'typed-list :suppress-line-breaks t)
(let ((text (with-output-to-string (s)
(proto:parse-text-format 'typed-list :stream s))))
(let ((list '((1 one) (2 two) (3 three))))
- (proto:serialize-object-to-stream list 'typed-list :stream nil)
+ (proto:serialize-object-to-bytes list 'typed-list)
(proto:print-text-format list 'typed-list)
(proto:print-text-format list 'typed-list :suppress-line-breaks t)
(let ((text (with-output-to-string (s)
(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*)
(setf (color-opacity color2) 50)
(progn
(format t "~2&Unextended (has-extension ~S)~%" (has-extension color1 'opacity))
- (let ((ser1 (proto:serialize-object-to-stream rqst1 'add-color-request :stream nil)))
+ (let ((ser1 (proto:serialize-object-to-bytes rqst1 'add-color-request)))
(print ser1)
(proto:print-text-format rqst1)
(proto:print-text-format (proto:deserialize-object 'add-color-request ser1))))
(progn
(format t "~2&Extended (has-extension ~S)~%" (has-extension color2 'opacity))
- (let ((ser2 (proto:serialize-object-to-stream rqst2 'add-color-request :stream nil)))
+ (let ((ser2 (proto:serialize-object-to-bytes rqst2 'add-color-request)))
(print ser2)
(proto:print-text-format rqst2)
(proto:print-text-format (proto:deserialize-object 'add-color-request ser2)))))
(:package color-wheel
;; :optimize :speed
:documentation "Color wheel example, with nested message")
+ (proto:define-type-alias date ()
+ :lisp-type integer
+ :proto-type string
+ :serializer integer-to-date
+ :deserializer date-to-integer)
(proto:define-message color-wheel1 ()
(proto:define-message metadata1 ()
(author :type (or null string))
(revision :type (or null string))
- (date :type (or null string)))
+ (date :type (or null date)))
(name :type string)
- (colors :type (list-of color1))
+ (colors :type (proto:list-of color1))
(metadata1 :type (or null metadata1)))
(proto:define-message color1 ()
(name :type (or null string))
(:package color-wheel
;; :optimize :speed
:documentation "Color wheel example, with group")
+ (proto:define-type-alias date ()
+ :lisp-type integer
+ :proto-type string
+ :serializer integer-to-date
+ :deserializer date-to-integer)
(proto:define-message color-wheel2 ()
(name :type string)
- (colors :type (list-of color2))
+ (colors :type (proto:list-of color2))
(proto:define-group metadata2
(:index 3
:arity :optional)
(author :type (or null string))
(revision :type (or null string))
- (date :type (or null string))))
+ (date :type (or null date))))
(proto:define-message color2 ()
(name :type (or null string))
(r-value :type integer)
(wheel :type color-wheel2)
(color :type color2)))
+(defun integer-to-date (date)
+ (with-output-to-string (s)
+ (quux:write-local-date (quux:get-local-time date) s :format :dd-mth-yyyy)))
+
+(defun date-to-integer (string)
+ (quux:parse-local-date string))
+
(proto:write-schema *color-wheel1*)
(proto:write-schema *color-wheel2*)
-(let* ((meta1 (make-instance 'metadata1 :revision "1.0"))
+(let* ((meta1 (make-instance 'metadata1 :revision "1.0" :date (date-to-integer "12-FEB-1958")))
(wheel1 (make-instance 'color-wheel1 :name "Colors" :metadata1 meta1))
(color1 (make-instance 'color1 :r-value 100 :g-value 0 :b-value 100))
(rqst1 (make-instance 'add-color1 :wheel wheel1 :color color1))
- (meta2 (make-instance 'metadata2 :revision "1.0"))
+ (meta2 (make-instance 'metadata2 :revision "1.0" :date (date-to-integer "12-FEB-1958")))
(wheel2 (make-instance 'color-wheel2 :name "Colors" :metadata2 meta2))
(color2 (make-instance 'color2 :r-value 100 :g-value 0 :b-value 100))
(rqst2 (make-instance 'add-color2 :wheel wheel2 :color color2)))
(progn
(format t "~2&Nested")
- (let ((ser1 (proto:serialize-object-to-stream rqst1 'add-color1 :stream nil)))
+ (let ((ser1 (proto:serialize-object-to-bytes rqst1 'add-color1)))
(print ser1)
(proto:print-text-format rqst1)
(proto:print-text-format (proto:deserialize-object 'add-color1 ser1))))
(progn
(format t "~2&Group")
- (let ((ser2 (proto:serialize-object-to-stream rqst2 'add-color2 :stream nil)))
+ (let ((ser2 (proto:serialize-object-to-bytes rqst2 'add-color2)))
(print ser2)
(proto:print-text-format rqst2)
(proto:print-text-format (proto:deserialize-object 'add-color2 ser2)))))
projects / cl-protobufs.git / blobdiff