From 51adab5de24b3ee215fe636aedb7ff91d69a220c Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 8 Jun 2018 02:35:50 +0100 Subject: [PATCH] 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 5b94580827f..bb6ab04a927 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. -@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 argument @var{args} is a list of +keyword/argument pairs. The following keywords are accepted: + +@table @code + +@item :null-object +The value decides which Lisp object to use to represent the JSON +keyword @code{null}. It defaults to the symbol @code{:null}. + +@item :false-object +The value decides which Lisp object to use to represent the JSON +keyword @code{false}. It defaults to the symbol @code{:false}. + +@end table + @end defun -@defun json-insert object +@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 &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: -@itemize +@table @code -@item @code{:object-type} +@item :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} +@item :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}. -@item @code{:false-object} +@item :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}. -@end itemize +@end table @end defun diff --git a/src/json.c b/src/json.c index e86ef237d03..d30c997da4c 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 918b2336d0f..ffa6fe19f9b 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)) -- 2.39.2