From eb1162893fadd928a893a79fe0ddeaf827e5dfc5 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Wed, 13 Dec 2017 23:35:07 +0100 Subject: [PATCH] Allow JSON parser functions to return alists * src/json.c (Fjson_parse_string, Fjson_parse_buffer): Give these functions a keyword argument to specify the return type for JSON objects. (json_to_lisp): Convert objects to alists if requested. (json_parse_object_type): New helper function to parse keyword arguments. * test/src/json-tests.el (json-parse-string/object): Add a unit test. * doc/lispref/text.texi (Parsing JSON): Document new functionality. --- doc/lispref/text.texi | 20 ++++---- src/json.c | 128 +++++++++++++++++++++++++++++++++++++------------ test/src/json-tests.el | 16 ++++--- 3 files changed, 119 insertions(+), 45 deletions(-) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 5b288d9750..7517dbcfb6 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4965,14 +4965,13 @@ Parsing JSON @item JSON has only one map type, the object. JSON objects are represented -using Lisp hashtables. +using Lisp hashtables or alists. @end itemize @noindent -Note that @code{nil} doesn't represent any JSON values: this is to -avoid confusion, because @code{nil} could either represent address@hidden, @code{false}, or an empty array, all of which are +Note that @code{nil} represents the empty JSON object, @address@hidden@}}, +not @code{null}, @code{false}, or an empty array, all of which are different JSON values. If some Lisp object can't be represented in JSON, the serialization @@ -4995,8 +4994,13 @@ Parsing JSON Only top-level values (arrays and objects) can be serialized to JSON. The subobjects within these top-level values can be of any -type. Likewise, the parsing functions will only return vectors and -hashtables. +type. Likewise, the parsing functions will only return vectors, +hashtables, and alists. + + The parsing functions accept keyword arguments. Currently only one +keyword argument, @code{:object-type}, is recognized; its value can be +either @code{hash-table} to parse JSON objects as hashtables with +string keys (the default) or @code{alist} to parse them as alists. @defun json-serialize object This function returns a new Lisp string which contains the JSON @@ -5008,12 +5012,12 @@ Parsing JSON current buffer before point. @end defun address@hidden json-parse-string string address@hidden json-parse-string string &key (object-type 'hash-table) This function parses the JSON value in @var{string}, which must be a Lisp string. @end defun address@hidden json-parse-buffer address@hidden json-parse-buffer &key (object-type 'hash-table) 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 diff --git a/src/json.c b/src/json.c index 7025ae165c..34c568d76f 100644 --- a/src/json.c +++ b/src/json.c @@ -507,10 +507,15 @@ OBJECT. */) return unbind_to (count, Qnil); } +enum json_object_type { + json_object_hashtable, + json_object_alist, +}; + /* Convert a JSON object to a Lisp object. */ static _GL_ARG_NONNULL ((1)) Lisp_Object -json_to_lisp (json_t *json) +json_to_lisp (json_t *json, enum json_object_type object_type) { switch (json_typeof (json)) { @@ -544,7 +549,7 @@ json_to_lisp (json_t *json) 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))); + json_to_lisp (json_array_get (json, i), object_type)); --lisp_eval_depth; return result; } @@ -552,23 +557,49 @@ json_to_lisp (json_t *json) { if (++lisp_eval_depth > max_lisp_eval_depth) xsignal0 (Qjson_object_too_deep); - size_t size = json_object_size (json); - if (FIXNUM_OVERFLOW_P (size)) - xsignal0 (Qoverflow_error); - Lisp_Object result = CALLN (Fmake_hash_table, QCtest, Qequal, - QCsize, make_natnum (size)); - struct Lisp_Hash_Table *h = XHASH_TABLE (result); - const char *key_str; - json_t *value; - json_object_foreach (json, key_str, value) + Lisp_Object result; + switch (object_type) { - Lisp_Object key = json_build_string (key_str); - EMACS_UINT hash; - ptrdiff_t i = hash_lookup (h, key, &hash); - /* 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), hash); + case json_object_hashtable: + { + size_t size = json_object_size (json); + if (FIXNUM_OVERFLOW_P (size)) + xsignal0 (Qoverflow_error); + result = CALLN (Fmake_hash_table, QCtest, Qequal, QCsize, + make_natnum (size)); + struct Lisp_Hash_Table *h = XHASH_TABLE (result); + const char *key_str; + json_t *value; + json_object_foreach (json, key_str, value) + { + Lisp_Object key = json_build_string (key_str); + EMACS_UINT hash; + ptrdiff_t i = hash_lookup (h, key, &hash); + /* 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); + } + break; + } + case json_object_alist: + { + result = Qnil; + const char *key_str; + json_t *value; + json_object_foreach (json, key_str, value) + { + Lisp_Object key = Fintern (json_build_string (key_str), Qnil); + result + = Fcons (Fcons (key, json_to_lisp (value, object_type)), + result); + } + result = Fnreverse (result); + break; + } + default: + /* Can’t get here. */ + emacs_abort (); } --lisp_eval_depth; return result; @@ -578,15 +609,43 @@ json_to_lisp (json_t *json) emacs_abort (); } -DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, 1, NULL, +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: { + 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; + else if (EQ (value, Qalist)) + return json_object_alist; + else + wrong_choice (list2 (Qhash_table, Qalist), value); + } + default: + wrong_type_argument (Qplistp, Flist (nargs, args)); + } +} + +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 or hashtable. Its elements -will be `:null', `:false', t, numbers, strings, or further vectors and -hashtables. 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. */) - (Lisp_Object string) +see. The returned object will be a vector, hashtable, or alist. Its +elements will be `:null', `:false', t, numbers, strings, or further +vectors, hashtables, and alists. 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' or `alist'. +usage: (string &key (OBJECT-TYPE \\='hash-table)) */) + (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); @@ -605,8 +664,11 @@ an error of type `json-parse-error' is signaled. */) } #endif + 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); json_error_t error; json_t *object = json_loads (SSDATA (encoded), 0, &error); @@ -617,7 +679,7 @@ an error of type `json-parse-error' is signaled. */) if (object != NULL) record_unwind_protect_ptr (json_release_object, object); - return unbind_to (count, json_to_lisp (object)); + return unbind_to (count, json_to_lisp (object, object_type)); } struct json_read_buffer_data @@ -650,12 +712,13 @@ json_read_buffer_callback (void *buffer, size_t buflen, void *data) } DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer, - 0, 0, NULL, + 0, MANY, NULL, doc: /* Read JSON object from current buffer starting at point. 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. */) - (void) +not moved. +usage: (&key (OBJECT-TYPE \\='hash-table)) */) + (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t count = SPECPDL_INDEX (); @@ -674,6 +737,8 @@ not moved. */) } #endif + enum json_object_type object_type = json_parse_object_type (nargs, args); + ptrdiff_t point = PT_BYTE; struct json_read_buffer_data data = {.point = point}; json_error_t error; @@ -687,7 +752,7 @@ not moved. */) record_unwind_protect_ptr (json_release_object, object); /* Convert and then move point only if everything succeeded. */ - Lisp_Object lisp = json_to_lisp (object); + Lisp_Object lisp = json_to_lisp (object, object_type); /* Adjust point by how much we just read. */ point += error.position; @@ -750,6 +815,9 @@ syms_of_json (void) Fput (Qjson_parse_string, Qpure, Qt); Fput (Qjson_parse_string, Qside_effect_free, Qt); + DEFSYM (QCobject_type, ":object-type"); + DEFSYM (Qalist, "alist"); + defsubr (&Sjson_serialize); defsubr (&Sjson_insert); defsubr (&Sjson_parse_string); diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 07eb41d093..da51aac8c8 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -52,13 +52,15 @@ (ert-deftest json-parse-string/object () (skip-unless (fboundp 'json-parse-string)) - (let ((actual - (json-parse-string - "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n"))) - (should (hash-table-p actual)) - (should (equal (hash-table-count actual) 2)) - (should (equal (cl-sort (map-pairs actual) #'string< :key #'car) - '(("abc" . [9 :false]) ("def" . :null)))))) + (let ((input + "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n")) + (let ((actual (json-parse-string input))) + (should (hash-table-p actual)) + (should (equal (hash-table-count actual) 2)) + (should (equal (cl-sort (map-pairs actual) #'string< :key #'car) + '(("abc" . [9 :false]) ("def" . :null))))) + (should (equal (json-parse-string input :object-type 'alist) + '((abc . [9 :false]) (def . :null)))))) (ert-deftest json-parse-string/string () (skip-unless (fboundp 'json-parse-string)) -- 2.15.1