Re: [PATCH] Support custom 'null' and 'false' objects when parsing JSON

["João Távora" <joaotavora@gmail.com>]

João Távora <joaotavora@gmail.com> writes:

>> Wouldn't it make sense to group those 3 parameters into a single object
>> (presumably a pointer to a stack-allocated struct containing those
>> 3 fields)?
>
> Yes it would, good idea.

Please see the updated patch using the stack-allocated struct.

Also note that the new version of the patch allows custom objects when
serializing JSON.  Yes, I know I could change all the json.el-compatible
:json-false references to :false and configure the json.el-encoder use
to use json.c's :false instead, but this is nicer.

I got the two patches split in two commits over at
scratch/allow-custom-null-and-false-objects-in-jsonc.

João

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 2c5b5a1b42..cfacb004e3 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -5008,9 +5008,10 @@ Parsing JSON
 @itemize
 
 @item
-JSON has a couple of keywords: @code{null}, @code{false}, and
-@code{true}.  These are represented in Lisp using the keywords
-@code{:null}, @code{:false}, and @code{t}, respectively.
+JSON uses three keywords: @code{true}, @code{null}, @code{false}.
+@code{true} is represented by the symbol @code{t}.  By default, the
+remaining two are represented, respectively, by the symbols
+@code{:null} and @code{:false}.
 
 @item
 JSON only has floating-point numbers.  They can represent both Lisp
@@ -5062,34 +5063,62 @@ Parsing JSON
 type.  Likewise, the parsing functions will only return vectors,
 hashtables, alists, and plists.
 
-  The parsing functions accept keyword arguments.  Currently only one
-keyword argument, @code{:object-type}, is recognized; its value
-decides which Lisp object to use for representing the key-value
-mappings of a JSON object.  It can be either @code{hash-table}, the
-default, to make hashtables with strings as keys, @code{alist} to use
-alists with symbols as keys or @code{plist} to use plists with keyword
-symbols as keys.
-
-@defun json-serialize object
+@defun json-serialize object &rest args
 This function returns a new Lisp string which contains the JSON
-representation of @var{object}.
+representation of @var{object}.  The arguments @var{args} are a list
+of keyword/argument pairs.  The following keywords are accepted:
+
+@itemize
+
+@item @code{:null-object}
+The value decides which Lisp object use to represent the JSON keyword
+@code{null}.  It defaults to the lisp symbol @code{:null}.
+
+@item @code{:false-object}
+The value decides which Lisp object use to represent the JSON keyword
+@code{false}.  It defaults to the lisp symbol @code{:false}.
 @end defun
 
-@defun json-insert object
+@end itemize
+
+@defun json-insert object &rest args
 This function inserts the JSON representation of @var{object} into the
-current buffer before point.
+current buffer before point.  @var{args} is interpreted as in
+@code{json-parse-string}.
 @end defun
 
-@defun json-parse-string string &key (object-type @code{hash-table})
+@defun json-parse-string string &rest args
 This function parses the JSON value in @var{string}, which must be a
-Lisp string.
+Lisp string.  The arguments @var{args} are a list of keyword/argument
+pairs.  The following keywords are accepted:
+
+@itemize
+
+@item @code{:object-type}
+The value decides which Lisp object to use for representing the key-value
+mappings of a JSON object.  It can be either @code{hash-table}, the
+default, to make hashtables with strings as keys, @code{alist} to use
+alists with symbols as keys or @code{plist} to use plists with keyword
+symbols as keys.
+
+@item @code{:null-object}
+The value decides which Lisp object use to represent the JSON keyword
+@code{null}.  It defaults to the lisp symbol @code{:null}.
+
+@item @code{:false-object}
+The value decides which Lisp object use to represent the JSON keyword
+@code{false}.  It defaults to the lisp symbol @code{:false}.
+
+@end itemize
+
 @end defun
 
-@defun json-parse-buffer &key (object-type @code{hash-table})
+@defun json-parse-buffer &rest args
 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
