[elpa] externals/compat 476aa10 62/99: Add json-* functions from 27.1

[ELPA Syncer]

branch: externals/compat
commit 476aa10a63f609c66a9f22dc352a0fbfe3e93670
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Add json-* functions from 27.1
---
 compat-27.1.el  | 121 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 compat-tests.el |  34 ++++++++++++++++
 2 files changed, 155 insertions(+)

diff --git a/compat-27.1.el b/compat-27.1.el
index 59c5c1d..46847bd 100644
--- a/compat-27.1.el
+++ b/compat-27.1.el
@@ -105,6 +105,127 @@ Letter-case is significant, but text properties are 
ignored."
   (when (and redisplay recenter-redisplay)
     (redisplay)))
 
+;;;; Defined in json.c
+
+(declare-function json-encode-string "json" (object))
+(declare-function json-read-from-string "json" (string))
+(declare-function json-read "json" ())
+(defvar json-object-type)
+(defvar json-array-type)
+(defvar json-false)
+(defvar json-null)
+
+(compat-defun json-serialize (object &rest args)
+  "Return the JSON representation of OBJECT as a string.
+
+OBJECT must be t, a number, string, vector, hashtable, alist, plist,
+or the Lisp equivalents to the JSON null and false values, and its
+elements must recursively consist of the same kinds of values.  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."
+  (require 'json)
+  (let ((json-false (or (plist-get args :false-object) :false))
+        (json-null (or (plist-get args :null-object) :null)))
+    (json-encode-string object)))
+
+(compat-defun json-insert (object &rest args)
+  "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."
+  (insert (apply #'json-serialize object args)))
+
+(compat-defun json-parse-string (string &rest args)
+  "Parse the JSON STRING into a Lisp object.
+This is essentially the reverse operation of `json-serialize', which
+see.  The returned object will be the JSON null value, the JSON false
+value, t, a number, a string, a vector, a list, a hashtable, an alist,
+or a plist.  Its elements will be further objects of these types.  If
+there are duplicate keys in an object, all but the last one are
+ignored.  If STRING doesn't contain a valid JSON object, this function
+signals an error of type `json-parse-error'.
+
+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'.  It
+defaults to `hash-table'.
+
+The keyword argument `:array-type' specifies which Lisp type is used
+to represent arrays; it can be `array' (the default) or `list'.
+
+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'."
+  (require 'json)
+  (condition-case err
+      (let ((json-object-type (or (plist-get args :object-type) 'hash-table))
+            (json-array-type (or (plist-get args :array-type) 'vector))
+            (json-false (or (plist-get args :false-object) :false))
+            (json-null (or (plist-get args :null-object) :null)))
+        (when (eq json-array-type 'array)
+          (setq json-array-type 'vector))
+        (json-read-from-string string))
+    (json-error (signal 'json-parse-error err))))
+
+(compat-defun json-parse-buffer (&rest args)
+  "Read JSON object from current buffer starting at point.
+Move point after the end of the object if parsing was successful.
+On error, don't move point.
+
+The returned object will be a vector, list, hashtable, alist, or
+plist.  Its elements will be the JSON null value, the JSON false
+value, t, numbers, strings, or further vectors, lists, hashtables,
+alists, or plists.  If there are duplicate keys in an object, all
+but the last one are ignored.
+
+If the current buffer doesn't contain a valid JSON object, the
+function signals an error of type `json-parse-error'.
+
+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'.  It
+defaults to `hash-table'.
+
+The keyword argument `:array-type' specifies which Lisp type is used
+to represent arrays; it can be `array' (the default) or `list'.
+
+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'."
+  (require 'json)
+  (condition-case err
+      (let ((json-object-type (or (plist-get args :object-type) 'hash-table))
+            (json-array-type (or (plist-get args :array-type) 'vector))
+            (json-false (or (plist-get args :false-object) :false))
+            (json-null (or (plist-get args :null-object) :null)))
+        (when (eq json-array-type 'array)
+          (setq json-array-type 'vector))
+        (json-read))
+    (json-error (signal 'json-parse-buffer err))))
+
 ;;;; Defined in subr.el
 
 (compat-advise setq-local (&rest pairs)
diff --git a/compat-tests.el b/compat-tests.el
index d52ff93..213c9a4 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1262,5 +1262,39 @@ the compatibility function."
   (should-not
    (compat--and-let* (((= 5 6))) t)))
 
+(ert-deftest compat-json-parse-string ()
+  "Check if `compat--json-parse-string' was implemented properly."
+  (compat-test json-parse-string
+    (compat--should 0 "0")
+    (compat--should 1 "1")
+    (compat--should 0.5 "0.5")
+    (compat--should [1 2 3] "[1,2,3]")
+    (compat--should ["a" 2 3] "[\"a\",2,3]")
+    (compat--should [["a" 2] 3] "[[\"a\",2],3]")
+    (compat--should '(("a" 2) 3) "[[\"a\",2],3]" :array-type 'list)
+    (compat--should 'foo "null" :null-object 'foo)
+    (compat--should ["false" t] "[false, true]" :false-object "false"))
+  (let ((input "{\"key\":[\"abc\", 2], \"yek\": null}"))
+    (let ((obj (compat--json-parse-string input)))
+      (should (equal (gethash "key" obj) ["abc" 2]))
+      (should (equal (gethash "yek" obj) :null)))
+    (let ((obj (compat--json-parse-string input :object-type 'alist)))
+      (should (equal (cdr (assq 'key obj)) ["abc" 2]))
+      (should (equal (cdr (assq 'yek obj)) :null)))
+    (let ((obj (compat--json-parse-string input :object-type 'plist)))
+      (should (equal (plist-get obj :key) ["abc" 2]))
+      (should (equal (plist-get obj :yek) :null)))
+    (when (fboundp 'json-parse-string)
+      (let ((obj (json-parse-string input :object-type 'alist)))
+        (should (equal (cdr (assq 'key obj)) ["abc" 2]))
+        (should (equal (cdr (assq 'yek obj)) :null)))
+      (let ((obj (json-parse-string input :object-type 'plist)))
+        (should (equal (plist-get obj :key) ["abc" 2]))
+        (should (equal (plist-get obj :yek) :null)))
+      (let ((obj (json-parse-string input)))
+        (should (equal (gethash "key" obj) ["abc" 2]))
+        (should (equal (gethash "yek" obj) :null))))))
+
+
 (provide 'compat-tests)
 ;;; compat-tests.el ends here