src/discard.lisp @ 2a95e54cdcac

(in-package :jarl)

;; Optimized reader for cases where you just want to make sure the JSON parses
;; but don't want to allocate all the internal objects.


(defun discard-hex-digit (input)
  (let ((ch (r input)))
    (if (eql :eof ch)
      (e nil input "cannot parse \\u escape sequence, got ~S" :eof)
      (or (digit-char-p ch 16)
          (e nil input "cannot parse \\u escape sequence, ~S is not a hexadecimal digit" ch)))))

(defun discard-escaped-character (input)
  (let ((ch (r input)))
    (case ch
      ((#\" #\\ #\/ #\b #\f #\n #\r #\t) nil)
      (#\u (loop :repeat 4 :do (discard-hex-digit input)))
      (t (e nil input "bad escape sequence ~S ~S" #\\ ch))))
  nil)

(defun discard-literal (string input)
  (loop :for next :across string
        :for char = (r input)
        :unless (eql next char)
        :do (e nil input "expected ~S when parsing ~S but got ~S" next string char)))

(defun discard-array (input)
  (r input) ; [
  (incf-depth input)
  (skip-whitespace input)
  (if (eql (p input) #\])
    (progn (decf-depth input)
           (r input))
    (loop (discard-any input)
          (skip-whitespace input)
          (let ((ch (r input)))
            (case ch
              (#\] (decf-depth input) (return))
              (#\, (skip-whitespace input))
              (t (e nil input "expected ~S or ~S but got ~S." #\] #\, ch)))))))

(defun discard-object (input)
  (r input) ; {
  (incf-depth input)
  (skip-whitespace input)
  (if (eql (p input) #\})
    (progn (decf-depth input)
           (r input))
    (loop (discard-string input)
          (parse-kv-separator nil input)
          (discard-any input)
          (skip-whitespace input)
          (let ((ch (r input)))
            (case ch
              (#\} (decf-depth input) (return))
              (#\, (skip-whitespace input))
              (t (e nil input "expected ~S or ~S but got ~S" #\} #\, ch)))))))

(defun discard-string (input)
  (let ((ch (r input)))
    (unless (eql ch #\")
      (e nil input "expected opening ~S but got ~S" #\" ch)))
  (loop :for ch = (r input)
        :do (case ch
              (:eof (e nil input "got ~S" :eof))
              (#\\ (discard-escaped-character input))
              (#\" (return))
              (t (if (requires-escape-p ch)
                   (e nil input "bad unescaped character ~S" ch)
                   nil)))))

(defun discard-int (input &optional (allow-leading-zero t))
  (loop :for n :from 0
        :for ch = (p input #\e)
        :for digit = (digit-char-p ch)
        :while digit
        :do (progn (r input)
                   (when (and (not allow-leading-zero)
                              (zerop n) ; leading
                              (zerop digit) ; zero
                              (digit-char-p (p input #\e))) ; but not a bare zero
                     (e nil input "bad leading zero")))
        :finally (when (zerop n)
                   (e nil input "expected an integer"))))

(defun discard-exponent (input)
  (when (member (p input) '(#\+ #\-))
    (r input))
  (discard-int input))

(defun discard-number (input)
  (when (eql #\- (p input))
    (r input))
  (discard-int input nil)
  (when (eql #\. (p input))
    (r input)
    (discard-int input))
  (when (member (p input) '(#\e #\E))
    (r input)
    (discard-exponent input)))

(defun discard-any (input)
  (case (p input)
    (:eof (r input) (e 'discard-json input "got ~S" :eof))
    (#\n (discard-literal "null" input))
    (#\t (discard-literal "true" input))
    (#\f (discard-literal "false" input))
    (#\" (discard-string input))
    (#\{ (discard-object input))
    (#\[ (discard-array input))
    ((#\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (discard-number input))
    (t (e nil input "unexpected character ~S" (r input)))))


(defmethod read% ((class (eql 'nil)) contained-class input)
  (skip-whitespace input)
  (discard-any input)
  (values))