class dolduran json parser

4 files changed, 222 insertions, 12 deletions

diff --git a/dağ.asd b/dağ.asd
index 308c51d..8b9996b 100644
--- a/dağ.asd
+++ b/dağ.asd
@@ -1,7 +1,7 @@
 (defsystem dağ
   :author "Emre Akan"
   :description "Web frameworkü"
-  ;; :depends-on ()
+  :depends-on (closer-mop)
   :pathname "src/"
   :components ((:file "main")
                (:module "json"
diff --git a/src/json/json.lisp b/src/json/json.lisp
index e20c529..f46ef5a 100644
--- a/src/json/json.lisp
+++ b/src/json/json.lisp
@@ -49,7 +49,8 @@
            (setf ch2 (aref arabellek i))
            (incf i))
           (t
-           (setf ch2 +eof+)))))
+           (setf ch2 +eof+)
+           (incf i)))))
 
 (defun boşluk? (ch)
   (find ch #(#\Space #\Newline #\Return #\Tab)))
@@ -72,23 +73,216 @@
     (loop :for char := (char-gözat o)
           :while (rakam? char)
           :do (char-oynat o))
-    (subseq (arabellek o) baş (+ 1 (index 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)
-    (#\" (list :string (metin-oku o)))
+    (#\" (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))
-                      (list :sayı (sayı-oku o)))
+                      (values :sayı (sayı-oku o)))
                      ((boşluk? (ch o))
-                      (boşluk-geç o))
+                      (boşluk-geç o)
+                      (token-oku o))
                      ((eof? (ch o))
-                      :eof)))))
+                      :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)))
 
-(defmethod işle ((o json-okur))
-  (loop :for token := (token-oku o)
-        :collect token
-        :until (eq :eof token)))
+(defun pars (arabellek class-ismi)
+  (class-obje-pars (yeni-parser arabellek) class-ismi))
 
diff --git a/src/json/paket.lisp b/src/json/paket.lisp
index 534e15a..b1371bc 100644
--- a/src/json/paket.lisp
+++ b/src/json/paket.lisp
@@ -1,2 +1,3 @@
 (defpackage :json
-  (:use :common-lisp))
+  (:use :common-lisp)
+  (:export #:pars #:class-tanımla))
diff --git a/src/json/test.lisp b/src/json/test.lisp
new file mode 100644
index 0000000..d5ebfb4
--- /dev/null
+++ b/src/json/test.lisp
@@ -0,0 +1,15 @@
+(defpackage json-test
+  (:use :common-lisp))
+
+(defclass person ()
+  ((name :accessor name)
+   (email :accessor email)
+   (age :accessor age)))
+
+(json:class-tanımla 'person)
+
+(defparameter *json-metin* "{\"name\": \"Ahmet\", \"age\": 20, \"email\":\"ahmetzaxd@gmail.com\"}")
+
+(defun mop-test ()
+  (let ((kişi (json:pars *json-metin* 'person)))
+    (format t "~a (~a) <~a>" (name kişi) (age kişi) (email kişi))))