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.

1 files changed, 99 insertions, 30 deletions

diff --git a/src/json.c b/src/json.c
index 29e4400fc91..47c5b8ff468 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);