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 ;;--- Turn these into a test suite
  17
  18 #||
  19 (setq cschema (proto:write-protobuf-schema-for-classes
  20                '(qres-core::legacy-pnr
  21                  qres-core::legacy-pnr-pax
  22                  qres-core::legacy-pnr-segment
  23                  qres-core::legacy-pnr-pax-segment)
  24                :slot-filter #'quake::quake-slot-filter
  25                :type-filter #'quake::quake-type-filter
  26                :enum-filter #'quake::quake-enum-filter
  27                :value-filter #'quake::quake-value-filter))
  28
  29 (proto:serialize-object-to-stream pnr cschema :stream nil)
  30 ||#
  31
  32 #||
  33 (setq pschema (proto:write-protobuf-schema-for-classes
  34                '(proto:protobuf proto:protobuf-option
  35                  proto:protobuf-enum proto:protobuf-enum-value
  36                  proto:protobuf-message proto:protobuf-field proto:protobuf-extension
  37                  proto:protobuf-service proto:protobuf-rpc)))
  38
  39 (setq pser (proto:serialize-object-to-stream pschema pschema :stream nil))
  40 (describe (proto:deserialize-object 'proto:protobuf pschema pser 0))
  41
  42 (proto:print-text-format pschema pschema)
  43 (proto:print-text-format (proto:deserialize-object 'proto:protobuf pschema pser 0) pschema)
  44 ||#
  45
  46 #||
  47 (defclass proto-test1 ()
  48   ((intval :type (integer -2147483648 +2147483647)
  49            :initarg :intval)))
  50
  51 (defclass proto-test2 ()
  52   ((intval :type (or null (integer -2147483648 +2147483647))
  53            :initarg :intval)
  54    (strval :type string
  55            :initarg :strval)))
  56
  57 (defclass proto-test3 ()
  58   ((intval :type (or null (integer -2147483648 +2147483647))
  59            :initarg :intval)
  60    (strval :type (or null string)
  61            :initarg :strval)
  62    (recval :type proto-test1
  63            :initarg :recval)))
  64
  65 (defclass proto-test4 ()
  66   ((intval :type (or null (integer -2147483648 +2147483647))
  67            :initarg :intval)
  68    (strval :type (or null string)
  69            :initarg :strval)
  70    (recval :type proto-test2
  71            :initarg :recval)))
  72
  73 (defclass proto-test5 ()
  74   ((color   :type (member :red :green :blue)
  75             :initarg :color)
  76    (intvals :type (list-of integer)
  77             :initform ()
  78             :initarg :intvals)
  79    (strvals :type (list-of string)
  80             :initform ()
  81             :initarg :strvals)))
  82
  83 (setq tschema (proto:write-protobuf-schema-for-classes
  84                '(proto-test1 proto-test2 proto-test3 proto-test4 proto-test5)))
  85
  86 (setq test1 (make-instance 'proto-test1 :intval 150))
  87 (setq test2 (make-instance 'proto-test2 :strval "testing"))
  88 (setq test3 (make-instance 'proto-test3 :recval test1))
  89 (setq test4 (make-instance 'proto-test4 :recval test2))
  90 (setq test5 (make-instance 'proto-test5 :color :red :intvals '(2 3 5 7) :strvals '("two" "three" "five" "seven")))
  91
  92 (setq tser1 (proto:serialize-object-to-stream test1 tschema :stream nil))
  93 (equalp tser1 #(#x08 #x96 #x01))
  94 (describe (proto:deserialize-object 'proto-test1 tschema tser1 0))
  95
  96 (setq tser2 (proto:serialize-object-to-stream test2 tschema :stream nil))
  97 (equalp tser2 #(#x12 #x07 #x74 #x65 #x73 #x74 #x69 #x6E #x67))
  98 (describe (proto:deserialize-object 'proto-test2 tschema tser2 0))
  99
 100 (setq tser3 (proto:serialize-object-to-stream test3 tschema :stream nil))
 101 (equalp tser3 #(#x1A #x03 #x08 #x96 #x01))
 102 (describe (proto:deserialize-object 'proto-test3 tschema tser3 0))
 103 (describe (slot-value (proto:deserialize-object 'proto-test3 tschema tser3 0) 'recval))
 104
 105 (setq tser4 (proto:serialize-object-to-stream test4 tschema :stream nil))
 106 (equalp tser4 #(#x1A #x09 #x12 #x07 #x74 #x65 #x73 #x74 #x69 #x6E #x67))
 107 (describe (proto:deserialize-object 'proto-test4 tschema tser4 0))
 108 (describe (slot-value (proto:deserialize-object 'proto-test4 tschema tser4 0) 'recval))
 109
 110 (setq tser5 (proto:serialize-object-to-stream test5 tschema :stream nil))
 111 (equalp tser5 #(#x08 #x01
 112                 #x10 #x04 #x02 #x03 #x05 #x07
 113                 #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))
 114 (describe (proto:deserialize-object 'proto-test5 tschema tser5 0))
 115
 116 (equalp (mapcar #'proto-impl:zig-zag-encode32
 117                 '(0 -1 1 -2 2 -2147483648 2147483647))
 118         '(0 1 2 3 4 4294967295 4294967294))
 119 (equalp (mapcar #'proto-impl:zig-zag-encode64
 120                 '(0 -1 1 -2 2 -2147483648 2147483647 -1152921504606846976 1152921504606846975))
 121         '(0 1 2 3 4 4294967295 4294967294 2305843009213693951 2305843009213693950))
 122
 123 (proto:print-text-format test1 tschema)
 124 (proto:print-text-format (proto:deserialize-object 'proto-test1 tschema tser1 0) tschema)
 125
 126 (proto:print-text-format test2 tschema)
 127 (proto:print-text-format (proto:deserialize-object 'proto-test2 tschema tser2 0) tschema)
 128
 129 (proto:print-text-format test3 tschema)
 130 (proto:print-text-format (proto:deserialize-object 'proto-test3 tschema tser3 0) tschema)
 131
 132 (proto:print-text-format test4 tschema)
 133 (proto:print-text-format (proto:deserialize-object 'proto-test4 tschema tser4 0) tschema)
 134
 135 (proto:print-text-format test5 tschema)
 136 (proto:print-text-format (proto:deserialize-object 'proto-test5 tschema tser5 0) tschema)
 137 ||#
 138
 139 #||
 140 (let* ((enums (list (make-instance 'proto:protobuf-enum
 141                       :name "ColorName"
 142                       :values (list (make-instance 'proto:protobuf-enum-value
 143                                       :name "RED"
 144                                       :index 1
 145                                       :value :red)
 146                                     (make-instance 'proto:protobuf-enum-value
 147                                       :name "GREEN"
 148                                       :index 2
 149                                       :value :green)
 150                                     (make-instance 'proto:protobuf-enum-value
 151                                       :name "BLUE"
 152                                       :index 3
 153                                       :value :blue)))))
 154        (msgs  (list (make-instance 'proto:protobuf-message
 155                       :name "Color"
 156                       :enums (list (make-instance 'proto:protobuf-enum
 157                                       :name "ContrastName"
 158                                       :values (list (make-instance 'proto:protobuf-enum-value
 159                                                       :name "LOW"
 160                                                       :index 1
 161                                                       :value :high)
 162                                                     (make-instance 'proto:protobuf-enum-value
 163                                                       :name "HIGH"
 164                                                       :index 100
 165                                                       :value :low))))
 166                       :fields (list (make-instance 'proto:protobuf-field
 167                                       :name "color"
 168                                       :type "ColorName"
 169                                       :required :required
 170                                       :index 1)
 171                                     (make-instance 'proto:protobuf-field
 172                                       :name "contrast"
 173                                       :type "ContrastName"
 174                                       :required :optional
 175                                       :index 2
 176                                       :default "LOW")))))
 177        (rpcs  (list (make-instance 'proto:protobuf-rpc
 178                       :name "GetColor"
 179                       :input-type nil
 180                       :output-type "Color")
 181                     (make-instance 'proto:protobuf-rpc
 182                       :name "SetColor"
 183                       :input-type "Color"
 184                       :output-type "Color"
 185                       :options (list (make-instance 'protobuf-option
 186                                        :name "deadline" :value "1.0")))))
 187        (svcs  (list (make-instance 'proto:protobuf-service
 188                       :name "ColorWheel"
 189                       :rpcs rpcs)))
 190        (proto (make-instance 'proto:protobuf
 191                 :package "ita.color"
 192                 :imports '("descriptor.proto")
 193                 :enums enums
 194                 :messages msgs
 195                 :services svcs)))
 196   ;; The output should be example the same as the output of 'write-protobuf' below
 197   (proto:write-protobuf proto))
 198 ||#
 199
 200 #||
 201 (proto:define-proto color-wheel
 202     (:package ita.color
 203      :import "descriptor.proto"
 204      :documentation "Color wheel example")
 205   (proto:define-enum color-name
 206       (:documentation "A color name")
 207     red
 208     green
 209     blue)
 210   (proto:define-message color
 211       (:conc-name color-
 212        :documentation "Color and contrast")
 213     (proto:define-enum contrast-name
 214         (:documentation "A contrast name")
 215       (low    1)
 216       (high 100))
 217     (color    :type color-name)
 218     (contrast :type (or null contrast-name) :default :low))
 219   (proto:define-service color-wheel
 220       (:documentation "Get and set colors")
 221     (get-color nil color)
 222     (set-color color color :options ("deadline" "1.0"))))
 223
 224 => (PROGN
 225      (DEFTYPE COLOR-NAME () '(MEMBER :RED :GREEN :BLUE))
 226      (DEFTYPE CONTRAST-NAME () '(MEMBER :LOW :HIGH))
 227      (DEFCLASS COLOR ()
 228        ((COLOR :TYPE COLOR-NAME :ACCESSOR COLOR-COLOR :INITARG :COLOR)
 229         (CONTRAST :TYPE (OR NULL CONTRAST-NAME) :ACCESSOR COLOR-CONTRAST :INITARG :CONTRAST :INITFORM :LOW)))
 230      (DEFVAR *COLOR-WHEEL*
 231        (MAKE-INSTANCE 'PROTOBUF
 232          :NAME "ColorWheel"
 233          :CLASS 'COLOR-WHEEL
 234          :PACKAGE "ita.color"
 235          :IMPORTS '("descriptor.proto")
 236          :SYNTAX NIL
 237          :OPTIONS ()
 238          :ENUMS (LIST (MAKE-INSTANCE 'PROTOBUF-ENUM
 239                         :NAME "ColorName"
 240                         :CLASS 'COLOR-NAME
 241                         :VALUES (LIST (MAKE-INSTANCE 'PROTOBUF-ENUM-VALUE
 242                                         :NAME "RED" :INDEX 1 :VALUE :RED)
 243                                       (MAKE-INSTANCE 'PROTOBUF-ENUM-VALUE
 244                                         :NAME "GREEN" :INDEX 2 :VALUE :GREEN)
 245                                       (MAKE-INSTANCE 'PROTOBUF-ENUM-VALUE
 246                                         :NAME "BLUE" :INDEX 3 :VALUE :BLUE))))
 247          :MESSAGES (LIST (MAKE-INSTANCE 'PROTOBUF-MESSAGE
 248                            :NAME "Color"
 249                            :CLASS 'COLOR
 250                            :CONC-NAME "COLOR-"
 251                            :ENUMS (LIST (MAKE-INSTANCE 'PROTOBUF-ENUM
 252                                           :NAME "ContrastName"
 253                                           :CLASS 'CONTRAST-NAME
 254                                           :VALUES (LIST (MAKE-INSTANCE 'PROTOBUF-ENUM-VALUE
 255                                                           :NAME "LOW" :INDEX 1 :VALUE :LOW)
 256                                                         (MAKE-INSTANCE 'PROTOBUF-ENUM-VALUE
 257                                                           :NAME "HIGH" :INDEX 100 :VALUE :HIGH))))
 258                            :MESSAGES (LIST)
 259                            :FIELDS (LIST (MAKE-INSTANCE 'PROTOBUF-FIELD
 260                                            :NAME "color"
 261                                            :TYPE "ColorName"
 262                                            :CLASS 'COLOR-NAME
 263                                            :REQUIRED :REQUIRED
 264                                            :INDEX 1
 265                                            :VALUE 'COLOR
 266                                            :DEFAULT NIL
 267                                            :PACKED NIL)
 268                                          (MAKE-INSTANCE 'PROTOBUF-FIELD
 269                                            :NAME "contrast"
 270                                            :TYPE "ContrastName"
 271                                            :CLASS 'CONTRAST-NAME
 272                                            :REQUIRED :OPTIONAL
 273                                            :INDEX 2
 274                                            :VALUE 'CONTRAST
 275                                            :DEFAULT "LOW"
 276                                            :PACKED NIL))))
 277          :SERVICES (LIST (MAKE-INSTANCE 'PROTOBUF-SERVICE
 278                            :NAME "ColorWheel"
 279                            :CLASS 'COLOR-WHEEL
 280                            :RPCS (LIST (MAKE-INSTANCE 'PROTOBUF-RPC
 281                                          :NAME "GetColor"
 282                                          :CLASS 'GET-COLOR
 283                                          :INPUT-TYPE NIL
 284                                          :OUTPUT-TYPE "Color"
 285                                          :OPTIONS (LIST))
 286                                        (MAKE-INSTANCE 'PROTOBUF-RPC
 287                                          :NAME "SetColor"
 288                                          :CLASS 'SET-COLOR
 289                                          :INPUT-TYPE "Color"
 290                                          :OUTPUT-TYPE "Color"
 291                                          :OPTIONS (LIST (MAKE-INSTANCE 'PROTOBUF-OPTION
 292                                                           :NAME "deadline" :VALUE "1.0")))))))))
 293
 294 ;; The output should be example the same as the output of 'write-protobuf' above
 295 (proto:write-protobuf *color-wheel*)
 296
 297 ;; How does the Lisp version look?
 298 (proto:write-protobuf *color-wheel* :type :lisp)
 299
 300 (setq clr (make-instance 'color :color :red))
 301 (setq cser (proto:serialize-object-to-stream clr *color-wheel* :stream nil))
 302 (proto:print-text-format clr *color-wheel*)
 303 (proto:print-text-format (proto:deserialize-object 'color *color-wheel* cser 0) *color-wheel*)
 304 ||#
 305
 306 #||
 307 (let ((ps "package ita.color;
 308
 309 import \"descriptor.proto\";
 310
 311 enum ColorName {
 312   RED = 1;
 313   GREEN = 2;
 314   BLUE = 3;
 315 }
 316
 317 message Color {
 318   enum ContrastName {
 319     LOW = 1;
 320     HIGH = 100;
 321   }
 322   required ColorName color = 1;
 323   optional ContrastName contrast = 2 [default = LOW];
 324 }
 325
 326 service ColorWheel {
 327   rpc GetColor () returns (Color);
 328   rpc SetColor (Color) returns (Color) {
 329     option deadline = \"1.0\";
 330   }
 331 }"))
 332   (with-input-from-string (s ps)
 333     (setq ppp (parse-protobuf-from-stream s))))
 334
 335 (proto:write-protobuf ppp)
 336 (proto:write-protobuf ppp :type :lisp)
 337 ||#
 338
 339 #||
 340 (proto:define-proto read-air-reservation (:package qres-core)
 341   (proto:define-message read-air-reservation-request ()
 342     (proto:define-message air-reservation-spec ()
 343       (locator :type (list-of pnr-locator))
 344       (customer :type (or null string))
 345       (contract-group-id :type (or null integer))
 346       (last-name :type (or null string))
 347       (first-name :type (or null string))
 348       (phone-number :type (or null string))
 349       (email-address :type (or null string))
 350       (cc-number :type (or null string))
 351       (ticket-number :type (or null string))
 352       (ff-account :type (or null ff-account))
 353       (flights :type (list-of flight-spec)))
 354     (proto:define-message pnr-locator ()
 355       (system :type string)
 356       (locator :type string))
 357     (proto:define-message ff-account ()
 358       (carrier :type string)
 359       (number :type string))
 360     (proto:define-message flight-spec ()
 361       (carrier :type string)
 362       (flight-number :type integer)
 363       (suffix :type (or null string))
 364       (date :type string)
 365       (origin :type (or null string))
 366       (destination :type (or null string)))
 367     (spec :type air-reservation-spec))
 368   (proto:define-message read-air-reservation-response ()
 369     )
 370   (proto:define-service read-air-reservation ()
 371     (read-air-reservation read-air-reservation-request read-air-reservation-response)))
 372
 373 (proto:write-protobuf *read-air-reservation*)
 374 (proto:write-protobuf *read-air-reservation* :type :lisp)
 375 ||#
 376