Commit b41c1ca1 authored by Dmitry Gutov's avatar Dmitry Gutov

Add :array-type option to json-parse-string

* src/json.c (enum json_array_type): New type.
(struct json_configuration): New field array_type.
(json_parse_args): Rename the last argument.  Handle the
:array-type keyword argument (bug#32793).
(Fjson_parse_string): Update the docstring accordingly.
(json_to_lisp): Handle the case of :array-type being `list'.  Add
a call to 'rarely_quit' inside the loop.
(syms_of_json): Define new symbols.
(Fjson_serialize, Fjson_insert, Fjson_parse_string)
(Fjson_parse_buffer): Update the config struct initializers.
parent cc80eeb4
Pipeline #1261 failed with stage
in 50 minutes and 40 seconds
......@@ -5167,6 +5167,11 @@ key-value mappings of a JSON object. It can be either
keys; @code{alist} to use alists with symbols as keys; or @code{plist}
to use plists with keyword symbols as keys.
@item :array-type
The value decides which Lisp object to use for representing a JSON
array. It can be either @code{array}, the default, to use Lisp
arrays; or @code{list} to use lists.
@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}.
......
......@@ -337,8 +337,14 @@ enum json_object_type {
json_object_plist
};
enum json_array_type {
json_array_array,
json_array_list
};
struct json_configuration {
enum json_object_type object_type;
enum json_array_type array_type;
Lisp_Object null_object;
Lisp_Object false_object;
};
......@@ -521,7 +527,7 @@ static void
json_parse_args (ptrdiff_t nargs,
Lisp_Object *args,
struct json_configuration *conf,
bool configure_object_type)
bool parse_object_types)
{
if ((nargs % 2) != 0)
wrong_type_argument (Qplistp, Flist (nargs, args));
......@@ -531,7 +537,7 @@ json_parse_args (ptrdiff_t nargs,
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 (parse_object_types && EQ (key, QCobject_type))
{
if (EQ (value, Qhash_table))
conf->object_type = json_object_hashtable;
......@@ -542,12 +548,22 @@ json_parse_args (ptrdiff_t nargs,
else
wrong_choice (list3 (Qhash_table, Qalist, Qplist), value);
}
else if (parse_object_types && EQ (key, QCarray_type))
{
if (EQ (value, Qarray))
conf->array_type = json_array_array;
else if (EQ (value, Qlist))
conf->array_type = json_array_list;
else
wrong_choice (list2 (Qarray, Qlist), 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,
else if (parse_object_types)
wrong_choice (list4 (QCobject_type,
QCarray_type,
QCnull_object,
QCfalse_object),
value);
......@@ -604,7 +620,8 @@ usage: (json-serialize OBJECT &rest ARGS) */)
}
#endif
struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
struct json_configuration conf =
{json_object_hashtable, json_array_array, QCnull, QCfalse};
json_parse_args (nargs - 1, args + 1, &conf, false);
json_t *json = lisp_to_json_toplevel (args[0], &conf);
......@@ -701,7 +718,8 @@ usage: (json-insert OBJECT &rest ARGS) */)
}
#endif
struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
struct json_configuration conf =
{json_object_hashtable, json_array_array, QCnull, QCfalse};
json_parse_args (nargs - 1, args + 1, &conf, false);
json_t *json = lisp_to_json (args[0], &conf);
......@@ -817,10 +835,35 @@ json_to_lisp (json_t *json, struct json_configuration *conf)
size_t size = json_array_size (json);
if (PTRDIFF_MAX < size)
overflow_error ();
Lisp_Object result = make_vector (size, Qunbound);
for (ptrdiff_t i = 0; i < size; ++i)
ASET (result, i,
json_to_lisp (json_array_get (json, i), conf));
Lisp_Object result;
switch (conf->array_type)
{
case json_array_array:
{
result = make_vector (size, Qunbound);
for (ptrdiff_t i = 0; i < size; ++i)
{
rarely_quit (i);
ASET (result, i,
json_to_lisp (json_array_get (json, i), conf));
}
break;
}
case json_array_list:
{
result = Qnil;
for (ptrdiff_t i = size - 1; i >= 0; --i)
{
rarely_quit (i);
result = Fcons (json_to_lisp (json_array_get (json, i), conf),
result);
}
break;
}
default:
/* Can't get here. */
emacs_abort ();
}
--lisp_eval_depth;
return result;
}
......@@ -916,7 +959,12 @@ 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'.
to represent objects; it can be `hash-table', `alist' or `plist'. It
defaults to `hash-table'.
The keyword argument `:array-type' specifies which Lisp type is used
to represent arrays; it can be `array' or `list'. It defaults to
`array'.
The keyword argument `:null-object' specifies which object to use
to represent a JSON null value. It defaults to `:null'.
......@@ -946,7 +994,8 @@ usage: (json-parse-string STRING &rest ARGS) */)
Lisp_Object string = args[0];
Lisp_Object encoded = json_encode (string);
check_string_without_embedded_nuls (encoded);
struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
struct json_configuration conf =
{json_object_hashtable, json_array_array, QCnull, QCfalse};
json_parse_args (nargs - 1, args + 1, &conf, true);
json_error_t error;
......@@ -1016,7 +1065,8 @@ usage: (json-parse-buffer &rest args) */)
}
#endif
struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
struct json_configuration conf =
{json_object_hashtable, json_array_array, QCnull, QCfalse};
json_parse_args (nargs, args, &conf, true);
ptrdiff_t point = PT_BYTE;
......@@ -1095,10 +1145,12 @@ syms_of_json (void)
Fput (Qjson_parse_string, Qside_effect_free, Qt);
DEFSYM (QCobject_type, ":object-type");
DEFSYM (QCarray_type, ":array-type");
DEFSYM (QCnull_object, ":null-object");
DEFSYM (QCfalse_object, ":false-object");
DEFSYM (Qalist, "alist");
DEFSYM (Qplist, "plist");
DEFSYM (Qarray, "array");
defsubr (&Sjson_serialize);
defsubr (&Sjson_insert);
......
......@@ -117,6 +117,14 @@
(should (equal (json-parse-string input :object-type 'plist)
'(:abc [9 :false] :def :null)))))
(ert-deftest json-parse-string/array ()
(skip-unless (fboundp 'json-parse-string))
(let ((input "[\"a\", 1, [\"b\", 2]]"))
(should (equal (json-parse-string input)
["a" 1 ["b" 2]]))
(should (equal (json-parse-string input :array-type 'list)
'("a" 1 ("b" 2))))))
(ert-deftest json-parse-string/string ()
(skip-unless (fboundp 'json-parse-string))
(should-error (json-parse-string "[\"formfeed\f\"]") :type 'json-parse-error)
......
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