JSON解析簡單實現 之二

之前曾寫過一次JSON解析，藉助了讀取器的功能，可惜效果不太令人滿意。今天閒來無事，實現原生解析。

本次實現有以下缺限：

   1、沒有充分優化代碼

   2、沒有考慮轉義字符解析（待後續實現）

;JSON 解析 WHJ.V1.20200119
;--------------------------------------------------------------------------------------------
;JSON object
(defclass JSON-OBJECT nil
    ((parent :initarg :parent
             :accessor parent
             :initform nil)
     (object-type :initarg :object-type
                  :accessor object-type)))
;atom
(defclass JSON-ATOM (JSON-OBJECT)
    ((value :initarg :value
            :accessor value)))
;key:value
(defclass JSON-KV (JSON-OBJECT)
    ((key :initarg :key
          :accessor key)
     (value :initarg :value
            :accessor value)))
;hash object
(defclass JSON-HASH (JSON-OBJECT)
    ((kv-list :initarg :kv-list
              :accessor kv-list)))
;json array
(defclass JSON-ARRAY (JSON-OBJECT)
    ((value-list :initarg :value-list
                 :accessor value-list)))
                 
(defun json-object-p (obj)
    (member (type-of obj) '(JSON-OBJECT JSON-ATOM JSON-KV JSON-ARRAY JSON-HASH)))
;--------------------------------------------------------------------------------------------
(defgeneric read-json-object (JSON-OBJECT IN-STREAM));從流中讀取對象
(defgeneric add-json-object (PARENT CHILD));將child對象添加到parent中
(defgeneric json-object-empty-p (JSON-OBJECT));對象是否爲空
(defgeneric json-object-string (JSON-OBJECT));轉換爲字符串格式
;--------------------------------------------------------------------------------------------
;;;; read until char.
(defun read-until (IN-STREAM CHAR)
    (let ((char-array (make-array 20 :adjustable t :fill-pointer 0)))
        (do ((x (read-char IN-STREAM nil nil) (read-char IN-STREAM nil nil)))
            ((or (null x) (char= x CHAR)))
            (vector-push-extend x char-array))
        (coerce char-array 'string)))
(defun whitespace-p (char)
    (member char '(#\tab #\space #\return #\newline)))
;;;; 忽略流中的空白字符
(defun read-skip-whitespace (IN-STREAM)
    (let ((char-array (make-array 20 :adjustable t :fill-pointer 0))
          (tmp-char nil))
          
        (psetq tmp-char (read-char IN-STREAM nil nil))
        (do  nil
            ((or (null tmp-char) (not (whitespace-p tmp-char))))
            (vector-push-extend tmp-char char-array)
            (psetq tmp-char (read-char IN-STREAM nil nil)))
            
        (when tmp-char
            (unread-char tmp-char IN-STREAM))

        (coerce char-array 'string)))
;;;; 判斷下一個讀取的值的類型.當 value-p 爲t時說明是一個原子類型
(defun next-object-type (IN-STREAM &key (value-p nil))
    (read-skip-whitespace IN-STREAM); skip whitespace
    (let ((char (read-char IN-STREAM nil nil)))
        (prog1
            (cond
                ((null char) 'JSON-ATOM);讀取完畢
                ((char= char #\{) 'JSON-HASH)
                ((char= char #\[) 'JSON-ARRAY)
                (value-p 'JSON-ATOM)
                (t 'JSON-KV))
            (when char (unread-char char IN-STREAM)))))
(defun read-object-value (IN-STREAM)
    (let ((char-array (make-array 20 :adjustable t :fill-pointer 0))
          (tmp-char nil))
          
        (psetq tmp-char (read-char IN-STREAM nil))
        (do  nil
            ((or (null tmp-char) 
                 (member tmp-char '(#\, #\} #\]))))
            (vector-push-extend tmp-char char-array)
            (psetq tmp-char (read-char IN-STREAM nil)))

        (coerce char-array 'string)))
;--------------------------------------------------------------------------------------------
(defmethod initialize-instance :after ((obj JSON-ATOM) &key)
    (setf (object-type obj) 'JSON-ATOM))
(defmethod initialize-instance :after ((kv JSON-KV) &key)
    (setf (object-type kv) 'JSON-KV))
(defmethod initialize-instance :after ((hash JSON-HASH) &key)
    (setf (object-type hash) 'JSON-HASH
          (kv-list hash) (make-array 10 :adjustable t :fill-pointer 0)))
(defmethod initialize-instance :after ((arr JSON-ARRAY) &key)
    (setf (object-type arr) 'JSON-ARRAY
          (value-list arr) (make-array 10 :adjustable t :fill-pointer 0)))
;--------------------------------------------------------------------------------------------
(defmethod json-object-empty-p ((obj JSON-ATOM))
    (let ((value (value obj)))
        (or (null value) (string= value ""))))
(defmethod json-object-empty-p ((kv JSON-KV))
    (let ((key (key kv)))
        (or (null key) (string= key ""))))
(defmethod json-object-empty-p ((hash JSON-HASH))
    (= (length (kv-list hash)) 0))
(defmethod json-object-empty-p ((arr JSON-ARRAY))
    (= (length (value-list arr)) 0))

(defmethod read-json-object ((obj JSON-ATOM) IN-STREAM)
    (setf (value kv) (read-object-value IN-STREAM)))
(defmethod read-json-object ((kv JSON-KV) IN-STREAM)
    (setf (key kv) (read-until IN-STREAM #\:)
          (value kv) (read-until IN-STREAM #\,)))

(defmethod read-json-object ((arr JSON-ARRAY) IN-STREAM)
    (read-char IN-STREAM);ignore "["
    (read-skip-whitespace IN-STREAM); ignore whitespace
    (do nil
        (nil)
        
        (let ((tmp-item nil))
            (psetq  tmp-item 
                   (read-json-object (make-instance (next-object-type IN-STREAM :value-p t) :parent arr) 
                                     IN-STREAM))
                                     
            (read-skip-whitespace IN-STREAM); ignore whitespace
            (cond
                ((and (stringp tmp-item) 
                      (string= tmp-item ""))
                    (return))
                ((and (json-object-p tmp-item) 
                      (json-object-empty-p tmp-item))
                    (return))
                (t (add-json-object arr tmp-item)))))
    arr)
(defmethod read-json-object ((hash JSON-HASH) IN-STREAM)
    (read-char IN-STREAM);ignore "{"
    (read-skip-whitespace IN-STREAM); ignore whitespace
    (do nil
        (nil)
        
        
        (let ((kv (make-instance 'json-kv :parent hash)))
            (setf (key kv) (read-until IN-STREAM #\:))
            (when (json-object-empty-p kv) (return))
            (setf  (value kv) (read-json-object (make-instance (next-object-type IN-STREAM :value-p t) :parent hash) IN-STREAM))
            (add-json-object hash kv))
        
        (read-skip-whitespace IN-STREAM)  
        (let ((tmp-char (read-char IN-STREAM nil)))
            (cond 
                ((null tmp-char) (return))
                ((member tmp-char '(#\, #\] #\})) (return)))))
               ; (t (unread-char tmp-char IN-STREAM)))))
    hash)

;--------------------------------------------------------------------------------------------
;add child into parent json-hash-object   
(defmethod add-json-object ((PARENT JSON-HASH) (CHILD JSON-OBJECT))
   (setf (parent CHILD) PARENT)
   (vector-push-extend CHILD (kv-list PARENT)))
(defmethod add-json-object ((PARENT JSON-ARRAY) (CHILD JSON-OBJECT))
   (setf (parent CHILD) PARENT)
   (vector-push-extend CHILD (value-list PARENT)))
(defmethod add-json-object ((PARENT JSON-ARRAY) CHILD)
    (vector-push-extend CHILD (value-list PARENT)))
;--------------------------------------------------------------------------------------------
;for test function
(defmethod json-object-string ((obj JSON-KV))
    (format nil "<~a ~a ~a ~a>" (object-type obj) (parent obj) (key obj) (value obj)))
(defmethod json-object-string ((obj JSON-ARRAY))
    (format nil "<~a ~a ~a>" (object-type obj) (parent obj) (value-list obj)))
(defmethod json-object-string ((obj JSON-HASH))
    (format nil "<~a ~a ~a>" (object-type obj) (parent obj) (kv-list obj)))
;--------------------------------------------------------------------------------------------
;for test examples.
(defun test nil
    (loop for i from 1 to 9
        collect (funcall (intern (format nil "TEST-~d" i)))))

(defun test-1 nil 
    (let ((in (make-string-input-stream "{\"Wang\":123,\"ok\":\"test\"}")))
         (unwind-protect
            (read-json-object (make-instance (next-object-type in) :parent nil) in)
            (close in))))
(defun test-2 nil
    (let ((in (make-string-input-stream "{\"Wang\":[1,2,3,4],\"ok\":[\"test\"]}")))
         (unwind-protect
            (read-json-object (make-instance (next-object-type in) :parent nil) in)
            (close in))))
            
(defun test-3 nil
    (let ((in (make-string-input-stream "[1,2,3,4,\"test\"]")))
         (unwind-protect
            (read-json-object (make-instance (next-object-type in) :parent nil) in)
            (close in))))
(defun test-4 nil
    (let ((in (make-string-input-stream "[[1,2,3,4,\"test\"]]")))
         (unwind-protect
            (read-json-object (make-instance (next-object-type in) :parent nil) in)
            (close in))))
(defun test-5 nil
    (let ((in (make-string-input-stream "[[1,2,3,{test:check it},\"test\"]]")))
         (unwind-protect
            (read-json-object (make-instance (next-object-type in) :parent nil) in)
            (close in))))
(defun test-6 nil
    (let ((in (make-string-input-stream "[1,[2,3],{test:check it},\"test\"]")))
         (unwind-protect
            (read-json-object (make-instance (next-object-type in) :parent nil) in)
            (close in))))
(defun test-7 nil
    (let ((in (make-string-input-stream "[{test:check it},\"test\"]")))
         (unwind-protect
            (read-json-object (make-instance (next-object-type in) :parent nil) in)
            (close in))))
            
(defun test-8 nil
    (let ((in (make-string-input-stream "[{ test:[check, it]},\"test\"]")))
         (unwind-protect
            (read-json-object (make-instance (next-object-type in) :parent nil) in)
            (close in))))
(defun test-9 nil
    (let ((in (make-string-input-stream "{ ok: { test:[check, it]},\"test\":123}")))
         (unwind-protect
            (read-json-object (make-instance (next-object-type in) :parent nil) in)
            (close in))))
;--------------------------------------------------------------------------------------------