[Emacs-diffs] master db4f12e: Allow JSON parser functions to return alists

[Philipp Stephani]

branch: master
commit db4f12e93f466832a5e5e1d512aff87ea90ef197
Author: Philipp Stephani <address@hidden>
Commit: Philipp Stephani <address@hidden>

    Allow JSON parser functions to return alists
    
    * src/json.c (Fjson_parse_string, Fjson_parse_buffer): Give these
    functions a keyword argument to specify the return type for JSON
    objects.
    (json_to_lisp): Convert objects to alists if requested.
    (json_parse_object_type): New helper function to parse keyword
    arguments.
    
    * test/src/json-tests.el (json-parse-string/object): Add a unit test.
    
    * doc/lispref/text.texi (Parsing JSON): Document new functionality.
---
 doc/lispref/text.texi  |  20 +++++---
 src/json.c             | 129 +++++++++++++++++++++++++++++++++++++------------
 test/src/json-tests.el |  16 +++---
 3 files changed, 120 insertions(+), 45 deletions(-)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 5b288d9..9592702 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4965,14 +4965,13 @@ represented using Lisp vectors.
 
 @item
 JSON has only one map type, the object.  JSON objects are represented
-using Lisp hashtables.
+using Lisp hashtables or alists.
 
 @end itemize
 
 @noindent
-Note that @code{nil} doesn't represent any JSON values: this is to
-avoid confusion, because @code{nil} could either represent
address@hidden, @code{false}, or an empty array, all of which are
+Note that @code{nil} represents the empty JSON object, @address@hidden@}},
+not @code{null}, @code{false}, or an empty array, all of which are
 different JSON values.
 
   If some Lisp object can't be represented in JSON, the serialization
@@ -4995,8 +4994,13 @@ The parsing functions will signal the following errors:
 
   Only top-level values (arrays and objects) can be serialized to
 JSON.  The subobjects within these top-level values can be of any
-type.  Likewise, the parsing functions will only return vectors and
-hashtables.
+type.  Likewise, the parsing functions will only return vectors,
+hashtables, and alists.
+
+  The parsing functions accept keyword arguments.  Currently only one
+keyword argument, @code{:object-type}, is recognized; its value can be
+either @code{hash-table} to parse JSON objects as hashtables with
+string keys (the default) or @code{alist} to parse them as alists.
 
 @defun json-serialize object
 This function returns a new Lisp string which contains the JSON
@@ -5008,12 +5012,12 @@ This function inserts the JSON representation of 
@var{object} into the
 current buffer before point.
 @end defun
 
address@hidden json-parse-string string
address@hidden json-parse-string string &key (object-type @code{hash-table})
 This function parses the JSON value in @var{string}, which must be a
 Lisp string.
 @end defun
 
address@hidden json-parse-buffer
address@hidden json-parse-buffer &key (object-type @code{hash-table})
 This function reads the next JSON value from the current buffer,
 starting at point.  It moves point to the position immediately after
 the value if a value could be read and converted to Lisp; otherwise it
diff --git a/src/json.c b/src/json.c
index 29e4400..47c5b8f 100644
--- a/src/json.c
+++ b/src/json.c
@@ -518,10 +518,15 @@ OBJECT.  */)
   return unbind_to (count, Qnil);
 }
 
+enum json_object_type {
+  json_object_hashtable,
+  json_object_alist,
+};
+
 /* Convert a JSON object to a Lisp object.  */
 
 static _GL_ARG_NONNULL ((1)) Lisp_Object
-json_to_lisp (json_t *json)
+json_to_lisp (json_t *json, enum json_object_type object_type)
 {
   switch (json_typeof (json))
     {
@@ -555,7 +560,7 @@ json_to_lisp (json_t *json)
         Lisp_Object result = Fmake_vector (make_natnum (size), Qunbound);
         for (ptrdiff_t i = 0; i < size; ++i)
           ASET (result, i,
-                json_to_lisp (json_array_get (json, i)));
+                json_to_lisp (json_array_get (json, i), object_type));
         --lisp_eval_depth;
         return result;
       }
