<commit_before>;;; Copyright 2012-2020 Google LLC
;;;
;;; Use of this source code is governed by an MIT-style
;;; license that can be found in the LICENSE file or at
;;; https://opensource.org/licenses/MIT.

(in-package "PROTO-IMPL")


;;; Print objects using Protobufs text format

(defun print-text-format (object &key (stream *standard-output*)
                                 (print-name t)
                                 (suppress-pretty-print nil))
  "Prints a protocol buffer message to a stream.
Parameters:
  OBJECT: The protocol buffer message to print.
  STREAM: The stream to print to.
  PRINT-NAME: Bool for printing the name of the top level proto message.
  SUPPRESS-PRETTY-PRINT: When true, don't generate line breaks and other human readable output
    in the text format."
  (let* ((type    (type-of object))
         (message (find-message-for-class type)))
    (assert message ()
            "There is no Protobuf message having the type ~S" type)
    (macrolet ((read-slot (object slot reader)
                 `(if ,reader
                      (funcall ,reader ,object)
                      (slot-value ,object ,slot))))
      (labels ((has-struct-field-p (object field)
                 ;; If a field doesn't have an offset it's an extension.
                 ;; Call slot-value to avoid generic dispatch.
                 (if (slot-value field 'field-offset)
                     (= (bit (slot-value object '%%is-set)
                             (proto-field-offset field))
                        1)
                     (has-extension object (proto-internal-field-name field))))
               (do-field (object indent field)
                 ;; We don't do cycle detection here
                 ;; If the client needs it, he can define his own 'print-text-format'
                 ;; method to clean things up first
                 (let* ((type   (proto-class field))
                        (slot   (proto-internal-field-name field))
                        (reader (proto-reader field))
                        msg)
                   (when (has-struct-field-p object field)
                     (cond ((eq (proto-label field) :repeated)
                            (cond ((keywordp type)
                                   (doseq (v (read-slot object slot reader))
                                     (print-prim v type field stream
                                                 (or suppress-pretty-print indent))))
                                  ((typep (setq msg (and type (or (find-message type)
                                                                  (find-enum type)
                                                                  (find-type-alias type))))
                                          'message-descriptor)
                                   (let ((values (if slot (read-slot object slot reader) (list object))))
                                     (when values
                                       (let ((indent (+ indent 2)))
                                         (dolist (v values)
                                           (if suppress-pretty-print
                                               (format stream "~A { " (proto-name field))
                                               (format stream "~&~VT~A {~%" indent (proto-name field)))
                                           (dolist (f (proto-fields msg))
                                             (do-field v indent f))
                                           (if suppress-pretty-print
                                               (format stream "} ")
                                               (format stream "~&~VT}~%" indent)))))))
                                  ((typep msg 'protobuf-enum)
                                   (doseq (v (read-slot object slot reader))
                                     (print-enum v msg field stream
                                                 (or suppress-pretty-print indent))))
                                  ((typep msg 'protobuf-type-alias)
                                   (let ((type (proto-proto-type msg)))
                                     (doseq (v (read-slot object slot reader))
                                       (let ((v (funcall (proto-serializer msg) v)))
                                         (print-prim v type field stream
                                                     (or suppress-pretty-print indent))))))
                                  (t
                                   (undefined-field-type "While printing ~S to text format,"
                                                         object type field))))
                           (t
                            (cond ((keywordp type)
                                   (let ((v (read-slot object slot reader)))
                                     (print-prim v type field stream
                                                 (or suppress-pretty-print indent))))
                                  ((typep (setq msg (and type (or (find-message type)
                                                                  (find-enum type)
                                                                  (find-type-alias type))))
                                          'message-descriptor)
                                   (let ((v (if slot (read-slot object slot reader) object)))
                                     (when v
                                       (let ((indent (+ indent 2)))
                                         (if suppress-pretty-print
                                             (format stream "~A { " (proto-name field))
                                             (format stream "~&~VT~A {~%" indent (proto-name field)))
                                         (dolist (f (proto-fields msg))
                                           (do-field v indent f))
                                         (if suppress-pretty-print
                                             (format stream "} ")
                                             (format stream "~&~VT}~%" indent))))))
                                  ((typep msg 'protobuf-enum)
                                   (let ((v (read-slot object slot reader)))
                                     (when (and v (not (eql v (proto-default field))))
                                       (print-enum v msg field stream
                                                   (or suppress-pretty-print indent)))))
                                  ((typep msg 'protobuf-type-alias)
                                   (let ((v (read-slot object slot reader)))
                                     (when v
                                       (let ((v    (funcall (proto-serializer msg) v))
                                             (type (proto-proto-type msg)))
                                         (print-prim v type field stream
                                                     (or suppress-pretty-print indent))))))
                                  (t
                                   (undefined-field-type "While printing ~S to text format,"
                                                         object type field)))))))))
        (declare (dynamic-extent #'do-field))
        (if print-name
            (if suppress-pretty-print
                (format stream "~A { " (proto-name message))
                (format stream "~&~A {~%" (proto-name message)))
            (format stream "{"))
        (dolist (f (proto-fields message))
          (do-field object 0 f))
        (if suppress-pretty-print
            (format stream "}")
            (format stream "~&}~%"))
        nil))))

(defun print-prim (val type field stream indent)
  (when (or val (eq type :bool))
    (if (eq indent 't)
      (format stream "~A: " (proto-name field))
      (format stream "~&~VT~A: " (+ indent 2) (proto-name field)))
    (ecase type
      ((:int32 :uint32 :int64 :uint64 :sint32 :sint64
        :fixed32 :sfixed32 :fixed64 :sfixed64)
       (format stream "~D" val))
      ((:string)
       (format stream "\"~A\"" val))
      ((:bytes)
       (format stream "~S" val))
      ((:bool)
       (format stream "~A" (if val "true" "false")))
      ((:float :double)
       (format stream "~D" val))
      ;; A few of our homegrown types
      ((:symbol)
       (let ((val (if (keywordp val)
                    (string val)
                    (format nil "~A:~A" (package-name (symbol-package val)) (symbol-name val)))))
         (format stream "\"~A\"" val)))
      ((:date :time :datetime :timestamp)
       (format stream "~D" val)))
    (if (eq indent 't)
      (format stream " ")
      (format stream "~%"))))

(defun print-enum (val enum field stream indent)
  (when val
    (if (eq indent 't)
      (format stream "~A: " (proto-name field))
      (format stream "~&~VT~A: " (+ indent 2) (proto-name field)))
    (let ((name (let ((e (find (keywordify val)
                               (protobuf-enum-values enum)<commit_msg>Add support for printing map fields to text<commit_after>;;; Copyright 2012-2020 Google LLC
;;;
;;; Use of this source code is governed by an MIT-style
;;; license that can be found in the LICENSE file or at
;;; https://opensource.org/licenses/MIT.

(in-package "PROTO-IMPL")


;;; Print objects using Protobufs text format

(defun print-text-format (object &key (stream *standard-output*)
                                 (print-name t)
                                 (suppress-pretty-print nil))
  "Prints a protocol buffer message to a stream.
Parameters:
  OBJECT: The protocol buffer message to print.
  STREAM: The stream to print to.
  PRINT-NAME: Bool for printing the name of the top level proto message.
  SUPPRESS-PRETTY-PRINT: When true, don't generate line breaks and other human readable output
    in the text format."
  (let* ((type    (type-of object))
         (message (find-message-for-class type)))
    (assert message ()
            "There is no Protobuf message having the type ~S" type)
    (macrolet ((read-slot (object slot reader)
                 `(if ,reader
                      (funcall ,reader ,object)
                      (slot-value ,object ,slot))))
      (labels ((has-struct-field-p (object field)
                 ;; If a field doesn't have an offset it's an extension.
                 ;; Call slot-value to avoid generic dispatch.
                 (if (slot-value field 'field-offset)
                     (= (bit (slot-value object '%%is-set)
                             (proto-field-offset field))
                        1)
                     (has-extension object (proto-internal-field-name field))))
               (do-field (object indent field)
                 ;; We don't do cycle detection here
                 ;; If the client needs it, he can define his own 'print-text-format'
                 ;; method to clean things up first
                 (let* ((type   (proto-class field))
                        (slot   (proto-internal-field-name field))
                        (reader (proto-reader field))
                        msg)
                   (when (has-struct-field-p object field)
                     (cond ((eq (proto-label field) :repeated)
                            (cond ((keywordp type)
                                   (doseq (v (read-slot object slot reader))
                                     (print-prim v type field stream
                                                 (or suppress-pretty-print indent))))
                                  ((typep (setq msg (and type (or (find-message type)
                                                                  (find-enum type)
                                                                  (find-type-alias type))))
                                          'message-descriptor)
                                   (let ((values (if slot (read-slot object slot reader) (list object))))
                                     (when values
                                       (let ((indent (+ indent 2)))
                                         (dolist (v values)
                                           (if suppress-pretty-print
                                               (format stream "~A { " (proto-name field))
                                               (format stream "~&~VT~A {~%" indent (proto-name field)))
                                           (dolist (f (proto-fields msg))
                                             (do-field v indent f))
                                           (if suppress-pretty-print
                                               (format stream "} ")
                                               (format stream "~&~VT}~%" indent)))))))
                                  ((typep msg 'protobuf-enum)
                                   (doseq (v (read-slot object slot reader))
                                     (print-enum v msg field stream
                                                 (or suppress-pretty-print indent))))
                                  ((typep msg 'protobuf-type-alias)
                                   (let ((type (proto-proto-type msg)))
                                     (doseq (v (read-slot object slot reader))
                                       (let ((v (funcall (proto-serializer msg) v)))
                                         (print-prim v type field stream
                                                     (or suppress-pretty-print indent))))))
                                  (t
                                   (undefined-field-type "While printing ~S to text format,"
                                                         object type field))))
                           (t
                            (cond ((keywordp type)
                                   (let ((v (read-slot object slot reader)))
                                     (print-prim v type field stream
                                                 (or suppress-pretty-print indent))))
                                  ((typep (setq msg (and type (or (find-message type)
                                                                  (find-enum type)
                                                                  (find-type-alias type))))
                                          'message-descriptor)
                                   (let ((v (if slot (read-slot object slot reader) object)))
                                     (when v
                                       (let ((indent (+ indent 2)))
                                         (if suppress-pretty-print
                                             (format stream "~A { " (proto-name field))
                                             (format stream "~&~VT~A {~%" indent (proto-name field)))
                                         (dolist (f (proto-fields msg))
                                           (do-field v indent f))
                                         (if suppress-pretty-print
                                             (format stream "} ")
                                             (format stream "~&~VT}~%" indent))))))
                                  ((typep msg 'protobuf-enum)
                                   (let ((v (read-slot object slot reader)))
                                     (when (and v (not (eql v (proto-default field))))
                                       (print-enum v msg field stream
                                                   (or suppress-pretty-print indent)))))
                                  ((typep msg 'protobuf-type-alias)
                                   (let ((v (read-slot object slot reader)))
                                     (when v
                                       (let ((v    (funcall (proto-serializer msg) v))
                                             (type (proto-proto-type msg)))
                                         (print-prim v type field stream
                                                     (or suppress-pretty-print indent))))))
                                  (t
                                   (undefined-field-type "While printing ~S to text format,"
                                                         object type field)))))))))
        (declare (dynamic-extent #'do-field))
        (if print-name
            (if suppress-pretty-print
                (format stream "~A { " (proto-name message))
                (format stream "~&~A {~%" (proto-name message)))
            (format stream "{"))
        (dolist (f (proto-fields message))
          (do-field object 0 f))
        (if suppress-pretty-print
            (format stream "}")
            (format stream "~&}~%"))
        nil))))

(defun print-prim (val type field stream indent &optional (newline-p t))
  (when (or val (eq type :bool))
    (unless (eq indent 't)
        (format stream "~&~VT" (+ indent 2)))
    (if field
      (format stream "~A: " (proto-name field)))
    (ecase type
      ((:int32 :uint32 :int64 :uint64 :sint32 :sint64
        :fixed32 :sfixed32 :fixed64 :sfixed64)
       (format stream "~D" val))
      ((:string)
       (format stream "\"~A\"" val))
      ((:bytes)
       (format stream "~S" val))
      ((:bool)
       (format stream "~A" (if val "true" "false")))
      ((:float :double)
       (format stream "~D" val))
      ; todo(benkuehnert): Sort output by key value.
      ((:map)
       (let ((key-type (proto-type->keyword
                        (second (proto-set-type field))))
             (val-type (proto-type->keyword
                        (third  (proto-set-type field)))))
         (flet ((print-entry (k v)
                  (print-prim k key-type nil stream (+ 2 indent) nil)
                  (format stream "-> ")
                  (if (keywordp val-type)
                      (print-prim v val-type nil stream t)
                      (print-text-format v :stream stream :suppress-pretty-print t))))
           (format stream "~%")
           (maphash #'print-entry val))))
      ;; A few of our homegrown types
      ((:symbol)
       (let ((val (if (keywordp val)
                    (string val)
                    (format nil "~A:~A" (package-name (symbol-package val)) (symbol-name val)))))
         (format stream "\"~A\"" val)))
      ((:date :time :datetime :timestamp)
       (format stream "~D" val)))
    (if (and (not (eq indent 't)) newline-p)
      (format stream "~%")
      (format stream " "))))

(defun print-enum (val enum field stream indent)
  (when val
    (if (eq indent 't)
      (format stream "~A: " (proto-name field))
      (format stream "~&~VT~A: " (+ indent 2) (proto-name field)))
    (let ((name (let ((e (find (keywordify val)
                               (protobuf-enum-values enum)
{'fraction_non_alphanumeric': 0.10445778651506296, 'fraction_numerical': 0.003666117634557144, 'mean_word_length': 0.979179810725552, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 6, 'https://': 2, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 210, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '460383', 'n_tokens_mistral': 4260, 'n_tokens_neox': 3989, 'n_words': 1384}