-doesn't move point.
+doesn't move point.  @var{args} is interpreted as in
+@code{json-parse-string}.
 @end defun
 
 
diff --git a/src/json.c b/src/json.c
index afb81587a4..fc4bc1f376 100644
--- a/src/json.c
+++ b/src/json.c
@@ -325,14 +325,28 @@ json_check_utf8 (Lisp_Object string)
   CHECK_TYPE (utf8_string_p (string), Qutf_8_string_p, string);
 }
 
-static json_t *lisp_to_json (Lisp_Object);
+enum json_object_type {
+  json_object_hashtable,
+  json_object_alist,
+  json_object_plist
+};
+
+struct json_configuration {
+  enum json_object_type object_type;
+  Lisp_Object null_object;
+  Lisp_Object false_object;
+};
+
+static json_t *lisp_to_json (Lisp_Object, struct json_configuration *conf);
 
 /* Convert a Lisp object to a toplevel JSON object (array or object).
    This returns Lisp_Object so we can use unbind_to.  The return value
    is always nil.  */
 
 static _GL_ARG_NONNULL ((2)) Lisp_Object
-lisp_to_json_toplevel_1 (Lisp_Object lisp, json_t **json)
+lisp_to_json_toplevel_1 (Lisp_Object lisp,
+                         json_t **json,
+                         struct json_configuration *conf)
 {
   if (VECTORP (lisp))
     {
@@ -343,7 +357,8 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, json_t **json)
       for (ptrdiff_t i = 0; i < size; ++i)
         {
           int status
-            = json_array_append_new (*json, lisp_to_json (AREF (lisp, i)));
+            = json_array_append_new (*json, lisp_to_json (AREF (lisp, i),
+                                                          conf));
           if (status == -1)
             json_out_of_memory ();
         }
@@ -370,7 +385,8 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, json_t **json)
             if (json_object_get (*json, key_str) != NULL)
               wrong_type_argument (Qjson_value_p, lisp);
             int status = json_object_set_new (*json, key_str,
-                                              lisp_to_json (HASH_VALUE (h, i)));
+                                              lisp_to_json (HASH_VALUE (h, i),
+                                                            conf));
             if (status == -1)
               {
                 /* A failure can be caused either by an invalid key or
@@ -430,7 +446,8 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, json_t **json)
           if (json_object_get (*json, key_str) == NULL)
             {
               int status
-                = json_object_set_new (*json, key_str, lisp_to_json (value));
+                = json_object_set_new (*json, key_str, lisp_to_json (value,
+                                                                     conf));
               if (status == -1)
                 json_out_of_memory ();
             }
@@ -447,12 +464,12 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, json_t **json)
    hashtable, alist, or plist.  */
 
 static json_t *
-lisp_to_json_toplevel (Lisp_Object lisp)
+lisp_to_json_toplevel (Lisp_Object lisp, struct json_configuration *conf)
 {
   if (++lisp_eval_depth > max_lisp_eval_depth)
     xsignal0 (Qjson_object_too_deep);
   json_t *json;
-  lisp_to_json_toplevel_1 (lisp, &json);
+  lisp_to_json_toplevel_1 (lisp, &json, conf);
   --lisp_eval_depth;
   return json;
 }
@@ -462,11 +479,11 @@ lisp_to_json_toplevel (Lisp_Object lisp)
    JSON object.  */
 
 static json_t *
-lisp_to_json (Lisp_Object lisp)
+lisp_to_json (Lisp_Object lisp, struct json_configuration *conf)
 {
-  if (EQ (lisp, QCnull))
+  if (EQ (lisp, conf->null_object))
     return json_check (json_null ());
-  else if (EQ (lisp, QCfalse))
+  else if (EQ (lisp, conf->false_object))
     return json_check (json_false ());
   else if (EQ (lisp, Qt))
     return json_check (json_true ());
@@ -492,21 +509,77 @@ lisp_to_json (Lisp_Object lisp)
     }
 
   /* LISP now must be a vector, hashtable, alist, or plist.  */
-  return lisp_to_json_toplevel (lisp);
+  return lisp_to_json_toplevel (lisp, conf);
+}
+
+static void
+json_parse_args (ptrdiff_t nargs,
+                 Lisp_Object *args,
+                 struct json_configuration *conf,
+                 bool configure_object_type)
+{
+  if ((nargs % 2) != 0)
+    wrong_type_argument (Qplistp, Flist (nargs, args));
+
+  /* Start from the back so first value is honoured. */
+  for (ptrdiff_t i = nargs; i > 0; i -= 2) {
+    Lisp_Object key = args[i - 2];
+    Lisp_Object value = args[i - 1];
+    if (configure_object_type && EQ (key, QCobject_type))
+      {
+        if (EQ (value, Qhash_table))
+          conf->object_type = json_object_hashtable;
+        else if (EQ (value, Qalist))
+          conf->object_type = json_object_alist;
+        else if (EQ (value, Qplist))
+          conf->object_type = json_object_plist;
+        else
+          wrong_choice (list3 (Qhash_table, Qalist, Qplist), value);
+      }
+    else if (EQ (key, QCnull_object))
+      conf->null_object = value;
+    else if (EQ (key, QCfalse_object))
+      conf->false_object = value;
+    else if (configure_object_type)
+      wrong_choice (list3 (QCobject_type,
+                           QCnull_object,
+                           QCfalse_object),
+                    value);
+    else
+      wrong_choice (list2 (QCnull_object,
+                           QCfalse_object),
+                    value);
+  }
 }
 
-DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, 1, NULL,
+DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY,
+       NULL,
        doc: /* Return the JSON representation of OBJECT as a string.
+
 OBJECT must be a vector, hashtable, alist, or plist and its elements
-can recursively contain `:null', `:false', t, numbers, strings, or
-other vectors hashtables, alists or plists.  `:null', `:false', and t
-will be converted to JSON null, false, and true values, respectively.
-Vectors will be converted to JSON arrays, whereas hashtables, alists
-and plists are converted to JSON objects.  Hashtable keys must be
-strings without embedded null characters and must be unique within
-each object.  Alist and plist keys must be symbols; if a key is
-duplicate, the first instance is used.  */)
-  (Lisp_Object object)
+can recursively contain the lisp equivalents to the JSON null and
+false values, t, numbers, strings, or other vectors hashtables, alists
+or plists.  t will be converted to the JSON true value.  Vectors will
+be converted to JSON arrays, whereas hashtables, alists and plists are
+converted to JSON objects.  Hashtable keys must be strings without
+embedded null characters and must be unique within each object.  Alist
+and plist keys must be symbols; if a key is duplicate, the first
+instance is used.
+
+The lisp equivalents to the JSON null and false values are
+configurable in the arguments ARGS, a list of keyword/argument pairs:
+
+The keyword argument `:null-object' specifies which object to use
+to represent a JSON null value.  It defaults to `:null'.
+
+The keyword argument `:false-object' specifies which object to use to
+represent a JSON false value.  It defaults to `:false'.
+
+Note that ambiguity can arise if you specify the same value for
+`:null-object' and `:false-object', and so this function's behaviour
+is unspecified
+*/)
+     (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
 
@@ -525,7 +598,10 @@ duplicate, the first instance is used.  */)
     }
 #endif
 
-  json_t *json = lisp_to_json_toplevel (object);
+  struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
+  json_parse_args (nargs - 1, args + 1, &conf, false);
+
+  json_t *json = lisp_to_json_toplevel (args[0], &conf);
   record_unwind_protect_ptr (json_release_object, json);
 
   /* If desired, we might want to add the following flags:
@@ -581,12 +657,13 @@ json_insert_callback (const char *buffer, size_t size, void *data)
   return NILP (d->error) ? 0 : -1;
 }
 
-DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, NULL,
+DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, MANY,
+       NULL,
        doc: /* Insert the JSON representation of OBJECT before point.
 This is the same as (insert (json-serialize OBJECT)), but potentially
 faster.  See the function `json-serialize' for allowed values of
 OBJECT.  */)
