path: root/src/json/json.lisp

(in-package :json)

(defparameter *json* "{\"hello\": 55}")

(defclass json-okur ()
  ((arabellek :accessor arabellek
              :initarg :arabellek
              :type string)
   (uzunluk :accessor uzunluk
            :initarg :uzunluk
            :type integer)
   (i :accessor i
      :initform 0
      :type integer)
   (ch :accessor ch
       :type character)
   (ch2 :accessor ch2
        :type character)))

(defparameter +eof+ (code-char 0))

(defun eof? (ch)
  (char= +eof+ ch))

(defun yeni (arabellek &optional (uzunluk (length arabellek)))
  (let ((okur (make-instance 'json-okur :arabellek arabellek :uzunluk uzunluk)))
    (char-gözat! okur)
    okur))

(defmethod reset ((o json-okur))
  (setf (i o) 0)
  (char-gözat! o))

(defmethod index ((o json-okur))
  (- (i o) 2))

(defmethod char-oynat ((o json-okur))
  (setf (ch o) (ch2 o))
  (char-gözat! o)
  (ch o))

(defmethod char-gözat ((o json-okur))
  (ch2 o))

(defmethod char-gözat! ((o json-okur))
  "Sonraki karaktere bak ve kaydet"
  (with-slots (i uzunluk arabellek ch2) o
    (cond ((array-in-bounds-p arabellek i)
           (setf ch2 (aref arabellek i))
           (incf i))
          (t
           (setf ch2 +eof+)
           (incf i)))))

(defun boşluk? (ch)
  (find ch #(#\Space #\Newline #\Return #\Tab)))

(defmethod boşluk-geç ((o json-okur))
  (loop :while (boşluk? (char-gözat o))
        :do (char-oynat o)))

(defmethod metin-oku ((o json-okur))
  (let* ((baş (+ 1 (index o))))
    (loop :for char := (char-oynat o)
          :until (char= #\" char))
    (subseq (arabellek o) baş (index o))))

(defmethod rakam? (ch)
  (char<= #\0 ch #\9))

(defmethod sayı-oku ((o json-okur))
  (let* ((baş (index o)))
    (loop :for char := (char-gözat o)
          :while (rakam? char)
          :do (char-oynat o))
    (tamsayı-pars (arabellek o) baş (index o))))

(let ((sıfır (char-code #\0)))
  (defun tamsayı-pars (str baş son)
    (let ((sayı 0))
      (loop :for i :from baş :upto son
            :do (setf sayı (+ (* 10 sayı)
                              (- (char-code (aref str i)) sıfır))))
      sayı)))

(defmethod literal-beklenti ((o json-okur) str tok)
  (loop :for ch := (char-gözat o)
        :for beklenen-ch :across str
        :if (char= ch beklenen-ch)
          :do (char-oynat o)
        :else
          :do (error "json: tanımlı olmayan literal değer"))
  tok)

(defmethod token-oku ((o json-okur))
  (case (char-oynat o)
    (#\{ :süslü-aç)
    (#\} :süslü-kapa)
    (#\: :iki-nokta)
    (#\" (values :string (metin-oku o)))
    (#\, :virgül)
    (#\[ :köşeli-aç)
    (#\] :köşeli-kapa)
    (#\n (literal-beklenti o "ull" :null))
    (#\f (literal-beklenti o "alse" :false))
    (#\t (literal-beklenti o "rue" :true))
    (otherwise (cond ((rakam? (ch o))
                      (values :sayı (sayı-oku o)))
                     ((boşluk? (ch o))
                      (boşluk-geç o)
                      (token-oku o))
                     ((eof? (ch o))
                      :eof)
                     (t (error "json: beklenmeyen char ~c" (ch o)))))))



(defclass json-parser ()
  ((okur :accessor okur :initarg :okur :type json-okur)
   (tip :accessor tip)
   (val :accessor val)
   (tip2 :accessor tip2)
   (val2 :accessor val2)))

(defmethod sonraki-token ((p json-parser))
  (setf (tip p) (tip2 p))
  (setf (val p) (val2 p))
  (token-gözat! p))

(defmethod token-gözat! ((p json-parser))
  (multiple-value-bind (tip val) (token-oku (okur p))
    (setf (tip2 p) tip)
    (setf (val2 p) val)))

(defmethod token-gözat ((p json-parser))
  (values (tip2 p) (val2 p)))

(defmethod değer-pars ((p json-parser))
  (sonraki-token p)
  (case (tip p)
    (:sayı (val p))
    (:string (val p))
    (:süslü-aç (obje-pars p))
    (:köşeli-aç (dizi-pars p))
    (otherwise (error "~s pars edilemez" (tip p)))))

(defmethod beklenen-token ((p json-parser) tip)
  (if (eq tip (tip2 p))
      (sonraki-token p)
      (error "beklenen: ~s, gelen: ~s" tip (tip2 p))))

(defmethod dizi-pars ((p json-parser))
  (when (eq (tip2 p) :köşeli-kapa)
    (sonraki-token p)
    (return-from dizi-pars (make-array 0)))
  (let ((dizi (make-array 3 :fill-pointer 0 :adjustable t)))
    (loop :do (vector-push-extend (değer-pars p) dizi)
          :if (eq (tip2 p) :virgül)
            :do (sonraki-token p)
          :else
            :do (beklenen-token p :köşeli-kapa)
                (loop-finish))
    dizi))

(defmethod obje-pars ((p json-parser))
  (let ((map (make-hash-table :test 'equal))
        k v)
    (when (eq (tip2 p) :süslü-kapa)
      (sonraki-token p)
      (return-from obje-pars map))
    (loop :do (beklenen-token p :string)
              (setf k (val p))
              (beklenen-token p :iki-nokta)
              (setf v (değer-pars p))
              (setf (gethash k map) v)
          :if (eq (tip2 p) :virgül)
            :do (sonraki-token p)
          :else
            :do (beklenen-token p :süslü-kapa)
                (loop-finish))
    map))

(defun yeni-parser (js-str)
  (let ((p (make-instance 'json-parser :okur (yeni js-str))))
    (token-gözat! p)
    p))

(defun yaz (json &optional (akış *standard-output*))
  (typecase json
    (string (format akış "~s" json))
    (number (format akış "~d" json))
    (array
     (write-char #\[ akış)
     (when (> (length json) 0)
       (yaz (aref json 0) akış)
       (loop :for i :from 1 :below (length json)
             :do (write-sequence ", " akış)
                 (yaz (aref json i))))
     (write-char #\] akış))
    (hash-table
     (with-hash-table-iterator (it json)
       (write-char #\{ akış)
       (multiple-value-bind (var k v) (it)
         (unless (not var)
           (format akış "~s: " k)
           (yaz v akış)))
       (loop :do (multiple-value-bind (var k v) (it)
                   (when (not var)
                     (loop-finish))
                   (format akış ", ~s: " k)
                   (yaz v akış)))
       (write-char #\} akış)))))




(defmethod tüm-tokenler ((o json-okur))
  (let (tok v)
    (loop :do (multiple-value-setq (tok v) (token-oku o))
          :if (null v)
            :collect tok
          :else
            :collect (cons tok v)
          :until (eq :eof tok))))

(defun dene (js)
  (let ((okur (yeni js)))
    (tüm-tokenler okur)))

(defun pars-dene (js)
  (let ((p (yeni-parser js)))
    (değer-pars p)))

(defun testler ()
  (pars-dene "[1, \"hello\", [1, ]]")
  (pars-dene "{\"what\": 5 , \"obj\"  : {\"status\": \"ok\"}}")

  (pars-dene "{\"what\": 5 , \"arr\": [1, 2, {\"lol\": []}], \"obj\"  : {\"status\": \"ok\"}}")
  (pars-dene "{\"what\": 5 , \"obj\"  : {\"status\": \"ok\"}, \"arr\": [1, 2, {\"lol\": []}]}"))


(defun class-hash-table (class-ismi)
  (let ((class (find-class class-ismi))
        (hash (make-hash-table :test 'equal)))
    (c2mop:ensure-finalized class)
    (let ((slots (c2mop:class-slots class)))
      (mapc (lambda (s)
              (let ((sym (c2mop:slot-definition-name s)))
                (setf (gethash (string-downcase sym) hash)
                      sym)))
              slots))
    hash))

(defparameter *classlar* (make-hash-table))

(defun class-tanımla (class-ismi)
  (let ((hash (class-hash-table class-ismi)))
    (setf (gethash class-ismi *classlar*) hash)))

(defun obje-doldur (str val obj hash)
  (multiple-value-bind (sym ok) (gethash str hash)
    (unless (not ok)
      (setf (slot-value obj sym) val))))

(defmethod class-obje-pars ((p json-parser) class-ismi)
  (beklenen-token p :süslü-aç)
  (multiple-value-bind (hash ok) (gethash class-ismi *classlar*)
    (when (not ok)
      (error "~s için json class tanımı yok" class-ismi))
    (let ((obje (make-instance class-ismi)) k v)
      (when (eq (tip2 p) :süslü-kapa)
        (sonraki-token p)
        (return-from class-obje-pars obje))
      (loop :do (beklenen-token p :string)
                (setf k (val p))
                (beklenen-token p :iki-nokta)
                (setf v (değer-pars p))
                (obje-doldur k v obje hash)
            :if (eq (tip2 p) :virgül)
              :do (sonraki-token p)
            :else
              :do (beklenen-token p :süslü-kapa)
                  (loop-finish))
      obje)))

(defun pars (arabellek class-ismi)
  (class-obje-pars (yeni-parser arabellek) class-ismi))