mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-27 07:41:28 -08:00
Code Issues Projects Releases Wiki Activity

Support custom null and false objects when parsing JSON

Browse source 
* 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.
This commit is contained in:
João Távora 2018-06-07 17:41:19 +01:00
parent 8cb9beb321
commit 9348039ed4
3 changed files with 140 additions and 68 deletions
Download patch file Download diff file Expand all files Collapse all files

45
doc/lispref/text.texi
View file

@ -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

134
src/json.c
View file

@ -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)
static void
json_parse_args (ptrdiff_t nargs,
Lisp_Object *args,
struct json_configuration *conf)
{
switch (nargs)
{
case 0:
return json_object_hashtable;
case 2:
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");

29
test/src/json-tests.el
View file

@ -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