-  (Lisp_Object object)
+     (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
 
@@ -605,7 +682,10 @@ OBJECT.  */)
     }
 #endif
 
-  json_t *json = lisp_to_json (object);
+  struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
+  json_parse_args (nargs - 1, args + 1, &conf, false);
+
+  json_t *json = lisp_to_json (args[0], &conf);
   record_unwind_protect_ptr (json_release_object, json);
 
   struct json_insert_data data;
@@ -624,23 +704,17 @@ OBJECT.  */)
   return unbind_to (count, Qnil);
 }
 
-enum json_object_type {
-  json_object_hashtable,
-  json_object_alist,
-  json_object_plist
-};
-
 /* Convert a JSON object to a Lisp object.  */
 
 static _GL_ARG_NONNULL ((1)) Lisp_Object
-json_to_lisp (json_t *json, enum json_object_type object_type)
+json_to_lisp (json_t *json, struct json_configuration *conf)
 {
   switch (json_typeof (json))
     {
     case JSON_NULL:
-      return QCnull;
+      return conf->null_object;
     case JSON_FALSE:
-      return QCfalse;
+      return conf->false_object;
     case JSON_TRUE:
       return Qt;
     case JSON_INTEGER:
@@ -667,7 +741,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type)
         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), object_type));
+                json_to_lisp (json_array_get (json, i), conf));
         --lisp_eval_depth;
         return result;
       }
@@ -676,7 +750,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type)
         if (++lisp_eval_depth > max_lisp_eval_depth)
           xsignal0 (Qjson_object_too_deep);
         Lisp_Object result;
-        switch (object_type)
+        switch (conf->object_type)
           {
           case json_object_hashtable:
             {
@@ -696,7 +770,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type)
                   /* 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);
+                  hash_put (h, key, json_to_lisp (value, conf), hash);
                 }
               break;
             }
@@ -709,7 +783,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type)
                 {
                   Lisp_Object key = Fintern (json_build_string (key_str), Qnil);
                   result
-                    = Fcons (Fcons (key, json_to_lisp (value, object_type)),
+                    = Fcons (Fcons (key, json_to_lisp (value, conf)),
                              result);
                 }
               result = Fnreverse (result);
@@ -731,7 +805,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type)
                   /* Build the plist as value-key since we're going to
                      reverse it in the end.*/
                   result = Fcons (key, result);
-                  result = Fcons (json_to_lisp (value, object_type), result);
+                  result = Fcons (json_to_lisp (value, conf), result);
                   SAFE_FREE ();
                 }
               result = Fnreverse (result);
@@ -749,46 +823,27 @@ json_to_lisp (json_t *json, enum json_object_type object_type)
   emacs_abort ();
 }
 
-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 if (EQ (value, Qplist))
-          return json_object_plist;
-        else
-          wrong_choice (list3 (Qhash_table, Qalist, Qplist), 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, hashtable, alist, or
-plist.  Its elements will be `:null', `:false', t, numbers, strings,
-or further vectors, hashtables, alists, or plists.  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', `alist' or `plist'.
-usage: (json-parse-string STRING &key (OBJECT-TYPE \\='hash-table)) */)
+plist.  Its elements will be the JSON null value, the JSON false
+value, t, numbers, strings, or further vectors, hashtables, alists, or
+plists.  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 arguments ARGS are
+a list of keyword/argument pairs:
+
+The keyword argument `:object-type' specifies which Lisp type is used
+to represent objects; it can be `hash-table', `alist' or `plist'.
+
+The keyword argument `:null-object' specifies which object to use
+to represent a JSON null value.  It defaults to `:null'.
+
+The keyword argument `:false-object' specifies which object to use to
+represent a JSON false value.  It defaults to `:false'. */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
@@ -811,8 +866,8 @@ usage: (json-parse-string STRING &key (OBJECT-TYPE \\='hash-table)) */)
   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);
+  struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
+  json_parse_args (nargs - 1, args + 1, &conf, true);
 
   json_error_t error;
   json_t *object = json_loads (SSDATA (encoded), 0, &error);
@@ -823,7 +878,7 @@ usage: (json-parse-string STRING &key (OBJECT-TYPE \\='hash-table)) */)
   if (object != NULL)
     record_unwind_protect_ptr (json_release_object, object);
 
-  return unbind_to (count, json_to_lisp (object, object_type));
+  return unbind_to (count, json_to_lisp (object, &conf));
 }
 
 struct json_read_buffer_data
@@ -860,8 +915,7 @@ DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer,
        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.
-usage: (json-parse-buffer &key (OBJECT-TYPE \\='hash-table))  */)
+not moved.  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
@@ -881,7 +935,8 @@ usage: (json-parse-buffer &key (OBJECT-TYPE \\='hash-table))  */)
     }
 #endif
 
-  enum json_object_type object_type = json_parse_object_type (nargs, args);
+  struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
+  json_parse_args (nargs, args, &conf, true);
 
   ptrdiff_t point = PT_BYTE;
   struct json_read_buffer_data data = {.point = point};
@@ -896,7 +951,7 @@ usage: (json-parse-buffer &key (OBJECT-TYPE \\='hash-table))  */)
   record_unwind_protect_ptr (json_release_object, object);
 
   /* Convert and then move point only if everything succeeded.  */
-  Lisp_Object lisp = json_to_lisp (object, object_type);
+  Lisp_Object lisp = json_to_lisp (object, &conf);
 
   /* Adjust point by how much we just read.  */
   point += error.position;
@@ -959,6 +1014,8 @@ syms_of_json (void)
   Fput (Qjson_parse_string, Qside_effect_free, Qt);
 
   DEFSYM (QCobject_type, ":object-type");
+  DEFSYM (QCnull_object, ":null-object");
+  DEFSYM (QCfalse_object, ":false-object");
   DEFSYM (Qalist, "alist");
   DEFSYM (Qplist, "plist");
 
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 7a193545b1..0107dbbcd2 100644
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -209,6 +209,43 @@ 'json-tests--error
     (should-not (bobp))
     (should (looking-at-p (rx " [456]" eos)))))
 
+(ert-deftest json-parse-with-custom-null-and-false-objects ()
+  (let* ((input
+          "{ \"abc\" : [9, false] , \"def\" : null }")
+         (output
+          (replace-regexp-in-string " " "" input)))
+    (should (equal (json-parse-string input
+                                      :object-type 'plist
+                                      :null-object :json-null
+                                      :false-object :json-false)
+                   '(:abc [9 :json-false] :def :json-null)))
+    (should (equal (json-parse-string input
+                                      :object-type 'plist
+                                      :false-object :json-false)
+                   '(:abc [9 :json-false] :def :null)))
+    (should (equal (json-parse-string input
+                                      :object-type 'alist
+                                      :null-object :zilch)
+                   '((abc . [9 :false]) (def . :zilch))))
+    (should (equal (json-parse-string input
+                                      :object-type 'alist
+                                      :false-object nil
+                                      :null-object nil)
+                   '((abc . [9 nil]) (def))))
+    (let* ((thingy '(1 2 3))
+           (retval (json-parse-string input
+                                      :object-type 'alist
+                                      :false-object thingy
+                                      :null-object nil)))
+      (should (equal retval `((abc . [9 ,thingy]) (def))))
+      (should (eq (elt (cdr (car retval)) 1) thingy)))
+    (should (equal output
+                   (json-serialize '((abc . [9 :myfalse]) (def . :mynull))
+                                   :false-object :myfalse
+                                   :null-object :mynull)))
+    ;; :object-type is not allowed in json-serialize
+    (should (json-serialize '() :object-type 'alist))))
+
 (ert-deftest json-insert/signal ()
   (skip-unless (fboundp 'json-insert))
   (with-temp-buffer