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 ;;; Protobufs schema pretty printing
16 (defun write-schema (protobuf &rest keys
17 &key (stream *standard-output*) (type :proto) &allow-other-keys)
18 "Writes the object 'protobuf' (schema, message, enum, etc) onto the
19 stream 'stream'in the format given by 'type' (:proto, :text, etc)."
20 (let ((*protobuf* protobuf))
21 (apply #'write-schema-as type protobuf stream keys)))
23 (defgeneric write-schema-as (type protobuf stream &key indentation &allow-other-keys)
25 "Writes the protobuf object 'protobuf' (schema, message, enum, etc) onto
26 the given stream 'stream' in the format given by 'type' (:proto, :text, etc).
27 If 'more' is true, this means there are more enum values, fields, etc to
28 be written after the current one."))
30 (defgeneric write-schema-documentation (type docstring stream &key indentation)
32 "Writes the docstring as a \"block comment\" onto the given stream 'stream'
33 in the format given by 'type' (:proto, :text, etc)."))
36 ;;; Pretty print a schema as a .proto file
38 (defmethod write-schema-as ((type (eql :proto)) (schema protobuf-schema) stream
40 (with-prefixed-accessors (name documentation syntax package imports options) (proto- schema)
42 (write-schema-documentation type documentation stream :indentation indentation))
44 (format stream "~&syntax = \"~A\";~%~%" syntax))
46 (format stream "~&package ~A;~%~%" (substitute #\_ #\- package)))
48 (dolist (import imports)
49 (format stream "~&import \"~A\";~%" import))
51 (write-schema-header type schema stream)
53 (dolist (option options)
54 (format stream "~&option ~:/protobuf-option/;~%" option))
56 (loop for (enum . more) on (proto-enums schema) doing
57 (write-schema-as type enum stream :indentation indentation :more more)
59 (loop for (msg . more) on (proto-messages schema) doing
60 (write-schema-as type msg stream :indentation indentation :more more)
62 (loop for (svc . more) on (proto-services schema) doing
63 (write-schema-as type svc stream :indentation indentation :more more)
66 (defmethod write-schema-documentation ((type (eql :proto)) docstring stream
68 (let ((lines (split-string docstring :separators '(#\newline #\return))))
70 (format stream "~&~@[~VT~]// ~A~%"
71 (and (not (zerop indentation)) indentation) line))))
73 ;; Lisp was born in 1958 :-)
74 (defvar *lisp-options* '(("lisp_package" string 195801)
75 ("lisp_name" string 195802)
76 ("lisp_alias" string 195803)
77 ("lisp_type" string 195804)
78 ("lisp_class" string 195805)
79 ("lisp_slot" string 195806)))
81 (defvar *option-types* '(("optimize_for" symbol)
83 ("cc_generic_services" symbol)
84 ("java_generic_services" symbol)
85 ("py_generic_services" symbol)
88 (defmethod write-schema-header ((type (eql :proto)) (schema protobuf-schema) stream)
89 (when (any-lisp-option schema)
90 (format stream "~&import \"net/proto2/proto/descriptor.proto\";~%~%")
91 (format stream "~&extend proto2.MessageOptions {~%")
92 (loop for (option type index) in *lisp-options* doing
93 (format stream "~& optional ~(~A~) ~A = ~D;~%" type option index))
94 (format stream "~&}~%~%")))
96 (defmethod any-lisp-option ((schema protobuf-schema))
97 (labels ((find-one (protobuf)
98 (dolist (enum (proto-enums protobuf))
99 (with-prefixed-accessors (name class alias-for) (proto- enum)
101 (and class (not (string-equal name (class-name->proto class))) class))
102 (return-from any-lisp-option t))))
103 (dolist (msg (proto-messages protobuf))
104 (with-prefixed-accessors (name class alias-for) (proto- msg)
106 (and class (not (string-equal name (class-name->proto class))) class))
107 (return-from any-lisp-option t))))
108 (map () #'find-one (proto-messages protobuf))))
112 (defun cl-user::protobuf-option (stream option colon-p atsign-p)
113 (let ((type (or (second (find (proto-name option) *option-types* :key #'first :test #'string=))
114 (proto-type option))))
115 (cond (colon-p ;~:/protobuf-option/ -- .proto format
117 (cond ((find (proto-name option) *lisp-options* :key #'first :test #'string=)
118 (if (eq type 'symbol) "(~A)~@[ = ~A~]" "(~A)~@[ = ~S~]"))
120 (if (eq type 'symbol) "~A~@[ = ~A~]" "~A~@[ = ~S~]")))))
121 (format stream fmt-control (proto-name option) (proto-value option))))
122 (atsign-p ;~@/protobuf-option/ -- .lisp format
123 (let ((fmt-control (if (eq type 'symbol) "~(~S~) ~A" "~(~S~) ~S")))
124 (format stream fmt-control (proto-name option) (proto-value option))))
125 (t ;~/protobuf-option/ -- keyword/value format
126 (let ((fmt-control (if (eq type 'symbol) "~(:~A~) ~A" "~(:~A~) ~S")))
127 (format stream fmt-control (proto-name option) (proto-value option)))))))
129 (defmethod write-schema-as ((type (eql :proto)) (enum protobuf-enum) stream
130 &key (indentation 0) more)
131 (declare (ignore more))
132 (with-prefixed-accessors (name class alias-for documentation options) (proto- enum)
134 (write-schema-documentation type documentation stream :indentation indentation))
135 (format stream "~&~@[~VT~]enum ~A {~%"
136 (and (not (zerop indentation)) indentation) name)
137 (let ((other (and class (not (string-equal name (class-name->proto class))) class)))
139 (format stream "~&~VToption (lisp_name) = \"~A:~A\";~%"
140 (+ indentation 2) (package-name (symbol-package class)) (symbol-name class))))
142 (format stream "~&~VToption (lisp_alias) = \"~A:~A\";~%"
143 (+ indentation 2) (package-name (symbol-package alias-for)) (symbol-name alias-for)))
144 (dolist (option options)
145 (format stream "~&option ~:/protobuf-option/;~%" option))
146 (loop for (value . more) on (proto-values enum) doing
147 (write-schema-as type value stream :indentation (+ indentation 2) :more more))
148 (format stream "~&~@[~VT~]}~%"
149 (and (not (zerop indentation)) indentation))))
151 (defparameter *protobuf-enum-comment-column* 56)
152 (defmethod write-schema-as ((type (eql :proto)) (val protobuf-enum-value) stream
153 &key (indentation 0) more)
154 (declare (ignore more))
155 (with-prefixed-accessors (name documentation index) (proto- val)
156 (format stream "~&~@[~VT~]~A = ~D;~:[~*~*~;~VT// ~A~]~%"
157 (and (not (zerop indentation)) indentation) name index
158 documentation *protobuf-enum-comment-column* documentation)))
161 (defmethod write-schema-as ((type (eql :proto)) (message protobuf-message) stream
162 &key (indentation 0) more index arity)
163 (declare (ignore more arity))
164 (with-prefixed-accessors (name class alias-for message-type documentation options) (proto- message)
165 (cond ((eq message-type :group)
166 ;; If we've got a group, the printer for fields has already
167 ;; printed a partial line (nice modularity, huh?)
168 (format stream "group ~A = ~D {~%" name index)
169 (let ((other (and class (not (string-equal name (class-name->proto class))) class)))
171 (format stream "~&~VToption (lisp_name) = \"~A:~A\";~%"
172 (+ indentation 2) (package-name (symbol-package class)) (symbol-name class))))
174 (format stream "~&~VToption (lisp_alias) = \"~A:~A\";~%"
175 (+ indentation 2) (package-name (symbol-package alias-for)) (symbol-name alias-for)))
176 (dolist (option options)
177 (format stream "~&~VToption ~:/protobuf-option/;~%"
178 (+ indentation 2) option))
179 (loop for (enum . more) on (proto-enums message) doing
180 (write-schema-as type enum stream :indentation (+ indentation 2) :more more))
181 (loop for (field . more) on (proto-fields message) doing
182 (write-schema-as type field stream
183 :indentation (+ indentation 2) :more more :message message))
184 (format stream "~&~@[~VT~]}~%"
185 (and (not (zerop indentation)) indentation)))
188 (write-schema-documentation type documentation stream :indentation indentation))
189 (format stream "~&~@[~VT~]~A ~A {~%"
190 (and (not (zerop indentation)) indentation)
191 (if (eq message-type :message) "message" "extend") name)
192 (let ((other (and class (not (string-equal name (class-name->proto class))) class)))
194 (format stream "~&~VToption (lisp_name) = \"~A:~A\";~%"
195 (+ indentation 2) (package-name (symbol-package class)) (symbol-name class))))
197 (format stream "~&~VToption (lisp_alias) = \"~A:~A\";~%"
198 (+ indentation 2) (package-name (symbol-package alias-for)) (symbol-name alias-for)))
199 (dolist (option options)
200 (format stream "~&~VToption ~:/protobuf-option/;~%"
201 (+ indentation 2) option))
202 (cond ((eq message-type :extends)
203 (loop for (field . more) on (proto-extended-fields message) doing
204 (write-schema-as type field stream
205 :indentation (+ indentation 2) :more more
208 (loop for (enum . more) on (proto-enums message) doing
209 (write-schema-as type enum stream :indentation (+ indentation 2) :more more))
210 (loop for (msg . more) on (proto-messages message) doing
211 (unless (eq (proto-message-type msg) :group)
212 (write-schema-as type msg stream :indentation (+ indentation 2) :more more)))
213 (loop for (field . more) on (proto-fields message) doing
214 (write-schema-as type field stream
215 :indentation (+ indentation 2) :more more
217 (loop for (extension . more) on (proto-extensions message) doing
218 (write-schema-as type extension stream :indentation (+ indentation 2) :more more))))
219 (format stream "~&~@[~VT~]}~%"
220 (and (not (zerop indentation)) indentation))))))
222 (defparameter *protobuf-field-comment-column* 56)
223 (defmethod write-schema-as ((type (eql :proto)) (field protobuf-field) stream
224 &key (indentation 0) more message)
225 (declare (ignore more))
226 (with-prefixed-accessors (name documentation required type index packed options) (proto- field)
227 (let* ((class (if (eq (proto-class field) 'boolean) :bool (proto-class field)))
228 (msg (and (not (keywordp class))
229 (or (find-message message class) (find-enum message class)))))
230 (cond ((and (typep msg 'protobuf-message)
231 (eq (proto-message-type msg) :group))
232 (format stream "~&~@[~VT~]~(~A~) "
233 (and (not (zerop indentation)) indentation) required)
234 (write-schema-as :proto msg stream :indentation indentation :index index :arity required))
236 (let* ((defaultp (not (empty-default-p field)))
237 (default (proto-default field))
238 (default (and defaultp
239 (cond ((and (typep msg 'protobuf-enum)
240 (or (stringp default) (symbolp default)))
241 (let ((e (find default (proto-values msg)
242 :key #'proto-name :test #'string=)))
243 (and e (proto-name e))))
245 (if (boolean-true-p default) "true" "false"))
247 (default (and defaultp
248 (if (stringp default) (escape-string default) default))))
249 (format stream (if (and (keywordp class) (not (eq class :bool)))
250 ;; Keyword class means a primitive type, print default with ~S
251 "~&~@[~VT~]~(~A~) ~A ~A = ~D~
252 ~:[~*~; [default = ~S]~]~@[ [packed = true]~*~]~{ [~:/protobuf-option/]~};~
253 ~:[~*~*~;~VT// ~A~]~%"
254 ;; Non-keyword class means an enum type, print default with ~A"
255 "~&~@[~VT~]~(~A~) ~A ~A = ~D~
256 ~:[~*~; [default = ~A]~]~@[ [packed = true]~*~]~{ [~:/protobuf-option/]~};~
257 ~:[~*~*~;~VT// ~A~]~%")
258 (and (not (zerop indentation)) indentation)
259 required type name index defaultp default packed options
260 documentation *protobuf-field-comment-column* documentation)))))))
262 (defun escape-string (string)
263 (if (every #'(lambda (ch) (and (standard-char-p ch) (graphic-char-p ch))) string)
265 (with-output-to-string (s)
266 (loop for ch across string
267 as esc = (escape-char ch)
268 do (format s "~A" esc)))))
270 (defmethod write-schema-as ((type (eql :proto)) (extension protobuf-extension) stream
271 &key (indentation 0) more)
272 (declare (ignore more))
273 (with-prefixed-accessors (from to) (proto-extension- extension)
274 (format stream "~&~@[~VT~]extensions ~D~:[~*~; to ~D~];~%"
275 (and (not (zerop indentation)) indentation)
276 from (not (eql from to)) (if (eql to #.(1- (ash 1 29))) "max" to))))
279 (defmethod write-schema-as ((type (eql :proto)) (service protobuf-service) stream
280 &key (indentation 0) more)
281 (declare (ignore more))
282 (with-prefixed-accessors (name documentation) (proto- service)
284 (write-schema-documentation type documentation stream :indentation indentation))
285 (format stream "~&~@[~VT~]service ~A {~%"
286 (and (not (zerop indentation)) indentation) name)
287 (loop for (method . more) on (proto-methods service) doing
288 (write-schema-as type method stream :indentation (+ indentation 2) :more more))
289 (format stream "~&~@[~VT~]}~%"
290 (and (not (zerop indentation)) indentation))))
292 (defmethod write-schema-as ((type (eql :proto)) (method protobuf-method) stream
293 &key (indentation 0) more)
294 (declare (ignore more))
295 (with-prefixed-accessors (name documentation input-name output-name options) (proto- method)
297 (write-schema-documentation type documentation stream :indentation indentation))
298 (format stream "~&~@[~VT~]rpc ~A (~@[~A~])~@[ returns (~A)~]"
299 (and (not (zerop indentation)) indentation)
300 name input-name output-name)
302 (format stream " {~%")
303 (dolist (option options)
304 (format stream "~&~@[~VT~]option ~:/protobuf-option/;~%"
305 (+ indentation 2) option))
306 (format stream "~@[~VT~]}"
307 (and (not (zerop indentation)) indentation)))
309 (format stream ";~%")))))
312 ;;; Pretty print a schema as a .lisp file
314 (defvar *show-lisp-enum-indexes* t)
315 (defvar *show-lisp-field-indexes* t)
317 (defmethod write-schema-as ((type (eql :lisp)) (schema protobuf-schema) stream
319 (show-field-indexes *show-lisp-field-indexes*)
320 (show-enum-indexes *show-lisp-enum-indexes*))
321 (with-prefixed-accessors (name class documentation package lisp-package imports) (proto- schema)
322 (let* ((optimize (let ((opt (find-option schema "optimize_for")))
323 (and opt (cond ((string= opt "SPEED") :speed)
324 ((string= opt "CODE_SIZE") :space)
326 (options (remove-if #'(lambda (x) (string= (proto-name x) "optimize_for"))
327 (proto-options schema)))
328 (pkg (and package (if (stringp package) package (string package))))
329 (lisp-pkg (and lisp-package (if (stringp lisp-package) lisp-package (string lisp-package))))
330 (*show-lisp-enum-indexes* show-enum-indexes)
331 (*show-lisp-field-indexes* show-field-indexes)
332 (*protobuf-package* (or (find-package lisp-pkg)
333 (find-package (string-upcase lisp-pkg))
335 (*package* *protobuf-package*))
336 (when (or lisp-pkg pkg)
337 (let ((pkg (string-upcase (or lisp-pkg pkg))))
338 (format stream "~&(eval-when (:execute :compile-toplevel :load-toplevel) ~
339 ~% (unless (find-package \"~A\") ~
340 ~% (defpackage ~A (:use :COMMON-LISP :PROTOBUFS)))) ~
341 ~%(in-package \"~A\")~%~%"
344 (write-schema-documentation type documentation stream :indentation indentation))
345 (format stream "~&(proto:define-schema ~(~A~)" (or class name))
346 (if (or pkg lisp-pkg imports optimize options documentation)
347 (format stream "~% (")
348 (format stream " ("))
351 (format stream "~A:package \"~A\"" spaces pkg)
352 (when (or lisp-pkg imports optimize options documentation)
356 (format stream "~A:lisp-package \"~A\"" spaces lisp-pkg)
357 (when (or imports optimize options documentation)
361 (cond ((= (length imports) 1)
362 (format stream "~A:import \"~A\"" spaces (car imports)))
364 (format stream "~A:import (~{\"~A\"~^ ~})" spaces imports)))
365 (when (or optimize options documentation)
369 (format stream "~A:optimize ~(~S~)" spaces optimize)
370 (when (or options documentation)
374 (format stream "~A:options (~{~@/protobuf-option/~^ ~})" spaces options)
379 (format stream "~A:documentation ~S" spaces documentation)))
381 (loop for (enum . more) on (proto-enums schema) doing
382 (write-schema-as type enum stream :indentation 2 :more more))
383 (loop for (msg . more) on (proto-messages schema) doing
384 (write-schema-as type msg stream :indentation 2 :more more))
385 (loop for (svc . more) on (proto-services schema) doing
386 (write-schema-as type svc stream :indentation 2 :more more)))
387 (format stream ")~%")))
389 (defmethod write-schema-documentation ((type (eql :lisp)) docstring stream
390 &key (indentation 0))
391 (let ((lines (split-string docstring :separators '(#\newline #\return))))
393 (format stream "~&~@[~VT~];; ~A~%"
394 (and (not (zerop indentation)) indentation) line))))
396 (defmethod write-schema-header ((type (eql :lisp)) (schema protobuf-schema) stream)
397 (declare (ignorable type stream))
400 (defmethod write-schema-as ((type (eql :lisp)) (enum protobuf-enum) stream
401 &key (indentation 0) more)
402 (declare (ignore more))
404 (with-prefixed-accessors (name class alias-for documentation) (proto- enum)
406 (write-schema-documentation type documentation stream :indentation indentation))
407 (format stream "~@[~VT~](proto:define-enum ~(~S~)"
408 (and (not (zerop indentation)) indentation) class)
409 (let ((other (and name (not (string-equal name (class-name->proto class))) name)))
410 (cond ((or other alias-for documentation)
411 (format stream "~%~@[~VT~](~:[~*~*~;:name ~(~S~)~@[~%~VT~]~]~
412 ~:[~*~*~;:alias-for ~(~S~)~@[~%~VT~]~]~
413 ~:[~*~;:documentation ~S~])"
415 other other (and (or alias-for documentation) (+ indentation 5))
416 alias-for alias-for (and documentation (+ indentation 5))
417 documentation documentation))
419 (format stream " ()"))))
420 (loop for (value . more) on (proto-values enum) doing
421 (write-schema-as type value stream :indentation (+ indentation 2) :more more)
424 (format stream ")")))
426 (defmethod write-schema-as ((type (eql :lisp)) (val protobuf-enum-value) stream
427 &key (indentation 0) more)
428 (declare (ignore more))
429 (with-prefixed-accessors (value index) (proto- val)
430 (if *show-lisp-enum-indexes*
431 (format stream "~&~@[~VT~](~(~A~) ~D)"
432 (and (not (zerop indentation)) indentation) value index)
433 (format stream "~&~@[~VT~]~(~A~)"
434 (and (not (zerop indentation)) indentation) value))))
437 (defmethod write-schema-as ((type (eql :lisp)) (message protobuf-message) stream
438 &key (indentation 0) more index arity)
439 (declare (ignore more))
440 (with-prefixed-accessors (name class alias-for conc-name message-type documentation) (proto- message)
441 (cond ((eq message-type :group)
443 (write-schema-documentation type documentation stream :indentation indentation))
444 (format stream "~&~@[~VT~](proto:define-group ~(~S~)"
445 (and (not (zerop indentation)) indentation) class)
446 (let ((other (and name (not (string-equal name (class-name->proto class))) name)))
447 (format stream "~%~@[~VT~](:index ~D~@[~%~VT~]~
448 :arity ~(~S~)~@[~%~VT~]~
449 ~:[~*~*~;:name ~(~S~)~@[~%~VT~]~]~
450 ~:[~*~*~;:alias-for ~(~S~)~@[~%~VT~]~]~
451 ~:[~*~*~;:conc-name ~(~S~)~@[~%~VT~]~]~
452 ~:[~*~;:documentation ~S~])"
454 index (+ indentation 5)
455 arity (and (or other alias-for conc-name documentation) (+ indentation 5))
456 other other (and (or alias-for conc-name documentation) (+ indentation 5))
457 alias-for alias-for (and (or documentation conc-name) (+ indentation 5))
458 conc-name conc-name (and documentation (+ indentation 5))
459 documentation documentation))
460 (loop for (enum . more) on (proto-enums message) doing
461 (write-schema-as type enum stream :indentation (+ indentation 2) :more more)
464 (loop for (field . more) on (proto-fields message) doing
465 (write-schema-as type field stream
466 :indentation (+ indentation 2) :more more
472 (write-schema-documentation type documentation stream :indentation indentation))
473 (format stream "~&~@[~VT~](proto:define-~A ~(~S~)"
474 (and (not (zerop indentation)) indentation)
475 (if (eq message-type :message) "message" "extend") class)
476 (let ((other (and name (not (string-equal name (class-name->proto class))) name)))
477 (cond ((eq message-type :extends)
478 (format stream " ()"))
479 ((or other alias-for conc-name documentation)
480 (format stream "~%~@[~VT~](~:[~*~*~;:name ~(~S~)~@[~%~VT~]~]~
481 ~:[~*~*~;:alias-for ~(~S~)~@[~%~VT~]~]~
482 ~:[~*~*~;:conc-name ~(~S~)~@[~%~VT~]~]~
483 ~:[~*~;:documentation ~S~])"
485 other other (and (or alias-for conc-name documentation) (+ indentation 5))
486 alias-for alias-for (and (or documentation conc-name) (+ indentation 5))
487 conc-name conc-name (and documentation (+ indentation 5))
488 documentation documentation))
490 (format stream " ()"))))
491 (cond ((eq message-type :extends)
492 (loop for (field . more) on (proto-extended-fields message) doing
493 (write-schema-as type field stream
494 :indentation (+ indentation 2) :more more
499 (loop for (enum . more) on (proto-enums message) doing
500 (write-schema-as type enum stream :indentation (+ indentation 2) :more more)
503 (loop for (msg . more) on (proto-messages message) doing
504 (unless (eq (proto-message-type msg) :group)
505 (write-schema-as type msg stream :indentation (+ indentation 2) :more more)
508 (loop for (field . more) on (proto-fields message) doing
509 (write-schema-as type field stream
510 :indentation (+ indentation 2) :more more
514 (loop for (extension . more) on (proto-extensions message) doing
515 (write-schema-as type extension stream :indentation (+ indentation 2) :more more)
517 (terpri stream)))))))
518 (format stream ")")))
520 (defparameter *protobuf-slot-comment-column* 56)
521 (defmethod write-schema-as ((type (eql :lisp)) (field protobuf-field) stream
522 &key (indentation 0) more message)
523 (with-prefixed-accessors (value required index packed options documentation) (proto- field)
524 (let* ((class (if (eq (proto-class field) 'boolean) :bool (proto-class field)))
525 (msg (and (not (keywordp class))
526 (or (find-message message class) (find-enum message class))))
527 (type (let ((cl (case class
534 ((:fixed32) 'fixed32)
535 ((:fixed64) 'fixed64)
536 ((:sfixed32) 'sfixed32)
537 ((:sfixed64) 'sfixed64)
539 ((:double) 'double-float)
542 ((:bytes) 'byte-vector)
545 (cond ((eq required :optional)
547 ((eq required :repeated)
550 (cond ((and (typep msg 'protobuf-message)
551 (eq (proto-message-type msg) :group))
552 (write-schema-as :lisp msg stream :indentation indentation :index index :arity required))
554 (let* ((defaultp (not (empty-default-p field)))
555 (default (proto-default field))
556 (default (and defaultp
557 (cond ((and (typep msg 'protobuf-enum)
558 (or (stringp default) (symbolp default)))
559 (let ((e (find default (proto-values msg)
560 :key #'proto-name :test #'string=)))
561 (and e (proto-value e))))
563 (boolean-true-p default))
565 (default (and defaultp
566 (if (stringp default) (escape-string default) default)))
567 (reader (unless (eq (proto-reader field) value) (proto-reader field)))
568 (writer (unless (eq (proto-writer field) value) (proto-writer field)))
569 (slot-name (if *show-lisp-field-indexes*
570 (format nil "(~(~S~) ~D)" value index)
571 (format nil "~(~S~)" value))))
572 (format stream (if (and (keywordp class) (not (eq class :bool)))
573 ;; Keyword class means a primitive type, print default with ~S
574 "~&~@[~VT~](~A :type ~(~S~)~:[~*~; :default ~S~]~
575 ~@[ :reader ~(~S~)~]~@[ :writer ~(~S~)~]~@[ :packed ~(~S~)~]~
576 ~@[ :options (~{~@/protobuf-option/~^ ~})~])~
578 ;; Non-keyword class means an enum type, print default with ~(~S~)
579 "~&~@[~VT~](~A :type ~(~S~)~:[~*~; :default ~(~S~)~]~
580 ~@[ :reader ~(~S~)~]~@[ :writer ~(~S~)~]~@[ :packed ~(~S~)~]~
581 ~@[ :options (~{~@/protobuf-option/~^ ~})~])~
583 (and (not (zerop indentation)) indentation)
584 slot-name type defaultp default reader writer packed options
585 ;; Don't write the comment if we'll insert a close paren after it
586 (and more documentation) *protobuf-slot-comment-column* documentation)))))))
588 (defmethod write-schema-as ((type (eql :lisp)) (extension protobuf-extension) stream
589 &key (indentation 0) more)
590 (declare (ignore more))
591 (with-prefixed-accessors (from to) (proto-extension- extension)
592 (format stream "~&~@[~VT~](proto:define-extension ~D ~D)"
593 (and (not (zerop indentation)) indentation)
594 from (if (eql to #.(1- (ash 1 29))) "max" to))))
597 (defmethod write-schema-as ((type (eql :lisp)) (service protobuf-service) stream
598 &key (indentation 0) more)
599 (declare (ignore more))
600 (with-prefixed-accessors (class documentation conc-name) (proto- service)
602 (write-schema-documentation type documentation stream :indentation indentation))
603 (format stream "~&~@[~VT~](proto:define-service ~(~S~)"
604 (and (not (zerop indentation)) indentation) (proto-class service))
606 (format stream "~%~@[~VT~](:documentation ~S)"
607 (+ indentation 4) documentation))
609 (format stream " ()")))
610 (loop for (method . more) on (proto-methods service) doing
611 (write-schema-as type method stream :indentation (+ indentation 2) :more more)
614 (format stream ")")))
616 (defmethod write-schema-as ((type (eql :lisp)) (method protobuf-method) stream
617 &key (indentation 0) more)
618 (declare (ignore more))
619 (with-prefixed-accessors
620 (function documentation input-type output-type options) (proto- method)
622 (write-schema-documentation type documentation stream :indentation indentation))
623 (format stream "~&~@[~VT~](~(~S~) (~(~S~) ~(~S~))"
624 (and (not (zerop indentation)) indentation)
625 function input-type output-type)
627 (format stream "~%~VT:options (~{~@/protobuf-option/~^ ~})"
628 (+ indentation 2) options))
629 (format stream ")")))