@@ -563,23 +568,49 @@ json_to_lisp (json_t *json)
       {
         if (++lisp_eval_depth > max_lisp_eval_depth)
           xsignal0 (Qjson_object_too_deep);
-        size_t size = json_object_size (json);
-        if (FIXNUM_OVERFLOW_P (size))
-          xsignal0 (Qoverflow_error);
-        Lisp_Object result = CALLN (Fmake_hash_table, QCtest, Qequal,
-                                    QCsize, make_natnum (size));
-        struct Lisp_Hash_Table *h = XHASH_TABLE (result);
-        const char *key_str;
-        json_t *value;
-        json_object_foreach (json, key_str, value)
+        Lisp_Object result;
+        switch (object_type)
           {
-            Lisp_Object key = json_build_string (key_str);
-            EMACS_UINT hash;
-            ptrdiff_t i = hash_lookup (h, key, &hash);
-            /* Keys in JSON objects are unique, so the key can't be
-               present yet.  */
-            eassert (i < 0);
-            hash_put (h, key, json_to_lisp (value), hash);
+          case json_object_hashtable:
+            {
+              size_t size = json_object_size (json);
+              if (FIXNUM_OVERFLOW_P (size))
+                xsignal0 (Qoverflow_error);
+              result = CALLN (Fmake_hash_table, QCtest, Qequal, QCsize,
+                              make_natnum (size));
+              struct Lisp_Hash_Table *h = XHASH_TABLE (result);
+              const char *key_str;
+              json_t *value;
+              json_object_foreach (json, key_str, value)
+                {
+                  Lisp_Object key = json_build_string (key_str);
+                  EMACS_UINT hash;
+                  ptrdiff_t i = hash_lookup (h, key, &hash);
+                  /* Keys in JSON objects are unique, so the key can't
+                     be present yet.  */
+                  eassert (i < 0);
+                  hash_put (h, key, json_to_lisp (value, object_type), hash);
+                }
+              break;
+            }
+          case json_object_alist:
+            {
+              result = Qnil;
+              const char *key_str;
+              json_t *value;
+              json_object_foreach (json, key_str, value)
+                {
+                  Lisp_Object key = Fintern (json_build_string (key_str), 
Qnil);
+                  result
+                    = Fcons (Fcons (key, json_to_lisp (value, object_type)),
+                             result);
+                }
+              result = Fnreverse (result);
+              break;
+            }
+          default:
+            /* Can't get here.  */
+            emacs_abort ();
           }
         --lisp_eval_depth;
         return result;
@@ -589,15 +620,44 @@ json_to_lisp (json_t *json)
   emacs_abort ();
 }
 
-DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, 1, NULL,
+static enum json_object_type
+json_parse_object_type (ptrdiff_t nargs, Lisp_Object *args)
+{
+  switch (nargs)
+    {
+    case 0:
+      return json_object_hashtable;
+    case 2:
+      {
+        Lisp_Object key = args[0];
+        Lisp_Object value = args[1];
+        if (!EQ (key, QCobject_type))
+          wrong_choice (list1 (QCobject_type), key);
+        if (EQ (value, Qhash_table))
+          return json_object_hashtable;
+        else if (EQ (value, Qalist))
+          return json_object_alist;
+        else
+          wrong_choice (list2 (Qhash_table, Qalist), value);
+      }
+    default:
+      wrong_type_argument (Qplistp, Flist (nargs, args));
+    }
+}
+
+DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY,
+       NULL,
        doc: /* Parse the JSON STRING into a Lisp object.
 This is essentially the reverse operation of `json-serialize', which
-see.  The returned object will be a vector or hashtable.  Its elements
-will be `:null', `:false', t, numbers, strings, or further vectors and
-hashtables.  If there are duplicate keys in an object, all but the
-last one are ignored.  If STRING doesn't contain a valid JSON object,
-an error of type `json-parse-error' is signaled.  */)
-  (Lisp_Object string)
+see.  The returned object will be a vector, hashtable, or alist.  Its
+elements will be `:null', `:false', t, numbers, strings, or further
+vectors, hashtables, and alists.  If there are duplicate keys in an
+object, all but the last one are ignored.  If STRING doesn't contain a
+valid JSON object, an error of type `json-parse-error' is signaled.
+The keyword argument `:object-type' specifies which Lisp type is used
+to represent objects; it can be `hash-table' or `alist'.
+usage: (string &key (OBJECT-TYPE \\='hash-table)) */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
 
@@ -616,8 +676,11 @@ an error of type `json-parse-error' is signaled.  */)
     }
 #endif
 
+  Lisp_Object string = args[0];
   Lisp_Object encoded = json_encode (string);
   check_string_without_embedded_nulls (encoded);
+  enum json_object_type object_type
+    = json_parse_object_type (nargs - 1, args + 1);
 
   json_error_t error;
   json_t *object = json_loads (SSDATA (encoded), 0, &error);
@@ -628,7 +691,7 @@ an error of type `json-parse-error' is signaled.  */)
   if (object != NULL)
     record_unwind_protect_ptr (json_release_object, object);
 
-  return unbind_to (count, json_to_lisp (object));
+  return unbind_to (count, json_to_lisp (object, object_type));
 }
 
 struct json_read_buffer_data
@@ -661,12 +724,13 @@ json_read_buffer_callback (void *buffer, size_t buflen, 
void *data)
 }
 
 DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer,
-       0, 0, NULL,
+       0, MANY, NULL,
        doc: /* Read JSON object from current buffer starting at point.
 This is similar to `json-parse-string', which see.  Move point after
 the end of the object if parsing was successful.  On error, point is
-not moved.  */)
-  (void)
+not moved.
+usage: (&key (OBJECT-TYPE \\='hash-table))  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
 
@@ -685,6 +749,8 @@ not moved.  */)
     }
 #endif
 
+  enum json_object_type object_type = json_parse_object_type (nargs, args);
+
   ptrdiff_t point = PT_BYTE;
   struct json_read_buffer_data data = {.point = point};
   json_error_t error;
@@ -698,7 +764,7 @@ not moved.  */)
   record_unwind_protect_ptr (json_release_object, object);
 
   /* Convert and then move point only if everything succeeded.  */
-  Lisp_Object lisp = json_to_lisp (object);
+  Lisp_Object lisp = json_to_lisp (object, object_type);
 
   /* Adjust point by how much we just read.  */
   point += error.position;
@@ -761,6 +827,9 @@ syms_of_json (void)
   Fput (Qjson_parse_string, Qpure, Qt);
   Fput (Qjson_parse_string, Qside_effect_free, Qt);
 
+  DEFSYM (QCobject_type, ":object-type");
+  DEFSYM (Qalist, "alist");
+
   defsubr (&Sjson_serialize);
   defsubr (&Sjson_insert);
   defsubr (&Sjson_parse_string);
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 551f8ac..100bf7b 100644
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -54,13 +54,15 @@
 
 (ert-deftest json-parse-string/object ()
   (skip-unless (fboundp 'json-parse-string))
-  (let ((actual
-         (json-parse-string
-          "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] 
}\n")))
-    (should (hash-table-p actual))
-    (should (equal (hash-table-count actual) 2))
-    (should (equal (cl-sort (map-pairs actual) #'string< :key #'car)
-                   '(("abc" . [9 :false]) ("def" . :null))))))
+  (let ((input
+         "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n"))
+    (let ((actual (json-parse-string input)))
+      (should (hash-table-p actual))
+      (should (equal (hash-table-count actual) 2))
+      (should (equal (cl-sort (map-pairs actual) #'string< :key #'car)
+                     '(("abc" . [9 :false]) ("def" . :null)))))
+    (should (equal (json-parse-string input :object-type 'alist)
+                   '((abc . [9 :false]) (def . :null))))))
 
 (ert-deftest json-parse-string/string ()
   (skip-unless (fboundp 'json-parse-string))