]> asedeno.scripts.mit.edu Git - cl-protobufs.git/blobdiff - examples.lisp
Make (declare (values ...)) for rpc methods opt-in, rather than opt-out
[cl-protobufs.git] / examples.lisp
index 8067bf9edeb2a266e07a3e97c05824d721c07ddc..1ff8d53d117f5b303680a1a546f989b698ebb4e1 100644 (file)
 ;; A pretty useful subset of geographic business data
 (defclass geodata ()
   ;; 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)))
+  ((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)))
+  ((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::country-currencies
                  qres-core::carrier
                  geodata geodata-v))
-  (let ((message (proto-impl:find-message *geodata* class)))
+  (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-stream geodata-v 'geodata-v :stream nil)) nil))
+(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-stream
-                (proto:deserialize-object 'geodata-v gser-v)
-                'geodata-v :stream nil))
+(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 (proto:list-of color1))
     (metadata1 :type (or null metadata1)))
     (: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 (proto:list-of color2))
          :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)))))