aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJoão Távora2018-06-07 17:41:19 +0100
committerJoão Távora2018-06-15 00:11:56 +0100
commit9348039ed45c8e493e8bfef0220249d4d31ef6da (patch)
treee7f79a9013d4b80bfb6b980a216419662f982866
parent8cb9beb32163fa3ce3b052ced646fd673814ddc6 (diff)
downloademacs-9348039ed45c8e493e8bfef0220249d4d31ef6da.tar.gz
emacs-9348039ed45c8e493e8bfef0220249d4d31ef6da.zip
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.
-rw-r--r--doc/lispref/text.texi45
-rw-r--r--src/json.c136
-rw-r--r--test/src/json-tests.el29
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:
5008@itemize 5008@itemize
5009 5009
5010@item 5010@item
5011JSON has a couple of keywords: @code{null}, @code{false}, and 5011JSON uses three keywords: @code{true}, @code{null}, @code{false}.
5012@code{true}. These are represented in Lisp using the keywords 5012@code{true} is represented by the symbol @code{t}. By default, the
5013@code{:null}, @code{:false}, and @code{t}, respectively. 5013remaining two are represented, respectively, by the symbols
5014@code{:null} and @code{:false}.
5014 5015
5015@item 5016@item
5016JSON only has floating-point numbers. They can represent both Lisp 5017JSON 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
5062type. Likewise, the parsing functions will only return vectors, 5063type. Likewise, the parsing functions will only return vectors,
5063hashtables, alists, and plists. 5064hashtables, alists, and plists.
5064 5065
5065 The parsing functions accept keyword arguments. Currently only one
5066keyword argument, @code{:object-type}, is recognized; its value
5067decides which Lisp object to use for representing the key-value
5068mappings of a JSON object. It can be either @code{hash-table}, the
5069default, to make hashtables with strings as keys, @code{alist} to use
5070alists with symbols as keys or @code{plist} to use plists with keyword
5071symbols as keys.
5072
5073@defun json-serialize object 5066@defun json-serialize object
5074This function returns a new Lisp string which contains the JSON 5067This function returns a new Lisp string which contains the JSON
5075representation of @var{object}. 5068representation of @var{object}.
@@ -5080,16 +5073,38 @@ This function inserts the JSON representation of @var{object} into the
5080current buffer before point. 5073current buffer before point.
5081@end defun 5074@end defun
5082 5075
5083@defun json-parse-string string &key (object-type @code{hash-table}) 5076@defun json-parse-string string &rest args
5084This function parses the JSON value in @var{string}, which must be a 5077This function parses the JSON value in @var{string}, which must be a
5085Lisp string. 5078Lisp string. The argument @var{args} is a list of keyword/argument
5079pairs. The following keywords are accepted:
5080
5081@itemize
5082
5083@item @code{:object-type}
5084The value decides which Lisp object to use for representing the
5085key-value mappings of a JSON object. It can be either
5086@code{hash-table}, the default, to make hashtables with strings as
5087keys; @code{alist} to use alists with symbols as keys; or @code{plist}
5088to use plists with keyword symbols as keys.
5089
5090@item @code{:null-object}
5091The value decides which Lisp object to use to represent the JSON
5092keyword @code{null}. It defaults to the lisp symbol @code{:null}.
5093
5094@item @code{:false-object}
5095The value decides which Lisp object to use to represent the JSON
5096keyword @code{false}. It defaults to the lisp symbol @code{:false}.
5097
5098@end itemize
5099
5086@end defun 5100@end defun
5087 5101
5088@defun json-parse-buffer &key (object-type @code{hash-table}) 5102@defun json-parse-buffer &rest args
5089This function reads the next JSON value from the current buffer, 5103This function reads the next JSON value from the current buffer,
5090starting at point. It moves point to the position immediately after 5104starting at point. It moves point to the position immediately after
5091the value if a value could be read and converted to Lisp; otherwise it 5105the value if a value could be read and converted to Lisp; otherwise it
5092doesn't move point. 5106doesn't move point. @var{args} is interpreted as in
5107@code{json-parse-string}.
5093@end defun 5108@end defun
5094 5109
5095 5110
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.
7GNU Emacs is free software: you can redistribute it and/or modify 7GNU Emacs is free software: you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by 8it under the terms of the GNU General Public License as published by
9the Free Software Foundation, either version 3 of the License, or (at 9the Free Software Foundation, either version 3 of the License, or (at
10your option) any later version. 10nyour option) any later version.
11 11
12GNU Emacs is distributed in the hope that it will be useful, 12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of 13but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -502,7 +502,7 @@ and plists are converted to JSON objects. Hashtable keys must be
502strings without embedded null characters and must be unique within 502strings without embedded null characters and must be unique within
503each object. Alist and plist keys must be symbols; if a key is 503each object. Alist and plist keys must be symbols; if a key is
504duplicate, the first instance is used. */) 504duplicate, the first instance is used. */)
505 (Lisp_Object object) 505 (Lisp_Object object)
506{ 506{
507 ptrdiff_t count = SPECPDL_INDEX (); 507 ptrdiff_t count = SPECPDL_INDEX ();
508 508
@@ -579,10 +579,10 @@ json_insert_callback (const char *buffer, size_t size, void *data)
579 579
580DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, NULL, 580DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, NULL,
581 doc: /* Insert the JSON representation of OBJECT before point. 581 doc: /* Insert the JSON representation of OBJECT before point.
582This is the same as (insert (json-serialize OBJECT)), but potentially 582 This is the same as (insert (json-serialize OBJECT)), but potentially
583faster. See the function `json-serialize' for allowed values of 583 faster. See the function `json-serialize' for allowed values of
584OBJECT. */) 584 OBJECT. */)
585 (Lisp_Object object) 585 (Lisp_Object object)
586{ 586{
587 ptrdiff_t count = SPECPDL_INDEX (); 587 ptrdiff_t count = SPECPDL_INDEX ();
588 588
@@ -621,22 +621,28 @@ OBJECT. */)
621} 621}
622 622
623enum json_object_type { 623enum json_object_type {
624 json_object_hashtable, 624 json_object_hashtable,
625 json_object_alist, 625 json_object_alist,
626 json_object_plist 626 json_object_plist
627};
628
629struct json_configuration {
630 enum json_object_type object_type;
631 Lisp_Object null_object;
632 Lisp_Object false_object;
627}; 633};
628 634
629/* Convert a JSON object to a Lisp object. */ 635/* Convert a JSON object to a Lisp object. */
630 636
631static _GL_ARG_NONNULL ((1)) Lisp_Object 637static _GL_ARG_NONNULL ((1)) Lisp_Object
632json_to_lisp (json_t *json, enum json_object_type object_type) 638json_to_lisp (json_t *json, struct json_configuration *conf)
633{ 639{
634 switch (json_typeof (json)) 640 switch (json_typeof (json))
635 { 641 {
636 case JSON_NULL: 642 case JSON_NULL:
637 return QCnull; 643 return conf->null_object;
638 case JSON_FALSE: 644 case JSON_FALSE:
639 return QCfalse; 645 return conf->false_object;
640 case JSON_TRUE: 646 case JSON_TRUE:
641 return Qt; 647 return Qt;
642 case JSON_INTEGER: 648 case JSON_INTEGER:
@@ -644,9 +650,9 @@ json_to_lisp (json_t *json, enum json_object_type object_type)
644 otherwise. This loses precision for integers with large 650 otherwise. This loses precision for integers with large
645 magnitude; however, such integers tend to be nonportable 651 magnitude; however, such integers tend to be nonportable
646 anyway because many JSON implementations use only 64-bit 652 anyway because many JSON implementations use only 64-bit
647 floating-point numbers with 53 mantissa bits. See 653 floating-point numbers with 53 mantissa bits. See
648 https://tools.ietf.org/html/rfc7159#section-6 for some 654 https://tools.ietf.org/html/rfc7159#section-6 for some
649 discussion. */ 655 discussion. */
650 return make_fixnum_or_float (json_integer_value (json)); 656 return make_fixnum_or_float (json_integer_value (json));
651 case JSON_REAL: 657 case JSON_REAL:
652 return make_float (json_real_value (json)); 658 return make_float (json_real_value (json));
@@ -663,7 +669,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type)
663 Lisp_Object result = Fmake_vector (make_natnum (size), Qunbound); 669 Lisp_Object result = Fmake_vector (make_natnum (size), Qunbound);
664 for (ptrdiff_t i = 0; i < size; ++i) 670 for (ptrdiff_t i = 0; i < size; ++i)
665 ASET (result, i, 671 ASET (result, i,
666 json_to_lisp (json_array_get (json, i), object_type)); 672 json_to_lisp (json_array_get (json, i), conf));
667 --lisp_eval_depth; 673 --lisp_eval_depth;
668 return result; 674 return result;
669 } 675 }
@@ -672,7 +678,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type)
672 if (++lisp_eval_depth > max_lisp_eval_depth) 678 if (++lisp_eval_depth > max_lisp_eval_depth)
673 xsignal0 (Qjson_object_too_deep); 679 xsignal0 (Qjson_object_too_deep);
674 Lisp_Object result; 680 Lisp_Object result;
675 switch (object_type) 681 switch (conf->object_type)
676 { 682 {
677 case json_object_hashtable: 683 case json_object_hashtable:
678 { 684 {
@@ -692,7 +698,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type)
692 /* Keys in JSON objects are unique, so the key can't 698 /* Keys in JSON objects are unique, so the key can't
693 be present yet. */ 699 be present yet. */
694 eassert (i < 0); 700 eassert (i < 0);
695 hash_put (h, key, json_to_lisp (value, object_type), hash); 701 hash_put (h, key, json_to_lisp (value, conf), hash);
696 } 702 }
697 break; 703 break;
698 } 704 }
@@ -705,7 +711,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type)
705 { 711 {
706 Lisp_Object key = Fintern (json_build_string (key_str), Qnil); 712 Lisp_Object key = Fintern (json_build_string (key_str), Qnil);
707 result 713 result
708 = Fcons (Fcons (key, json_to_lisp (value, object_type)), 714 = Fcons (Fcons (key, json_to_lisp (value, conf)),
709 result); 715 result);
710 } 716 }
711 result = Fnreverse (result); 717 result = Fnreverse (result);
@@ -727,7 +733,7 @@ json_to_lisp (json_t *json, enum json_object_type object_type)
727 /* Build the plist as value-key since we're going to 733 /* Build the plist as value-key since we're going to
728 reverse it in the end.*/ 734 reverse it in the end.*/
729 result = Fcons (key, result); 735 result = Fcons (key, result);
730 result = Fcons (json_to_lisp (value, object_type), result); 736 result = Fcons (json_to_lisp (value, conf), result);
731 SAFE_FREE (); 737 SAFE_FREE ();
732 } 738 }
733 result = Fnreverse (result); 739 result = Fnreverse (result);
@@ -745,47 +751,66 @@ json_to_lisp (json_t *json, enum json_object_type object_type)
745 emacs_abort (); 751 emacs_abort ();
746} 752}
747 753
748static enum json_object_type 754static void
749json_parse_object_type (ptrdiff_t nargs, Lisp_Object *args) 755json_parse_args (ptrdiff_t nargs,
750{ 756 Lisp_Object *args,
751 switch (nargs) 757 struct json_configuration *conf)
752 { 758{
753 case 0: 759 if ((nargs % 2) != 0)
754 return json_object_hashtable; 760 wrong_type_argument (Qplistp, Flist (nargs, args));
755 case 2: 761
762 /* Start from the back so keyword values appearing
763 first take precedence. */
764 for (ptrdiff_t i = nargs; i > 0; i -= 2) {
765 Lisp_Object key = args[i - 2];
766 Lisp_Object value = args[i - 1];
767 if (EQ (key, QCobject_type))
756 { 768 {
757 Lisp_Object key = args[0];
758 Lisp_Object value = args[1];
759 if (!EQ (key, QCobject_type))
760 wrong_choice (list1 (QCobject_type), key);
761 if (EQ (value, Qhash_table)) 769 if (EQ (value, Qhash_table))
762 return json_object_hashtable; 770 conf->object_type = json_object_hashtable;
763 else if (EQ (value, Qalist)) 771 else if (EQ (value, Qalist))
764 return json_object_alist; 772 conf->object_type = json_object_alist;
765 else if (EQ (value, Qplist)) 773 else if (EQ (value, Qplist))
766 return json_object_plist; 774 conf->object_type = json_object_plist;
767 else 775 else
768 wrong_choice (list3 (Qhash_table, Qalist, Qplist), value); 776 wrong_choice (list3 (Qhash_table, Qalist, Qplist), value);
769 } 777 }
770 default: 778 else if (EQ (key, QCnull_object))
771 wrong_type_argument (Qplistp, Flist (nargs, args)); 779 conf->null_object = value;
772 } 780 else if (EQ (key, QCfalse_object))
781 conf->false_object = value;
782 else
783 wrong_choice (list3 (QCobject_type,
784 QCnull_object,
785 QCfalse_object),
786 value);
787 }
773} 788}
774 789
775DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY, 790DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY,
776 NULL, 791 NULL,
777 doc: /* Parse the JSON STRING into a Lisp object. 792 doc: /* Parse the JSON STRING into a Lisp object.
793
778This is essentially the reverse operation of `json-serialize', which 794This is essentially the reverse operation of `json-serialize', which
779see. The returned object will be a vector, hashtable, alist, or 795see. The returned object will be a vector, hashtable, alist, or
780plist. Its elements will be `:null', `:false', t, numbers, strings, 796plist. Its elements will be the JSON null value, the JSON false
781or further vectors, hashtables, alists, or plists. If there are 797value, t, numbers, strings, or further vectors, hashtables, alists, or
782duplicate keys in an object, all but the last one are ignored. If 798plists. If there are duplicate keys in an object, all but the last
783STRING doesn't contain a valid JSON object, an error of type 799one are ignored. If STRING doesn't contain a valid JSON object, an
784`json-parse-error' is signaled. The keyword argument `:object-type' 800error of type `json-parse-error' is signaled. The arguments ARGS are
785specifies which Lisp type is used to represent objects; it can be 801a list of keyword/argument pairs:
786`hash-table', `alist' or `plist'. 802
787usage: (json-parse-string STRING &key (OBJECT-TYPE \\='hash-table)) */) 803The keyword argument `:object-type' specifies which Lisp type is used
788 (ptrdiff_t nargs, Lisp_Object *args) 804to represent objects; it can be `hash-table', `alist' or `plist'.
805
806The keyword argument `:null-object' specifies which object to use
807to represent a JSON null value. It defaults to `:null'.
808
809The keyword argument `:false-object' specifies which object to use to
810represent a JSON false value. It defaults to `:false'.
811
812usage: (json-parse-string STRING &rest args) */)
813 (ptrdiff_t nargs, Lisp_Object *args)
789{ 814{
790 ptrdiff_t count = SPECPDL_INDEX (); 815 ptrdiff_t count = SPECPDL_INDEX ();
791 816
@@ -807,8 +832,8 @@ usage: (json-parse-string STRING &key (OBJECT-TYPE \\='hash-table)) */)
807 Lisp_Object string = args[0]; 832 Lisp_Object string = args[0];
808 Lisp_Object encoded = json_encode (string); 833 Lisp_Object encoded = json_encode (string);
809 check_string_without_embedded_nulls (encoded); 834 check_string_without_embedded_nulls (encoded);
810 enum json_object_type object_type 835 struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
811 = json_parse_object_type (nargs - 1, args + 1); 836 json_parse_args (nargs - 1, args + 1, &conf);
812 837
813 json_error_t error; 838 json_error_t error;
814 json_t *object = json_loads (SSDATA (encoded), 0, &error); 839 json_t *object = json_loads (SSDATA (encoded), 0, &error);
@@ -819,7 +844,7 @@ usage: (json-parse-string STRING &key (OBJECT-TYPE \\='hash-table)) */)
819 if (object != NULL) 844 if (object != NULL)
820 record_unwind_protect_ptr (json_release_object, object); 845 record_unwind_protect_ptr (json_release_object, object);
821 846
822 return unbind_to (count, json_to_lisp (object, object_type)); 847 return unbind_to (count, json_to_lisp (object, &conf));
823} 848}
824 849
825struct json_read_buffer_data 850struct json_read_buffer_data
@@ -857,8 +882,8 @@ DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer,
857This is similar to `json-parse-string', which see. Move point after 882This is similar to `json-parse-string', which see. Move point after
858the end of the object if parsing was successful. On error, point is 883the end of the object if parsing was successful. On error, point is
859not moved. 884not moved.
860usage: (json-parse-buffer &key (OBJECT-TYPE \\='hash-table)) */) 885usage: (json-parse-buffer &rest args) */)
861 (ptrdiff_t nargs, Lisp_Object *args) 886 (ptrdiff_t nargs, Lisp_Object *args)
862{ 887{
863 ptrdiff_t count = SPECPDL_INDEX (); 888 ptrdiff_t count = SPECPDL_INDEX ();
864 889
@@ -877,7 +902,8 @@ usage: (json-parse-buffer &key (OBJECT-TYPE \\='hash-table)) */)
877 } 902 }
878#endif 903#endif
879 904
880 enum json_object_type object_type = json_parse_object_type (nargs, args); 905 struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
906 json_parse_args (nargs, args, &conf);
881 907
882 ptrdiff_t point = PT_BYTE; 908 ptrdiff_t point = PT_BYTE;
883 struct json_read_buffer_data data = {.point = point}; 909 struct json_read_buffer_data data = {.point = point};
@@ -892,7 +918,7 @@ usage: (json-parse-buffer &key (OBJECT-TYPE \\='hash-table)) */)
892 record_unwind_protect_ptr (json_release_object, object); 918 record_unwind_protect_ptr (json_release_object, object);
893 919
894 /* Convert and then move point only if everything succeeded. */ 920 /* Convert and then move point only if everything succeeded. */
895 Lisp_Object lisp = json_to_lisp (object, object_type); 921 Lisp_Object lisp = json_to_lisp (object, &conf);
896 922
897 /* Adjust point by how much we just read. */ 923 /* Adjust point by how much we just read. */
898 point += error.position; 924 point += error.position;
@@ -955,6 +981,8 @@ syms_of_json (void)
955 Fput (Qjson_parse_string, Qside_effect_free, Qt); 981 Fput (Qjson_parse_string, Qside_effect_free, Qt);
956 982
957 DEFSYM (QCobject_type, ":object-type"); 983 DEFSYM (QCobject_type, ":object-type");
984 DEFSYM (QCnull_object, ":null-object");
985 DEFSYM (QCfalse_object, ":false-object");
958 DEFSYM (Qalist, "alist"); 986 DEFSYM (Qalist, "alist");
959 DEFSYM (Qplist, "plist"); 987 DEFSYM (Qplist, "plist");
960 988
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."
209 (should-not (bobp)) 209 (should-not (bobp))
210 (should (looking-at-p (rx " [456]" eos))))) 210 (should (looking-at-p (rx " [456]" eos)))))
211 211
212(ert-deftest json-parse-with-custom-null-and-false-objects ()
213 (let ((input
214 "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n"))
215 (should (equal (json-parse-string input
216 :object-type 'plist
217 :null-object :json-null
218 :false-object :json-false)
219 '(:abc [9 :json-false] :def :json-null)))
220 (should (equal (json-parse-string input
221 :object-type 'plist
222 :false-object :json-false)
223 '(:abc [9 :json-false] :def :null)))
224 (should (equal (json-parse-string input
225 :object-type 'alist
226 :null-object :zilch)
227 '((abc . [9 :false]) (def . :zilch))))
228 (should (equal (json-parse-string input
229 :object-type 'alist
230 :false-object nil
231 :null-object nil)
232 '((abc . [9 nil]) (def))))
233 (let* ((thingy '(1 2 3))
234 (retval (json-parse-string input
235 :object-type 'alist
236 :false-object thingy
237 :null-object nil)))
238 (should (equal retval `((abc . [9 ,thingy]) (def))))
239 (should (eq (elt (cdr (car retval)) 1) thingy)))))
240
212(ert-deftest json-insert/signal () 241(ert-deftest json-insert/signal ()
213 (skip-unless (fboundp 'json-insert)) 242 (skip-unless (fboundp 'json-insert))
214 (with-temp-buffer 243 (with-temp-buffer