[Emacs-diffs] master 51adab5 2/2: Also allow custom false and null when serializing to JSON

[João Távora]

branch: master
commit 51adab5de24b3ee215fe636aedb7ff91d69a220c
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>

    Also allow custom false and null when serializing to JSON
    
    * doc/lispref/text.texi (Parsing JSON): Describe new arguments of
    json-serialize and json-insert.
    
    * src/json.c (enum json_object_type, struct json_configuration):
    Move up in file before first usage.
    (lisp_to_json_toplevel, lisp_to_json_toplevel_1, lisp_to_json):
    Accept a struct json_configuration*.
    (Fjson_serialize, Fjson_insert): Accept multiple args.
    (json_parse_args): Accept new boolean configure_object_type.
    
    * test/src/json-tests.el
    (json-serialize, json-insert): Update forward decls.
    (json-parse-with-custom-null-and-false-objects): Add assertions for
    json-serialize.
---
 doc/lispref/text.texi  |  37 +++++++---
 src/json.c             | 195 ++++++++++++++++++++++++++++---------------------
 test/src/json-tests.el |  18 +++--
 3 files changed, 152 insertions(+), 98 deletions(-)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 5b94580..bb6ab04 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -5063,14 +5063,29 @@ JSON.  The subobjects within these top-level values can 
be of any
 type.  Likewise, the parsing functions will only return vectors,
 hashtables, alists, and plists.
 
address@hidden json-serialize object
address@hidden 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 argument @var{args} is a list of
+keyword/argument pairs.  The following keywords are accepted:
+
address@hidden @code
+
address@hidden :null-object
+The value decides which Lisp object to use to represent the JSON
+keyword @code{null}.  It defaults to the symbol @code{:null}.
+
address@hidden :false-object
+The value decides which Lisp object to use to represent the JSON
+keyword @code{false}.  It defaults to the symbol @code{:false}.
+
address@hidden table
+
 @end defun
 
address@hidden json-insert object
address@hidden 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
address@hidden
 @end defun
 
 @defun json-parse-string string &rest args
@@ -5078,24 +5093,24 @@ This function parses the JSON value in @var{string}, 
which must be a
 Lisp string.  The argument @var{args} is a list of keyword/argument
 pairs.  The following keywords are accepted:
 
address@hidden
address@hidden @code
 
address@hidden @code{:object-type}
address@hidden :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.
 
address@hidden @code{:null-object}
address@hidden :null-object
 The value decides which Lisp object to use to represent the JSON
-keyword @code{null}.  It defaults to the lisp symbol @code{:null}.
+keyword @code{null}.  It defaults to the symbol @code{:null}.
 
address@hidden @code{:false-object}
address@hidden :false-object
 The value decides which Lisp object to use to represent the JSON
-keyword @code{false}.  It defaults to the lisp symbol @code{:false}.
+keyword @code{false}.  It defaults to the symbol @code{:false}.
 
address@hidden itemize
address@hidden table
 
 @end defun
 
diff --git a/src/json.c b/src/json.c
index e86ef23..d30c997 100644
--- a/src/json.c
+++ b/src/json.c
@@ -325,12 +325,25 @@ 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).  */
 
 static json_t *
-lisp_to_json_toplevel_1 (Lisp_Object lisp)
+lisp_to_json_toplevel_1 (Lisp_Object lisp,
+                         struct json_configuration *conf)
 {
   json_t *json;
   ptrdiff_t count;
@@ -344,7 +357,8 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp)
       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 ();
         }
@@ -369,7 +383,8 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp)
             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
@@ -424,7 +439,8 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp)
           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 ();
             }
@@ -444,11 +460,11 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp)
    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_t *json = lisp_to_json_toplevel_1 (lisp, conf);
   --lisp_eval_depth;
   return json;
 }
@@ -458,11 +474,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 ());
@@ -488,21 +504,78 @@ 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);
 }
 
-DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, 1, NULL,
+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 keyword values appearing
+     first take precedence. */
+  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, 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'.
+
+In you specify the same value for `:null-object' and `:false-object',
+a potentially ambiguous situation, the JSON output will not contain
+any JSON false values.
+usage: (json-serialize STRING &rest ARGS) */)
+     (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
 
@@ -521,7 +594,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:
@@ -577,12 +653,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)
+This is the same as (insert (json-serialize OBJECT)), but potentially
+faster.  See the function `json-serialize' for allowed values of
+OBJECT.  */)
+     (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
 
@@ -601,7 +678,10 @@ DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, 
NULL,
     }
 #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;
@@ -620,18 +700,6 @@ DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, 
NULL,
   return unbind_to (count, Qnil);
 }
 
-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;
-};
-
 /* Convert a JSON object to a Lisp object.  */
 
 static _GL_ARG_NONNULL ((1)) Lisp_Object
@@ -751,42 +819,6 @@ json_to_lisp (json_t *json, struct json_configuration 
*conf)
   emacs_abort ();
 }
 
-static void
-json_parse_args (ptrdiff_t nargs,
-                 Lisp_Object *args,
-                 struct json_configuration *conf)
-{
-  if ((nargs % 2) != 0)
-    wrong_type_argument (Qplistp, Flist (nargs, args));
-
-  /* Start from the back so keyword values appearing
-     first take precedence. */
-  for (ptrdiff_t i = nargs; i > 0; i -= 2) {
-    Lisp_Object key = args[i - 2];
-    Lisp_Object value = args[i - 1];
-    if (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
-      wrong_choice (list3 (QCobject_type,
-                           QCnull_object,
-                           QCfalse_object),
-                    value);
-  }
-}
-
 DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY,
        NULL,
        doc: /* Parse the JSON STRING into a Lisp object.
@@ -808,9 +840,8 @@ 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'.
-
-usage: (json-parse-string STRING &rest args) */)
-     (ptrdiff_t nargs, Lisp_Object *args)
+usage: (json-parse-string STRING &rest ARGS) */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
 
@@ -833,7 +864,7 @@ usage: (json-parse-string STRING &rest args) */)
   Lisp_Object encoded = json_encode (string);
   check_string_without_embedded_nulls (encoded);
   struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
-  json_parse_args (nargs - 1, args + 1, &conf);
+  json_parse_args (nargs - 1, args + 1, &conf, true);
 
   json_error_t error;
   json_t *object = json_loads (SSDATA (encoded), 0, &error);
@@ -882,7 +913,7 @@ DEFUN ("json-parse-buffer", Fjson_parse_buffer, 
Sjson_parse_buffer,
 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 &rest args)  */)
+usage: (json-parse-buffer &rest args) */)
      (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
@@ -903,7 +934,7 @@ usage: (json-parse-buffer &rest args)  */)
 #endif
 
   struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
-  json_parse_args (nargs, args, &conf);
+  json_parse_args (nargs, args, &conf, true);
 
   ptrdiff_t point = PT_BYTE;
   struct json_read_buffer_data data = {.point = point};
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 918b233..ffa6fe1 100644
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -26,8 +26,8 @@
 (require 'cl-lib)
 (require 'map)
 
-(declare-function json-serialize "json.c" (object))
-(declare-function json-insert "json.c" (object))
+(declare-function json-serialize "json.c" (object &rest args))
+(declare-function json-insert "json.c" (object &rest args))
 (declare-function json-parse-string "json.c" (string &rest args))
 (declare-function json-parse-buffer "json.c" (&rest args))
 
@@ -210,8 +210,10 @@ Test with both unibyte and multibyte strings."
     (should (looking-at-p (rx " [456]" eos)))))
 
 (ert-deftest json-parse-with-custom-null-and-false-objects ()
-  (let ((input
-         "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n"))
+  (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
@@ -236,7 +238,13 @@ Test with both unibyte and multibyte strings."
                                       :false-object thingy
                                       :null-object nil)))
       (should (equal retval `((abc . [9 ,thingy]) (def))))
-      (should (eq (elt (cdr (car retval)) 1) thingy)))))
+      (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-error (json-serialize '() :object-type 'alist))))
 
 (ert-deftest json-insert/signal ()
   (skip-unless (fboundp 'json-insert))