printer.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 ;;; Protobufs schema pretty printing
  15
  16 (defun write-protobuf (protobuf &key (stream *standard-output*) (type :proto))
  17   "Writes the protobuf object 'protobuf' (schema, message, enum, etc) onto
  18    the given stream 'stream'in the format given by 'type' (:proto, :text, etc)."
  19    (let ((*protobuf* protobuf))
  20      (write-protobuf-as type protobuf stream)))
  21
  22 (defgeneric write-protobuf-as (type protobuf stream &key indentation)
  23   (:documentation
  24    "Writes the protobuf object 'protobuf' (schema, message, enum, etc) onto
  25     the given stream 'stream' in the format given by 'type' (:proto, :text, etc)."))
  26
  27 (defgeneric write-protobuf-documentation (type docstring stream &key indentation)
  28   (:documentation
  29    "Writes the docstring as a \"block comment\" onto the given stream 'stream'
  30     in the format given by 'type' (:proto, :text, etc)."))
  31
  32
  33 ;;; Pretty print a schema as a .proto file
  34
  35 (defmethod write-protobuf-as ((type (eql :proto)) (protobuf protobuf) stream
  36                               &key (indentation 0))
  37   (with-prefixed-accessors (name documentation syntax package imports optimize options) (proto- protobuf)
  38     (when documentation
  39       (write-protobuf-documentation type documentation stream :indentation indentation))
  40     (when syntax
  41       (format stream "~&syntax = \"~A\";~%~%" syntax))
  42     (when package
  43       (format stream "~&package ~A;~%~%" (substitute #\_ #\- package)))
  44     (when imports
  45       (dolist (import imports)
  46         (format stream "~&import \"~A\";~%" import))
  47       (terpri stream))
  48     (when optimize
  49       (format stream "~&option optimize_for ~A;~%~%"
  50               (if (eq optimize :space) "CODE_SIZE" "SPEED")))
  51     (when options
  52       (dolist (option options)
  53         (format stream "~&option ~:/protobuf-option/;~%" option))
  54       (terpri stream))
  55     (dolist (enum (proto-enums protobuf))
  56       (write-protobuf-as type enum stream :indentation indentation)
  57       (terpri stream))
  58     (dolist (msg (proto-messages protobuf))
  59       (write-protobuf-as type msg stream :indentation indentation)
  60       (terpri stream))
  61     (dolist (svc (proto-services protobuf))
  62       (write-protobuf-as type svc stream :indentation indentation)
  63       (terpri stream))))
  64
  65 (defmethod write-protobuf-documentation ((type (eql :proto)) docstring stream
  66                                          &key (indentation 0))
  67   (let ((lines (split-string docstring :separators '(#\newline #\return))))
  68     (dolist (line lines)
  69       (format stream "~&~@[~VT~]// ~A~%"
  70               (and (not (zerop indentation)) indentation) line))))
  71
  72
  73 (defmethod write-protobuf-as ((type (eql :proto)) (enum protobuf-enum) stream
  74                               &key (indentation 0))
  75   (with-prefixed-accessors (name class alias-for documentation options) (proto- enum)
  76     (when documentation
  77       (write-protobuf-documentation type documentation stream :indentation indentation))
  78     (format stream "~&~@[~VT~]enum ~A {~%"
  79             (and (not (zerop indentation)) indentation) name)
  80     (let ((other (and class (not (string= name (class-name->proto class))) class)))
  81       (when other
  82         (format stream "~&~VToption lisp_name = \"~A:~A\";~%"
  83                 (+ indentation 2) (package-name (symbol-package class)) (symbol-name class))))
  84     (when alias-for
  85       (format stream "~&~VToption lisp_alias = \"~A:~A\";~%"
  86               (+ indentation 2) (package-name (symbol-package alias-for)) (symbol-name alias-for)))
  87     (dolist (option options)
  88       (format stream "~&option ~:/protobuf-option/;~%" option))
  89     (dolist (value (proto-values enum))
  90       (write-protobuf-as type value stream :indentation (+ indentation 2)))
  91     (format stream "~&~@[~VT~]}~%"
  92             (and (not (zerop indentation)) indentation))))
  93
  94 (defparameter *protobuf-enum-comment-column* 56)
  95 (defmethod write-protobuf-as ((type (eql :proto)) (val protobuf-enum-value) stream
  96                               &key (indentation 0))
  97   (with-prefixed-accessors (name documentation index) (proto- val)
  98     (format stream "~&~@[~VT~]~A = ~D;~:[~*~*~;~VT// ~A~]~%"
  99             (and (not (zerop indentation)) indentation) name index
 100             documentation *protobuf-enum-comment-column* documentation)))
 101
 102
 103 (defmethod write-protobuf-as ((type (eql :proto)) (message protobuf-message) stream
 104                               &key (indentation 0))
 105   (with-prefixed-accessors (name class alias-for documentation options) (proto- message)
 106     (when documentation
 107       (write-protobuf-documentation type documentation stream :indentation indentation))
 108     (format stream "~&~@[~VT~]message ~A {~%"
 109             (and (not (zerop indentation)) indentation) name)
 110     (let ((other (and class (not (string= name (class-name->proto class))) class)))
 111       (when other
 112         (format stream "~&~VToption lisp_name = \"~A:~A\";~%"
 113                 (+ indentation 2) (package-name (symbol-package class)) (symbol-name class))))
 114     (when alias-for
 115       (format stream "~&~VToption lisp_alias = \"~A:~A\";~%"
 116               (+ indentation 2) (package-name (symbol-package alias-for)) (symbol-name alias-for)))
 117     (dolist (option options)
 118       (format stream "~&~VToption ~:/protobuf-option/;~%"
 119               (+ indentation 2) option))
 120     (dolist (enum (proto-enums message))
 121       (write-protobuf-as type enum stream :indentation (+ indentation 2)))
 122     (dolist (msg (proto-messages message))
 123       (write-protobuf-as type msg stream :indentation (+ indentation 2)))
 124     (dolist (field (proto-fields message))
 125       (write-protobuf-as type field stream :indentation (+ indentation 2)))
 126     (dolist (extension (proto-extensions message))
 127       (write-protobuf-as type extension stream :indentation (+ indentation 2)))
 128     (format stream "~&~@[~VT~]}~%"
 129             (and (not (zerop indentation)) indentation))))
 130
 131 (defparameter *protobuf-field-comment-column* 56)
 132 (defmethod write-protobuf-as ((type (eql :proto)) (field protobuf-field) stream
 133                               &key (indentation 0))
 134   (with-prefixed-accessors (name documentation required index default packed) (proto- field)
 135     (let ((dflt (if (stringp default)
 136                   (if (i= (length default) 0) nil default)
 137                   default)))
 138       (format stream "~&~@[~VT~]~(~A~) ~A ~A = ~D~@[ [default = ~A]~]~@[ [packed=true]~*~];~:[~*~*~;~VT// ~A~]~%"
 139               (and (not (zerop indentation)) indentation)
 140               required (proto-type field) name index dflt packed
 141               documentation *protobuf-field-comment-column* documentation))))
 142
 143 (defmethod write-protobuf-as ((type (eql :proto)) (extension protobuf-extension) stream
 144                               &key (indentation 0))
 145   (with-prefixed-accessors (from to) (proto-extension- extension)
 146     (format stream "~&~@[~VT~]extensions ~D to ~D;~%"
 147             (and (not (zerop indentation)) indentation)
 148             from to)))
 149
 150
 151 (defmethod write-protobuf-as ((type (eql :proto)) (service protobuf-service) stream
 152                               &key (indentation 0))
 153   (with-prefixed-accessors (name documentation) (proto- service)
 154     (when documentation
 155       (write-protobuf-documentation type documentation stream :indentation indentation))
 156     (format stream "~&~@[~VT~]service ~A {~%"
 157             (and (not (zerop indentation)) indentation) name)
 158     (dolist (method (proto-methods service))
 159       (write-protobuf-as type method stream :indentation (+ indentation 2)))
 160     (format stream "~&~@[~VT~]}~%"
 161             (and (not (zerop indentation)) indentation))))
 162
 163 (defmethod write-protobuf-as ((type (eql :proto)) (method protobuf-method) stream
 164                               &key (indentation 0))
 165   (with-prefixed-accessors (name documentation input-name output-name options) (proto- method)
 166     (when documentation
 167       (write-protobuf-documentation type documentation stream :indentation indentation))
 168     (format stream "~&~@[~VT~]rpc ~A (~@[~A~])~@[ returns (~A)~]"
 169             (and (not (zerop indentation)) indentation)
 170             name input-name output-name)
 171     (cond (options
 172            (format stream " {~%")
 173            (dolist (option options)
 174              (format stream "~&~@[~VT~]option ~:/protobuf-option/;~%"
 175                      (+ indentation 2) option))
 176            (format stream "~@[~VT~]}"
 177                    (and (not (zerop indentation)) indentation)))
 178           (t
 179            (format stream ";~%")))))
 180
 181
 182 ;;; Pretty print a schema as a .lisp file
 183
 184 (defmethod write-protobuf-as ((type (eql :lisp)) (protobuf protobuf) stream
 185                               &key (indentation 0))
 186   (with-prefixed-accessors (name class documentation package lisp-package imports optimize options) (proto- protobuf)
 187     (let ((lisp-pkg (and lisp-package
 188                          (or (null package) (not (string-equal lisp-package package))))))
 189       (when (or lisp-pkg package)
 190         (format stream "~&(in-package \"~A\")~%~%" (or lisp-pkg package)))
 191       (when documentation
 192         (write-protobuf-documentation type documentation stream :indentation indentation))
 193       (format stream "~&(proto:define-proto ~(~A~)" (or class name))
 194       (if (or package lisp-pkg imports optimize options documentation)
 195         (format stream "~%    (")
 196         (format stream " ("))
 197       (let ((spaces ""))
 198         (when package
 199           (format stream "~A:package ~A" spaces package)
 200           (when (or lisp-pkg imports optimize options documentation)
 201             (terpri stream))
 202           (setq spaces "     "))
 203         (when lisp-pkg
 204           (format stream "~A:lisp-package ~A" spaces lisp-pkg)
 205           (when (or imports optimize options documentation)
 206             (terpri stream))
 207           (setq spaces "     "))
 208         (when imports
 209           (cond ((= (length imports) 1)
 210                  (format stream "~A:import \"~A\"" spaces (car imports)))
 211                 (t
 212                  (format stream "~A:import (~{\"~A\"~^ ~})" spaces imports)))
 213           (when (or optimize options documentation)
 214             (terpri stream))
 215           (setq spaces "     "))
 216         (when optimize
 217           (format stream "~A:optimize ~(~S~)" spaces optimize)
 218           (when (or options documentation)
 219             (terpri stream))
 220           (setq spaces "     "))
 221         (when options
 222           (format stream "~A:options (~{~@/protobuf-option/~^ ~})" spaces options)
 223           (when documentation
 224             (terpri stream))
 225           (setq spaces "     "))
 226         (when documentation
 227           (format stream "~A:documentation ~S" spaces documentation)))
 228       (format stream ")"))
 229     (dolist (enum (proto-enums protobuf))
 230       (write-protobuf-as type enum stream :indentation 2))
 231     (dolist (msg (proto-messages protobuf))
 232       (write-protobuf-as type msg stream :indentation 2))
 233     (dolist (svc (proto-services protobuf))
 234       (write-protobuf-as type svc stream :indentation 2))
 235     (format stream ")~%")))
 236
 237 (defmethod write-protobuf-documentation ((type (eql :lisp)) docstring stream
 238                                          &key (indentation 0))
 239   (let ((lines (split-string docstring :separators '(#\newline #\return))))
 240     (dolist (line lines)
 241       (format stream "~&~@[~VT~];; ~A~%"
 242               (and (not (zerop indentation)) indentation) line))))
 243
 244
 245 (defmethod write-protobuf-as ((type (eql :lisp)) (enum protobuf-enum) stream
 246                               &key (indentation 0))
 247   (terpri stream)
 248   (with-prefixed-accessors (name class alias-for documentation) (proto- enum)
 249     (when documentation
 250       (write-protobuf-documentation type documentation stream :indentation indentation))
 251     (format stream "~@[~VT~](proto:define-enum ~(~S~)"
 252             (and (not (zerop indentation)) indentation) class)
 253     (let ((other (and name (not (string= name (class-name->proto class))) name)))
 254       (cond ((or other alias-for documentation)
 255              (format stream "~%~@[~VT~](~:[~*~*~;:name ~(~S~)~@[~%~VT~]~]~
 256                                         ~:[~*~*~;:alias-for ~(~S~)~@[~%~VT~]~]~
 257                                         ~:[~*~;:documentation ~S~])"
 258                      (+ indentation 4)
 259                      other other (and (or alias-for documentation) (+ indentation 5))
 260                      alias-for alias-for (and documentation (+ indentation 5))
 261                      documentation documentation))
 262             (t
 263              (format stream " ()"))))
 264     (loop for (value . more) on (proto-values enum) doing
 265       (write-protobuf-as type value stream :indentation (+ indentation 2))
 266       (when more
 267         (terpri stream)))
 268     (format stream ")")))
 269
 270 (defmethod write-protobuf-as ((type (eql :lisp)) (val protobuf-enum-value) stream
 271                               &key (indentation 0))
 272   (with-prefixed-accessors (value index) (proto- val)
 273     (format stream "~&~@[~VT~](~(~A~) ~D)"
 274             (and (not (zerop indentation)) indentation) value index)))
 275
 276
 277 (defmethod write-protobuf-as ((type (eql :lisp)) (message protobuf-message) stream
 278                               &key (indentation 0))
 279   (with-prefixed-accessors (name class alias-for conc-name documentation) (proto- message)
 280     (when documentation
 281       (write-protobuf-documentation type documentation stream :indentation indentation))
 282     (format stream "~&~@[~VT~](proto:define-message ~(~S~)"
 283             (and (not (zerop indentation)) indentation) class)
 284     (let ((other (and name (not (string= name (class-name->proto class))) name)))
 285       (cond ((or alias-for conc-name documentation)
 286              (format stream "~%~@[~VT~](~:[~*~*~;:name ~(~S~)~@[~%~VT~]~]~
 287                                         ~:[~*~*~;:alias-for ~(~S~)~@[~%~VT~]~]~
 288                                         ~:[~*~*~;:conc-name ~(~S~)~@[~%~VT~]~]~
 289                                         ~:[~*~;:documentation ~S~])"
 290                      (+ indentation 4)
 291                      other other (and (or alias-for conc-name documentation) (+ indentation 5))
 292                      alias-for alias-for (and (or documentation conc-name) (+ indentation 5))
 293                      conc-name conc-name (and documentation (+ indentation 5))
 294                      documentation documentation))
 295             (t
 296              (format stream " ()"))))
 297     (loop for (enum . more) on (proto-enums message) doing
 298       (write-protobuf-as type enum stream :indentation (+ indentation 2))
 299       (when more
 300         (terpri stream)))
 301     (loop for (msg . more) on (proto-messages message) doing
 302       (write-protobuf-as type msg stream :indentation (+ indentation 2))
 303       (when more
 304         (terpri stream)))
 305     (loop for (field . more) on (proto-fields message) doing
 306       (write-protobuf-as type field stream :indentation (+ indentation 2))
 307       (when more
 308         (terpri stream)))
 309     (loop for (extension . more) on (proto-extensions message) doing
 310       (write-protobuf-as type extension stream :indentation (+ indentation 2))
 311       (when more
 312         (terpri stream)))
 313     (format stream ")")))
 314
 315 (defparameter *protobuf-slot-comment-column* 56)
 316 (defmethod write-protobuf-as ((type (eql :lisp)) (field protobuf-field) stream
 317                               &key (indentation 0))
 318   (with-prefixed-accessors (value reader class documentation required default) (proto- field)
 319     (let ((dflt (protobuf-default-to-clos-init default class))
 320           (clss (let ((cl (case class
 321                             ((:int32 :uint32 :int64 :uint64 :sint32 :sint64
 322                               :fixed32 :sfixed32 :fixed64 :sfixed64) 'integer)
 323                             ((:single) 'float)
 324                             ((:double) 'double-float)
 325                             ((:bool)   'boolean)
 326                             ((:string) 'string)
 327                             ((:symbol) 'symbol)
 328                             (otherwise class))))
 329                   (cond ((eq required :optional)
 330                          `(or null ,cl))
 331                         ((eq required :repeated)
 332                          `(list-of ,cl))
 333                         (t cl)))))
 334       (format stream (if (keywordp class)
 335                        ;; Keyword means a primitive type, print default with ~S
 336                        "~&~@[~VT~](~(~S~) :type ~(~S~)~@[ :default ~S~]~@[ :reader ~(~S~)~])~:[~*~*~;~VT; ~A~]"
 337                        ;; Non-keyword must mean an enum type, print default with ~A
 338                        "~&~@[~VT~](~(~S~) :type ~(~S~)~@[ :default ~(:~A~)~]~@[ :reader ~(~S~)~])~:[~*~*~;~VT; ~A~]")
 339               (and (not (zerop indentation)) indentation)
 340               value clss dflt reader
 341               documentation *protobuf-slot-comment-column* documentation))))
 342
 343 (defmethod write-protobuf-as ((type (eql :lisp)) (extension protobuf-extension) stream
 344                               &key (indentation 0))
 345   (with-prefixed-accessors (from to) (proto-extension- extension)
 346     (format stream "~&~@[~VT~](define-extension ~D ~D)"
 347             (and (not (zerop indentation)) indentation)
 348             from to)))
 349
 350
 351 (defmethod write-protobuf-as ((type (eql :lisp)) (service protobuf-service) stream
 352                               &key (indentation 0))
 353   (with-prefixed-accessors (class documentation conc-name) (proto- service)
 354     (when documentation
 355       (write-protobuf-documentation type documentation stream :indentation indentation))
 356     (format stream "~&~@[~VT~](proto:define-service ~(~S~)"
 357             (and (not (zerop indentation)) indentation) (proto-class service))
 358     (cond (documentation
 359            (format stream "~%~@[~VT~](:documentation ~S)"
 360                    (+ indentation 4) documentation))
 361           (t
 362            (format stream " ()")))
 363     (loop for (method . more) on (proto-methods service) doing
 364       (write-protobuf-as type method stream :indentation (+ indentation 2))
 365       (when more
 366         (terpri stream)))
 367     (format stream ")")))
 368
 369 (defmethod write-protobuf-as ((type (eql :lisp)) (method protobuf-method) stream
 370                               &key (indentation 0))
 371   (with-prefixed-accessors
 372       (function documentation input-type output-type options) (proto- method)
 373     (when documentation
 374       (write-protobuf-documentation type documentation stream :indentation indentation))
 375     (format stream "~&~@[~VT~](~(~S~) (~(~S~) ~(~S~))"
 376             (and (not (zerop indentation)) indentation)
 377             function input-type output-type)
 378     (when options
 379       (format stream "~%~VT:options (~{~@/protobuf-option/~^ ~})"
 380               (+ indentation 2) options))
 381     (format stream ")")))