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