1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;; Confidential and proprietary information of ITA Software, Inc. ;;;
5 ;;; Copyright (c) 2012 ITA Software, Inc. All rights reserved. ;;;
7 ;;; Original author: Scott McKay ;;;
9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11 (in-package "PROTO-IMPL")
14 ;;; Protol buffers model classes
16 ;; The protobuf, corresponds to one .proto file
18 ((name :type (or null string) ;the name of this .proto file
22 (class :type (or null symbol) ;a "class name" for this protobuf, for Lisp
26 (syntax :type (or null string) ;syntax, passed on but otherwise ignored
30 (package :type (or null string) ;the package
34 (imports :type (list-of string) ;any imports
38 (options :type (list-of string) ;options, passed on but otherwise ignored
42 (enums :type (list-of protobuf-enum) ;the set of enum types
46 (messages :type (list-of protobuf-message) ;the set of messages
47 :accessor proto-messages
50 (services :type (list-of protobuf-service)
51 :accessor proto-services
55 "The model class that represents a protobufs schema, i.e., one .proto file."))
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))))
62 (defgeneric find-message-for-class (protobuf class)
64 "Given a protobuf schema or message and a class or class name,
65 returns the protobuf message corresponding to the class."))
67 (defgeneric find-enum-for-type (protobuf type)
69 "Given a protobuf schema or message and the name of an enum type,
70 returns the protobuf enum corresponding to the type."))
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))))
76 (defmethod find-message-for-class ((protobuf protobuf) (class class))
77 (find-message-for-class protobuf (class-name class)))
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))))
84 ;; A protobuf enumeration
85 (defclass protobuf-enum ()
86 ((name :type string ;the Protobuf name for the enum type
89 (class :type (or null symbol) ;the Lisp type it represents
93 (values :type (list-of protobuf-enum-value) ;all the values for this enum type
94 :accessor proto-values
97 (comment :type (or null string)
98 :accessor proto-comment
102 "The model class that represents a protobufs enumeration type."))
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))))
110 ;; A protobuf value within an enumeration
111 (defclass protobuf-enum-value ()
112 ((name :type string ;the name of the enum value
115 (index :type (integer #.(- (ash 1 31)) #.(1- (ash 1 31)))
116 :accessor proto-index ;the index of the enum value
118 (value :type (or null symbol)
119 :accessor proto-value ;the Lisp value of the enum
123 "The model class that represents a protobufs enumeration value."))
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))))
131 ;; A protobuf message
132 (defclass protobuf-message ()
133 ((name :type string ;the Protobuf name for the message
136 (class :type (or null symbol) ;the Lisp class it represents
137 :accessor proto-class
140 (conc :type (or null string) ;the conc-name used for Lisp accessors
141 :accessor proto-conc-name
144 (enums :type (list-of protobuf-enum) ;the embedded enum types
145 :accessor proto-enums
148 (messages :type (list-of protobuf-message) ;the embedded messages
149 :accessor proto-messages
152 (fields :type (list-of protobuf-field) ;the fields
153 :accessor proto-fields
156 (comment :type (or null string)
157 :accessor proto-comment
161 "The model class that represents a protobufs message."))
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))))
168 (defmethod find-message-for-class ((message protobuf-message) (class symbol))
169 (find class (proto-messages message) :key #'proto-class))
171 (defmethod find-message-for-class ((message protobuf-message) (class class))
172 (find-message-for-class message (class-name class)))
174 (defmethod find-enum-for-type ((message protobuf-message) type)
175 (find type (proto-enums message) :key #'proto-class))
178 ;; A protobuf field within a message
179 (defclass protobuf-field ()
180 ((name :type string ;the Protobuf name for the field
183 (type :type string ;the name of the Protobuf type for the field
186 (class :type (or null symbol) ;the Lisp class (or a keyword such as :fixed64)
187 :accessor proto-class
190 (required :type (member :required :optional :repeated)
191 :accessor proto-required
193 (index :type (integer 1 #.(1- (ash 1 29))) ;the index number for this field
194 :accessor proto-index
196 (value :type (or null symbol) ;the Lisp slot holding the value within an object
197 :accessor proto-value
200 (default :type (or null string)
201 :accessor proto-default
204 (packed :type (member t nil)
205 :accessor proto-packed
208 (comment :type (or null string)
209 :accessor proto-comment
213 "The model class that represents one field within a protobufs message."))
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)
223 ;; A protobuf service
224 (defclass protobuf-service ()
225 ((name :type string ;the Protobuf name for the service
228 (class :type (or null symbol) ;a "class name" for this service, for Lisp
229 :accessor proto-class
232 (rpcs :type (list-of protobuf-rpc) ;the RPCs in the service
236 (comment :type (or null string)
237 :accessor proto-comment
241 "The model class that represents a protobufs service."))
243 (defmethod print-object ((s protobuf-service) stream)
244 (print-unprintable-object (s stream :type t :identity t)
249 ;; A protobuf RPC within a service
250 (defclass protobuf-rpc ()
251 ((name :type string ;the Protobuf name for the RPC
254 (class :type (or null symbol) ;a "class name" for this RPC, for Lisp
255 :accessor proto-class
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
269 "The model class that represents one RPC with a protobufs service."))
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))))