examples.lisp

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;;                                                                  ;;;
   3 ;;; Confidential and proprietary information of ITA Software, Inc.   ;;;
   4 ;;;                                                                  ;;;
   5 ;;; Copyright (c) 2012 ITA Software, Inc.  All rights reserved.      ;;;
   6 ;;;                                                                  ;;;
   7 ;;; Original author: Scott McKay                                     ;;;
   8 ;;;                                                                  ;;;
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 (in-package "PROTO-IMPL")
  12
  13
  14 ;;; Examples, for manual testing
  15
  16 #||
  17 (setq cschema (proto:write-protobuf-schema-for-classes
  18                '(qres-core::legacy-pnr
  19                  qres-core::legacy-pnr-pax
  20                  qres-core::legacy-pnr-segment
  21                  qres-core::legacy-pnr-pax-segment)
  22                :slot-filter #'quake::quake-slot-filter
  23                :type-filter #'quake::quake-type-filter
  24                :enum-filter #'quake::quake-enum-filter
  25                :value-filter #'quake::quake-value-filter))
  26
  27 (proto:serialize-object-to-stream pnr cschema :stream nil)
  28 ||#
  29
  30 #||
  31 (setq pschema (proto:write-protobuf-schema-for-classes
  32                '(proto:protobuf
  33                  proto:protobuf-message proto:protobuf-field
  34                  proto:protobuf-enum proto:protobuf-enum-value)))
  35
  36 (setq pser (proto:serialize-object-to-stream pschema pschema :stream nil))
  37 (describe (proto:deserialize-object 'proto:protobuf pschema pser 0))
  38
  39 (proto:print-text-format pschema pschema)
  40 (proto:print-text-format (proto:deserialize-object 'proto:protobuf pschema pser 0) pschema)
  41 ||#
  42
  43 #||
  44 (defclass proto-test1 ()
  45   ((intval :type (integer -2147483648 +2147483647)
  46            :initarg :intval)))
  47
  48 (defclass proto-test2 ()
  49   ((intval :type (or null (integer -2147483648 +2147483647))
  50            :initarg :intval)
  51    (strval :type string
  52            :initarg :strval)))
  53
  54 (defclass proto-test3 ()
  55   ((intval :type (or null (integer -2147483648 +2147483647))
  56            :initarg :intval)
  57    (strval :type (or null string)
  58            :initarg :strval)
  59    (recval :type proto-test1
  60            :initarg :recval)))
  61
  62 (defclass proto-test4 ()
  63   ((intval :type (or null (integer -2147483648 +2147483647))
  64            :initarg :intval)
  65    (strval :type (or null string)
  66            :initarg :strval)
  67    (recval :type proto-test2
  68            :initarg :recval)))
  69
  70 (defclass proto-test5 ()
  71   ((color   :type (member :red :green :blue)
  72             :initarg :color)
  73    (intvals :type (list-of integer)
  74             :initform ()
  75             :initarg :intvals)
  76    (strvals :type (list-of string)
  77             :initform ()
  78             :initarg :strvals)))
  79
  80 (setq tschema (proto:write-protobuf-schema-for-classes
  81                '(proto-test1 proto-test2 proto-test3 proto-test4 proto-test5)))
  82
  83 (setq test1 (make-instance 'proto-test1 :intval 150))
  84 (setq test2 (make-instance 'proto-test2 :strval "testing"))
  85 (setq test3 (make-instance 'proto-test3 :recval test1))
  86 (setq test4 (make-instance 'proto-test4 :recval test2))
  87 (setq test5 (make-instance 'proto-test5 :color :red :intvals '(2 3 5 7) :strvals '("two" "three" "five" "seven")))
  88
  89 (setq tser1 (proto:serialize-object-to-stream test1 tschema :stream nil))
  90 (equalp tser1 #(#x08 #x96 #x01))
  91 (describe (proto:deserialize-object 'proto-test1 tschema tser1 0))
  92
  93 (setq tser2 (proto:serialize-object-to-stream test2 tschema :stream nil))
  94 (equalp tser2 #(#x12 #x07 #x74 #x65 #x73 #x74 #x69 #x6E #x67))
  95 (describe (proto:deserialize-object 'proto-test2 tschema tser2 0))
  96
  97 (setq tser3 (proto:serialize-object-to-stream test3 tschema :stream nil))
  98 (equalp tser3 #(#x1A #x03 #x08 #x96 #x01))
  99 (describe (proto:deserialize-object 'proto-test3 tschema tser3 0))
 100 (describe (slot-value (proto:deserialize-object 'proto-test3 tschema tser3 0) 'recval))
 101
 102 (setq tser4 (proto:serialize-object-to-stream test4 tschema :stream nil))
 103 (equalp tser4 #(#x1A #x09 #x12 #x07 #x74 #x65 #x73 #x74 #x69 #x6E #x67))
 104 (describe (proto:deserialize-object 'proto-test4 tschema tser4 0))
 105 (describe (slot-value (proto:deserialize-object 'proto-test4 tschema tser4 0) 'recval))
 106
 107 (setq tser5 (proto:serialize-object-to-stream test5 tschema :stream nil))
 108 (equalp tser5 #(#x08 #x01
 109                 #x10 #x04 #x02 #x03 #x05 #x07
 110                 #x1A #x03 #x74 #x77 #x6F #x1A #x05 #x74 #x68 #x72 #x65 #x65 #x1A #x04 #x66 #x69 #x76 #x65 #x1A #x05 #x73 #x65 #x76 #x65 #x6E))
 111 (describe (proto:deserialize-object 'proto-test5 tschema tser5 0))
 112
 113 (equalp (mapcar #'proto-impl:zig-zag-encode32
 114                 '(0 -1 1 -2 2 -2147483648 2147483647))
 115         '(0 1 2 3 4 4294967295 4294967294))
 116 (equalp (mapcar #'proto-impl:zig-zag-encode64
 117                 '(0 -1 1 -2 2 -2147483648 2147483647 -1152921504606846976 1152921504606846975))
 118         '(0 1 2 3 4 4294967295 4294967294 2305843009213693951 2305843009213693950))
 119
 120 (proto:print-text-format test1 tschema)
 121 (proto:print-text-format (proto:deserialize-object 'proto-test1 tschema tser1 0) tschema)
 122
 123 (proto:print-text-format test2 tschema)
 124 (proto:print-text-format (proto:deserialize-object 'proto-test2 tschema tser2 0) tschema)
 125
 126 (proto:print-text-format test3 tschema)
 127 (proto:print-text-format (proto:deserialize-object 'proto-test3 tschema tser3 0) tschema)
 128
 129 (proto:print-text-format test4 tschema)
 130 (proto:print-text-format (proto:deserialize-object 'proto-test4 tschema tser4 0) tschema)
 131
 132 (proto:print-text-format test5 tschema)
 133 (proto:print-text-format (proto:deserialize-object 'proto-test5 tschema tser5 0) tschema)
 134 ||#
 135
 136 #||
 137 (let* ((enums (list (make-instance 'proto:protobuf-enum
 138                       :name "ColorName"
 139                       :values (list (make-instance 'proto:protobuf-enum-value
 140                                       :name "RED"
 141                                       :index 1
 142                                       :value :red)
 143                                     (make-instance 'proto:protobuf-enum-value
 144                                       :name "GREEN"
 145                                       :index 2
 146                                       :value :green)
 147                                     (make-instance 'proto:protobuf-enum-value
 148                                       :name "BLUE"
 149                                       :index 3
 150                                       :value :blue)))))
 151        (msgs  (list (make-instance 'proto:protobuf-message
 152                       :name "Color"
 153                       :enums (list (make-instance 'proto:protobuf-enum
 154                                       :name "ContrastName"
 155                                       :values (list (make-instance 'proto:protobuf-enum-value
 156                                                       :name "LOW"
 157                                                       :index 1
 158                                                       :value :high)
 159                                                     (make-instance 'proto:protobuf-enum-value
 160                                                       :name "HIGH"
 161                                                       :index 100
 162                                                       :value :low))))
 163                       :fields (list (make-instance 'proto:protobuf-field
 164                                       :name "color"
 165                                       :type "ColorName"
 166                                       :required :required
 167                                       :index 1)
 168                                     (make-instance 'proto:protobuf-field
 169                                       :name "contrast"
 170                                       :type "ContrastName"
 171                                       :required :optional
 172                                       :index 2
 173                                       :default "LOW")))))
 174        (rpcs  (list (make-instance 'proto:protobuf-rpc
 175                       :name "GetColor"
 176                       :input-type nil
 177                       :output-type "Color")
 178                     (make-instance 'proto:protobuf-rpc
 179                       :name "SetColor"
 180                       :input-type "Color"
 181                       :output-type "Color")))
 182        (svcs  (list (make-instance 'proto:protobuf-service
 183                       :name "ColorWheel"
 184                       :rpcs rpcs)))
 185        (proto (make-instance 'proto:protobuf
 186                 :package "ita.color"
 187                 :imports '("descriptor.proto")
 188                 :enums enums
 189                 :messages msgs
 190                 :services svcs)))
 191   ;; The output should be example the same as the output of 'write-protobuf' below
 192   (proto:write-protobuf proto))
 193 ||#
 194
 195 #||
 196 (makunbound '*color-wheel*)
 197 (proto:define-proto color-wheel (:package ita.color
 198                                  :import "descriptor.proto")
 199   (proto:define-enum color-name ()
 200     red
 201     green
 202     blue)
 203   (proto:define-message color (:conc-name color-)
 204     (proto:define-enum contrast-name ()
 205       (low    1)
 206       (high 100))
 207     (color    :type color-name)
 208     (contrast :type (or null contrast-name) :default :low))
 209   (proto:define-service color-wheel ()
 210     (get-color nil color)
 211     (set-color color color :options ("deadline" "1.0"))))
 212
 213 => (PROGN
 214      (DEFTYPE COLOR-NAME () '(MEMBER :RED :GREEN :BLUE))
 215      (DEFTYPE CONTRAST-NAME () '(MEMBER :LOW :HIGH))
 216      (DEFCLASS COLOR ()
 217        ((COLOR :TYPE COLOR-NAME :ACCESSOR COLOR-COLOR :INITARG :COLOR)
 218         (CONTRAST :TYPE (OR NULL CONTRAST-NAME) :ACCESSOR COLOR-CONTRAST :INITARG :CONTRAST :INITFORM :LOW)))
 219      (DEFVAR *COLOR-WHEEL*
 220        (MAKE-INSTANCE 'PROTOBUF
 221          :NAME "ColorWheel"
 222          :CLASS 'COLOR-WHEEL
 223          :PACKAGE "ita.color"
 224          :IMPORTS '("descriptor.proto")
 225          :SYNTAX NIL
 226          :OPTIONS ()
 227          :ENUMS (LIST (MAKE-INSTANCE 'PROTOBUF-ENUM
 228                         :NAME "ColorName"
 229                         :CLASS 'COLOR-NAME
 230                         :VALUES (LIST (MAKE-INSTANCE 'PROTOBUF-ENUM-VALUE
 231                                         :NAME "RED" :INDEX 1 :VALUE :RED)
 232                                       (MAKE-INSTANCE 'PROTOBUF-ENUM-VALUE
 233                                         :NAME "GREEN" :INDEX 2 :VALUE :GREEN)
 234                                       (MAKE-INSTANCE 'PROTOBUF-ENUM-VALUE
 235                                         :NAME "BLUE" :INDEX 3 :VALUE :BLUE))))
 236          :MESSAGES (LIST (MAKE-INSTANCE 'PROTOBUF-MESSAGE
 237                            :NAME "Color"
 238                            :CLASS 'COLOR
 239                            :CONC-NAME "COLOR-"
 240                            :ENUMS (LIST (MAKE-INSTANCE 'PROTOBUF-ENUM
 241                                           :NAME "ContrastName"
 242                                           :CLASS 'CONTRAST-NAME
 243                                           :VALUES (LIST (MAKE-INSTANCE 'PROTOBUF-ENUM-VALUE
 244                                                           :NAME "LOW" :INDEX 1 :VALUE :LOW)
 245                                                         (MAKE-INSTANCE 'PROTOBUF-ENUM-VALUE
 246                                                           :NAME "HIGH" :INDEX 100 :VALUE :HIGH))))
 247                            :MESSAGES (LIST)
 248                            :FIELDS (LIST (MAKE-INSTANCE 'PROTOBUF-FIELD
 249                                            :NAME "color"
 250                                            :TYPE "ColorName"
 251                                            :CLASS 'COLOR-NAME
 252                                            :REQUIRED :REQUIRED
 253                                            :INDEX 1
 254                                            :VALUE 'COLOR
 255                                            :DEFAULT NIL
 256                                            :PACKED NIL)
 257                                          (MAKE-INSTANCE 'PROTOBUF-FIELD
 258                                            :NAME "contrast"
 259                                            :TYPE "ContrastName"
 260                                            :CLASS 'CONTRAST-NAME
 261                                            :REQUIRED :OPTIONAL
 262                                            :INDEX 2
 263                                            :VALUE 'CONTRAST
 264                                            :DEFAULT "LOW"
 265                                            :PACKED NIL))))
 266          :SERVICES (LIST (MAKE-INSTANCE 'PROTOBUF-SERVICE
 267                            :NAME "ColorWheel"
 268                            :CLASS 'COLOR-WHEEL
 269                            :RPCS (LIST (MAKE-INSTANCE 'PROTOBUF-RPC
 270                                          :NAME "GetColor"
 271                                          :CLASS 'GET-COLOR
 272                                          :INPUT-TYPE NIL
 273                                          :OUTPUT-TYPE "Color"
 274                                          :OPTIONS (LIST))
 275                                        (MAKE-INSTANCE 'PROTOBUF-RPC
 276                                          :NAME "SetColor"
 277                                          :CLASS 'SET-COLOR
 278                                          :INPUT-TYPE "Color"
 279                                          :OUTPUT-TYPE "Color"
 280                                          :OPTIONS (LIST (MAKE-INSTANCE 'PROTOBUF-OPTION
 281                                                           :NAME "deadline" :VALUE "1.0")))))))))
 282
 283 ;; The output should be example the same as the output of 'write-protobuf' above
 284 (proto:write-protobuf *color-wheel*)
 285
 286 ;; How does the Lisp version look?
 287 (proto:write-protobuf *color-wheel* :type :lisp)
 288
 289 (setq clr (make-instance 'color :color :red))
 290 (setq cser (proto:serialize-object-to-stream clr *color-wheel* :stream nil))
 291 (proto:print-text-format clr *color-wheel*)
 292 (proto:print-text-format (proto:deserialize-object 'color *color-wheel* cser 0) *color-wheel*)
 293 ||#