model-classes.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 ;;; Protol buffers model classes
  15
  16 ;; A few things (the pretty printer) want to keep track of the current schema
  17 (defvar *protobuf* nil)
  18
  19
  20 ;; The protobuf, corresponds to one .proto file
  21 (defclass protobuf ()
  22   ((name :type (or null string)                 ;the name of this .proto file
  23          :reader proto-name
  24          :initarg :name
  25          :initform nil)
  26    (class :type (or null symbol)                ;a "class name" for this protobuf, for Lisp
  27           :accessor proto-class
  28           :initarg :class
  29           :initform nil)
  30    (syntax :type (or null string)               ;syntax, passed on but otherwise ignored
  31            :reader proto-syntax
  32            :initarg :syntax
  33            :initform nil)
  34    (package :type (or null string)              ;the package
  35             :reader proto-package
  36             :initarg :package
  37             :initform nil)
  38    (imports :type (list-of string)              ;any imports
  39             :reader proto-imports
  40             :initarg :imports
  41             :initform ())
  42    (options :type (list-of string)              ;options, passed on but otherwise ignored
  43            :reader proto-options
  44            :initarg :options
  45            :initform ())
  46    (enums :type (list-of protobuf-enum)         ;the set of enum types
  47           :accessor proto-enums
  48           :initarg :enums
  49           :initform ())
  50    (messages :type (list-of protobuf-message)   ;the set of messages
  51              :accessor proto-messages
  52              :initarg :messages
  53              :initform ())
  54    (services :type (list-of protobuf-service)
  55              :accessor proto-services
  56              :initarg :services
  57              :initform ()))
  58   (:documentation
  59    "The model class that represents a protobufs schema, i.e., one .proto file."))
  60
  61 (defmethod print-object ((p protobuf) stream)
  62   (print-unprintable-object (p stream :type t :identity t)
  63     (format stream "~@[~A~]~@[ (package ~A)~]"
  64             (proto-name p) (proto-package p))))
  65
  66 (defgeneric find-message-for-class (protobuf class)
  67   (:documentation
  68    "Given a protobuf schema or message and a class or class name,
  69     returns the protobuf message corresponding to the class."))
  70
  71 (defgeneric find-enum-for-type (protobuf type)
  72   (:documentation
  73    "Given a protobuf schema or message and the name of an enum type,
  74     returns the protobuf enum corresponding to the type."))
  75
  76 (defmethod find-message-for-class ((protobuf protobuf) (class symbol))
  77   (or (find class (proto-messages protobuf) :key #'proto-class)
  78       (some #'(lambda (msg) (find-message-for-class msg class)) (proto-messages protobuf))))
  79
  80 (defmethod find-message-for-class ((protobuf protobuf) (class class))
  81   (find-message-for-class protobuf (class-name class)))
  82
  83 (defmethod find-message-for-class ((protobuf protobuf) (class string))
  84   (or (find class (proto-messages protobuf) :key #'proto-name :test #'string=)
  85       (some #'(lambda (msg) (find-message-for-class msg class)) (proto-messages protobuf))))
  86
  87 (defmethod find-enum-for-type ((protobuf protobuf) type)
  88   (or (find type (proto-enums protobuf) :key #'proto-class)
  89       (some #'(lambda (msg) (find-enum-for-type msg type)) (proto-messages protobuf))))
  90
  91 (defmethod find-enum-for-type ((protobuf protobuf) (type string))
  92   (or (find type (proto-enums protobuf) :key #'proto-name :test #'string=)
  93       (some #'(lambda (msg) (find-enum-for-type msg type)) (proto-messages protobuf))))
  94
  95
  96 ;; A protobuf enumeration
  97 (defclass protobuf-enum ()
  98   ((name :type string                           ;the Protobuf name for the enum type
  99          :reader proto-name
 100          :initarg :name)
 101    (class :type (or null symbol)                ;the Lisp type it represents
 102           :accessor proto-class
 103           :initarg :class
 104           :initform nil)
 105    (values :type (list-of protobuf-enum-value)  ;all the values for this enum type
 106            :accessor proto-values
 107            :initarg :values
 108            :initform ())
 109    (comment :type (or null string)
 110             :accessor proto-comment
 111             :initarg :comment
 112             :initform nil))
 113   (:documentation
 114    "The model class that represents a protobufs enumeration type."))
 115
 116 (defmethod print-object ((e protobuf-enum) stream)
 117   (print-unprintable-object (e stream :type t :identity t)
 118     (format stream "~A~@[ (~S)~]"
 119             (proto-name e) (proto-class e))))
 120
 121
 122 ;; A protobuf value within an enumeration
 123 (defclass protobuf-enum-value ()
 124   ((name :type string                           ;the name of the enum value
 125          :reader proto-name
 126          :initarg :name)
 127    (index :type (integer #.(- (ash 1 31)) #.(1- (ash 1 31)))
 128           :accessor proto-index                 ;the index of the enum value
 129           :initarg :index)
 130    (value :type (or null symbol)
 131           :accessor proto-value                 ;the Lisp value of the enum
 132           :initarg :value
 133           :initform nil))
 134   (:documentation
 135    "The model class that represents a protobufs enumeration value."))
 136
 137 (defmethod print-object ((v protobuf-enum-value) stream)
 138   (print-unprintable-object (v stream :type t :identity t)
 139     (format stream "~A = ~D~@[ (~S)~]"
 140             (proto-name v) (proto-index v) (proto-value v))))
 141
 142
 143 ;; A protobuf message
 144 (defclass protobuf-message ()
 145   ((name :type string                           ;the Protobuf name for the message
 146          :reader proto-name
 147          :initarg :name)
 148    (class :type (or null symbol)                ;the Lisp class it represents
 149           :accessor proto-class
 150           :initarg :class
 151           :initform nil)
 152    (conc :type (or null string)                 ;the conc-name used for Lisp accessors
 153          :accessor proto-conc-name
 154          :initarg :conc-name
 155          :initform nil)
 156    (enums :type (list-of protobuf-enum)         ;the embedded enum types
 157           :accessor proto-enums
 158           :initarg :enums
 159           :initform ())
 160    (messages :type (list-of protobuf-message)   ;the embedded messages
 161              :accessor proto-messages
 162              :initarg :messages
 163              :initform ())
 164    (fields :type (list-of protobuf-field)       ;the fields
 165            :accessor proto-fields
 166            :initarg :fields
 167            :initform ())
 168    (comment :type (or null string)
 169             :accessor proto-comment
 170             :initarg :comment
 171             :initform nil))
 172     (:documentation
 173    "The model class that represents a protobufs message."))
 174
 175 (defmethod print-object ((m protobuf-message) stream)
 176   (print-unprintable-object (m stream :type t :identity t)
 177     (format stream "~A~@[ (~S)~]"
 178             (proto-name m) (proto-class m))))
 179
 180 (defmethod find-message-for-class ((message protobuf-message) (class symbol))
 181   (find class (proto-messages message) :key #'proto-class))
 182
 183 (defmethod find-message-for-class ((message protobuf-message) (class class))
 184   (find-message-for-class message (class-name class)))
 185
 186 (defmethod find-message-for-class ((message protobuf-message) (class string))
 187   (find class (proto-messages message) :key #'proto-name :test #'string=))
 188
 189 (defmethod find-enum-for-type ((message protobuf-message) type)
 190   (find type (proto-enums message) :key #'proto-class))
 191
 192 (defmethod find-enum-for-type ((message protobuf-message) (type string))
 193   (find type (proto-enums message) :key #'proto-name :test #'string=))
 194
 195
 196 ;; A protobuf field within a message
 197 (defclass protobuf-field ()
 198   ((name :type string                           ;the Protobuf name for the field
 199          :accessor proto-name
 200          :initarg :name)
 201    (type :type string                           ;the name of the Protobuf type for the field
 202          :accessor proto-type
 203          :initarg :type)
 204    (class :type (or null symbol)                ;the Lisp class (or a keyword such as :fixed64)
 205           :accessor proto-class
 206           :initarg :class
 207           :initform nil)
 208    (required :type (member :required :optional :repeated)
 209              :accessor proto-required
 210              :initarg :required)
 211    (index :type (integer 1 #.(1- (ash 1 29)))   ;the index number for this field
 212           :accessor proto-index
 213           :initarg :index)
 214    (value :type (or null symbol)                ;the Lisp slot holding the value within an object
 215           :accessor proto-value
 216           :initarg :value
 217           :initform nil)
 218    (default :type (or null string)
 219             :accessor proto-default
 220             :initarg :default
 221             :initform nil)
 222    (packed :type (member t nil)
 223            :accessor proto-packed
 224            :initarg :packed
 225            :initform nil)
 226    (comment :type (or null string)
 227             :accessor proto-comment
 228             :initarg :comment
 229             :initform nil))
 230   (:documentation
 231    "The model class that represents one field within a protobufs message."))
 232
 233 (defmethod print-object ((f protobuf-field) stream)
 234   (print-unprintable-object (f stream :type t :identity t)
 235     (format stream "~A ~A~:[~*~*~; (~S~@[ :: ~S~])~] = ~D"
 236             (proto-type f) (proto-name f)
 237             (or (proto-value f) (proto-class f)) (proto-value f) (proto-class f)
 238             (proto-index f))))
 239
 240
 241 ;; A protobuf service
 242 (defclass protobuf-service ()
 243   ((name :type string                           ;the Protobuf name for the service
 244          :reader proto-name
 245          :initarg :name)
 246    (class :type (or null symbol)                ;a "class name" for this service, for Lisp
 247           :accessor proto-class
 248           :initarg :class
 249           :initform nil)
 250    (rpcs :type (list-of protobuf-rpc)           ;the RPCs in the service
 251          :accessor proto-rpcs
 252          :initarg :rpcs
 253          :initform ())
 254    (comment :type (or null string)
 255             :accessor proto-comment
 256             :initarg :comment
 257             :initform nil))
 258   (:documentation
 259    "The model class that represents a protobufs service."))
 260
 261 (defmethod print-object ((s protobuf-service) stream)
 262   (print-unprintable-object (s stream :type t :identity t)
 263     (format stream "~A"
 264             (proto-name s))))
 265
 266
 267 ;; A protobuf RPC within a service
 268 (defclass protobuf-rpc ()
 269   ((name :type string                           ;the Protobuf name for the RPC
 270          :reader proto-name
 271          :initarg :name)
 272    (class :type (or null symbol)                ;a "class name" for this RPC, for Lisp
 273           :accessor proto-class
 274           :initarg :class
 275           :initform nil)
 276    (input :type (or null string)                ;the name of the input message type
 277           :accessor proto-input-type
 278           :initarg :input-type)
 279    (output :type (or null string)               ;the name of the output message type
 280            :accessor proto-output-type
 281            :initarg :output-type)
 282    (comment :type (or null string)
 283             :accessor proto-comment
 284             :initarg :comment
 285             :initform nil))
 286   (:documentation
 287    "The model class that represents one RPC with a protobufs service."))
 288
 289 (defmethod print-object ((r protobuf-rpc) stream)
 290   (print-unprintable-object (r stream :type t :identity t)
 291     (format stream "~A (~@[~A~]) => (~@[~A~])"
 292             (proto-name r) (proto-input-type r) (proto-output-type r))))