Commit 51adab5d authored by João Távora's avatar João Távora
Browse files

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.
parent 9348039e
......@@ -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
......
......@@ -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};
......
......@@ -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))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment