From 9348039ed45c8e493e8bfef0220249d4d31ef6da Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Thu, 7 Jun 2018 17:41:19 +0100 Subject: [PATCH] Support custom null and false objects when parsing JSON * doc/lispref/text.texi (Parsing JSON): Describe new :null-object and :false-object kwargs to json-parse-string and json-parse-buffer. * src/json.c (struct json_configuration): New type. (json_to_lisp): Accept a struct json_configuration* param. (json_parse_args): Rename from json_parse_object_type. (Fjson_parse_string): Rework docstring. (Fjson_parse_string, Fjson_parse_buffer): Update call to json_to_lisp. (syms_of_json): Two new syms, QCnull_object and QCfalse_object. * test/src/json-tests.el (json-parse-with-custom-null-and-false-objects): New test. --- doc/lispref/text.texi | 45 +++++++++----- src/json.c | 136 +++++++++++++++++++++++++---------------- test/src/json-tests.el | 29 +++++++++ 3 files changed, 141 insertions(+), 69 deletions(-) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 2c5b5a1b42e..5b94580827f 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5008,9 +5008,10 @@ Specifically: @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,14 +5063,6 @@ 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. - 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 This function returns a new Lisp string which contains the JSON representation of @var{object}. @@ -5080,16 +5073,38 @@ This function inserts the JSON representation of @var{object} into the current buffer before point. @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 argument @var{args} is 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 to 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 to 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 c28e14d63c6..e86ef237d03 100644 --- a/src/json.c +++ b/src/json.c @@ -7,7 +7,7 @@ This file is part of GNU Emacs. GNU Emacs is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. +nyour option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -502,7 +502,7 @@ 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) + (Lisp_Object object) { ptrdiff_t count = SPECPDL_INDEX (); @@ -579,10 +579,10 @@ json_insert_callback (const char *buffer, size_t size, void *data) DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, 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. */) + (Lisp_Object object) { ptrdiff_t count = SPECPDL_INDEX (); @@ -621,22 +621,28 @@ OBJECT. */) } enum json_object_type { - json_object_hashtable, - json_object_alist, - json_object_plist + 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 -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: @@ -644,9 +650,9 @@ json_to_lisp (json_t *json, enum json_object_type object_type) otherwise. This loses precision for integers with large magnitude; however, such integers tend to be nonportable anyway because many JSON implementations use only 64-bit - floating-point numbers with 53 mantissa bits. See - https://tools.ietf.org/html/rfc7159#section-6 for some - discussion. */ + floating-point numbers with 53 mantissa bits. See + https://tools.ietf.org/html/rfc7159#section-6 for some + discussion. */ return make_fixnum_or_float (json_integer_value (json)); case JSON_REAL: return make_float (json_real_value (json)); @@ -663,7 +669,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; } @@ -672,7 +678,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: { @@ -692,7 +698,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; } @@ -705,7 +711,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); @@ -727,7 +733,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); @@ -745,47 +751,66 @@ 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: +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)) { - 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; + conf->object_type = json_object_hashtable; else if (EQ (value, Qalist)) - return json_object_alist; + conf->object_type = json_object_alist; else if (EQ (value, Qplist)) - return json_object_plist; + conf->object_type = json_object_plist; else wrong_choice (list3 (Qhash_table, Qalist, Qplist), value); } - default: - wrong_type_argument (Qplistp, Flist (nargs, args)); - } + 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. + 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)) */) - (ptrdiff_t nargs, Lisp_Object *args) +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'. + +usage: (json-parse-string STRING &rest args) */) + (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); @@ -807,8 +832,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); json_error_t error; json_t *object = json_loads (SSDATA (encoded), 0, &error); @@ -819,7 +844,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 @@ -857,8 +882,8 @@ 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 &key (OBJECT-TYPE \\='hash-table)) */) - (ptrdiff_t nargs, Lisp_Object *args) +usage: (json-parse-buffer &rest args) */) + (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); @@ -877,7 +902,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); ptrdiff_t point = PT_BYTE; struct json_read_buffer_data data = {.point = point}; @@ -892,7 +918,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; @@ -955,6 +981,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 7a193545b1a..918b2336d0f 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -209,6 +209,35 @@ Test with both unibyte and multibyte strings." (should-not (bobp)) (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")) + (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))))) + (ert-deftest json-insert/signal () (skip-unless (fboundp 'json-insert)) (with-temp-buffer -- 2.39.2