[bknr-cvs] hans changed trunk/libraries/yason/

[BKNR Commits]

Revision: 4407
Author: hans
URL: http://bknr.net/trac/changeset/4407

Patch by Sean Ross to make YASON optionally parse objects as alists.
U   trunk/libraries/yason/doc.xml
U   trunk/libraries/yason/package.lisp
U   trunk/libraries/yason/parse.lisp

Modified: trunk/libraries/yason/doc.xml
===================================================================
--- trunk/libraries/yason/doc.xml	2009-05-18 09:00:41 UTC (rev 4406)
+++ trunk/libraries/yason/doc.xml	2009-05-20 11:07:47 UTC (rev 4407)
@@ -87,7 +87,9 @@
           <td>hash-table<br/>:test&#x00A0;#'equal</td>
           <td>
             Keys are strings by default,
-            see <clix:ref>*parse-object-key-fn*</clix:ref>
+            see <clix:ref>*parse-object-key-fn*</clix:ref>.
+            Set <clix:ref>*parse-object-as-alist*</clix:ref> to a true
+            value in order to have YASON parse objects as alists.
           </td>
         </tr>
         <tr>
@@ -196,6 +198,13 @@
         </clix:description>
       </clix:special-variable>
 
+      <clix:special-variable name="*parse-object-as-alist*">
+        <clix:description>
+          If set to a true value, JSON objects will be parsed as
+          alists instead of hash tables.
+        </clix:description>
+      </clix:special-variable>
+
       <clix:special-variable name="*parse-json-booleans-as-symbols*">
         <clix:description>
           If set to a true value, JSON booleans will be read as the
@@ -209,6 +218,7 @@
           key in the CL hash produced.
         </clix:description>
       </clix:special-variable>
+
     </clix:subchapter>
   </clix:chapter>
 

Modified: trunk/libraries/yason/package.lisp
===================================================================
--- trunk/libraries/yason/package.lisp	2009-05-18 09:00:41 UTC (rev 4406)
+++ trunk/libraries/yason/package.lisp	2009-05-20 11:07:47 UTC (rev 4407)
@@ -15,6 +15,7 @@
    ;; Parser
    #:parse
    #:*parse-object-key-fn*
+   #:*parse-object-as-alist*
    #:*parse-json-arrays-as-vectors*
    #:*parse-json-booleans-as-symbols*
 

Modified: trunk/libraries/yason/parse.lisp
===================================================================
--- trunk/libraries/yason/parse.lisp	2009-05-18 09:00:41 UTC (rev 4406)
+++ trunk/libraries/yason/parse.lisp	2009-05-20 11:07:47 UTC (rev 4407)
@@ -102,24 +102,40 @@
              (format stream "cannot convert key ~S used in JSON object to hash table key"
                      (key-string c)))))
 
+(defvar *parse-object-as-alist* nil
+  "If set to a true value, JSON objects will be parsed as association lists and not hash tables.")
+
+(defun create-container ()
+  (if *parse-object-as-alist*
+      '()
+      (make-hash-table :test #'equal)))
+
+(defgeneric add-attribute (to key value)
+  (:method ((to hash-table) key value)
+   (setf (gethash key to) value)
+   to)
+  (:method ((to list) key value)
+   (acons key value to)))
+
 (defun parse-object (input)
-  (let ((return-value (make-hash-table :test #'equal)))
+  (let ((return-value (create-container)))
     (read-char input)
     (loop
        (when (eql (peek-char-skipping-whitespace input)
                   #\})
          (return))
        (skip-whitespace input)
-       (setf (gethash (prog1
-                          (let ((key-string (parse-string input)))
-                            (or (funcall *parse-object-key-fn* key-string)
-                                (error 'cannot-convert-key :key-string key-string)))
-                        (skip-whitespace input)
-                        (unless (eql #\: (read-char input))
-                          (error 'expected-colon))
-                        (skip-whitespace input))
-                      return-value)
-             (parse input))
+       (setf return-value
+             (add-attribute return-value
+                            (prog1
+                                (let ((key-string (parse-string input)))
+                                  (or (funcall *parse-object-key-fn* key-string)
+                                      (error 'cannot-convert-key :key-string key-string)))
+                              (skip-whitespace input)
+                              (unless (eql #\: (read-char input))
+                                (error 'expected-colon))
+                              (skip-whitespace input))
+                            (parse input)))
        (ecase (peek-char-skipping-whitespace input)
          (#\, (read-char input))
          (#\} nil)))
@@ -171,6 +187,9 @@
        (parse-array input))
       ((#\t #\f #\n)
        (parse-constant input))))
+  (:method ((input pathname))
+   (with-open-file (stream input)
+     (parse stream)))
   (:method ((input string))
     (parse (make-string-input-stream input))))