[elpa] externals/compat 730f2c5ad6: Improve json-serialize compatibility

[ELPA Syncer]

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

    Improve json-serialize compatibility
    
    On closer inspection, there were more differences between
    `json-encode' and `json-serialize', that have to be rectified before
    the object is processed.  These include raising errors for the wrong
    data-types, where `json-serialize' is more strict than `json-encode'.
---
 compat-27.el    | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++----
 compat-tests.el | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 100 insertions(+), 4 deletions(-)

diff --git a/compat-27.el b/compat-27.el
index b74450f9cb..56f69267a2 100644
--- a/compat-27.el
+++ b/compat-27.el
@@ -125,9 +125,10 @@ Letter-case is significant, but text properties are 
ignored."
 ;;;; Defined in json.c
 
 (declare-function json-parse-string nil (string &rest args))
-(declare-function json-encode-string "json" (object))
+(declare-function json-encode "json" (object))
 (declare-function json-read-from-string "json" (string))
 (declare-function json-read "json" ())
+(defvar json-encoding-pretty-print)
 (defvar json-object-type)
 (defvar json-array-type)
 (defvar json-false)
@@ -165,9 +166,54 @@ any JSON false values."
           (void-function t))
   :realname compat--json-serialize
   (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)))
+  (letrec ((fix (lambda (obj)
+                  (cond
+                   ((hash-table-p obj)
+                    (let ((ht (copy-hash-table obj)))
+                      (maphash
+                       (lambda (key val)
+                         (unless (stringp key)
+                           (signal
+                            'wrong-type-argument
+                            (list 'stringp key)))
+                         (puthash key (funcall fix val) ht))
+                       obj)
+                      ht))
+                   ((and (listp obj) (consp (car obj))) ;alist
+                    (mapcar
+                     (lambda (ent)
+                       (cons (symbol-name (car ent))
+                             (funcall fix (cdr ent))))
+                     obj))
+                   ((listp obj) ;plist
+                    (let (alist)
+                      (while obj
+                        (push (cons (cond
+                                     ((keywordp (car obj))
+                                      (substring
+                                       (symbol-name (car obj))
+                                       1))
+                                     ((symbolp (car obj))
+                                      (symbol-name (car obj)))
+                                     ((signal
+                                       'wrong-type-argument
+                                       (list 'symbolp (car obj)))))
+                                    (funcall fix (cadr obj)))
+                              alist)
+                        (unless (consp (cdr obj))
+                          (signal 'wrong-type-argument '(consp nil)))
+                        (setq obj (cddr obj)))
+                      (nreverse alist)))
+                   ((vectorp obj)
+                    (let ((vec (make-vector (length obj) nil)))
+                      (dotimes (i (length obj))
+                        (aset vec i (funcall fix (aref obj i))))
+                      vec))
+                   (obj))))
+           (json-encoding-pretty-print nil)
+           (json-false (or (plist-get args :false-object) :false))
+           (json-null (or (plist-get args :null-object) :null)))
+    (json-encode (funcall fix object))))
 
 (compat-defun json-insert (object &rest args)
   "Insert the JSON representation of OBJECT before point.
diff --git a/compat-tests.el b/compat-tests.el
index 2c0e93d133..d4064246d3 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1222,6 +1222,56 @@ being compared against."
         (should (equal (gethash "key" obj) ["abc" 2]))
         (should (equal (gethash "yek" obj) :null))))))
 
+(ert-deftest compat-json-serialize ()
+  "Check if `compat--json-serialize' was implemented properly."
+  (let ((input-1 '((:key . ["abc" 2]) (yek . t)))
+        (input-2 '(:key ["abc" 2] yek t))
+        (input-3 (let ((ht (make-hash-table)))
+                   (puthash "key" ["abc" 2] ht)
+                   (puthash "yek" t ht)
+                   ht)))
+    (should (equal (compat--json-serialize input-1)
+                   "{\":key\":[\"abc\",2],\"yek\":true}"))
+    (should (equal (compat--json-serialize input-2)
+                   "{\"key\":[\"abc\",2],\"yek\":true}"))
+    (should (member (compat--json-serialize input-2)
+                    '("{\"key\":[\"abc\",2],\"yek\":true}"
+                      "{\"yek\":true,\"key\":[\"abc\",2]}")))
+    (should-error (compat--json-serialize '(("a" . 1)))
+                  :type '(wrong-type-argument symbolp "a"))
+    (should-error (compat--json-serialize '("a" 1))
+                  :type '(wrong-type-argument symbolp "a"))
+    (should-error (compat--json-serialize '("a" 1 2))
+                  :type '(wrong-type-argument symbolp "a"))
+    (should-error (compat--json-serialize '(:a 1 2))
+                  :type '(wrong-type-argument consp nil))
+    (should-error (compat--json-serialize
+                   (let ((ht (make-hash-table)))
+                     (puthash 'a 1 ht)
+                     ht))
+                  :type '(wrong-type-argument stringp a))
+    (when (fboundp 'json-serialize)
+      (should (equal (json-serialize input-1)
+                     "{\":key\":[\"abc\",2],\"yek\":true}"))
+      (should (equal (json-serialize input-2)
+                     "{\"key\":[\"abc\",2],\"yek\":true}"))
+      (should (member (json-serialize input-2)
+                      '("{\"key\":[\"abc\",2],\"yek\":true}"
+                        "{\"yek\":true,\"key\":[\"abc\",2]}")))
+      (should-error (json-serialize '(("a" . 1)))
+                    :type '(wrong-type-argument symbolp "a"))
+      (should-error (json-serialize '("a" 1))
+                    :type '(wrong-type-argument symbolp "a"))
+      (should-error (json-serialize '("a" 1 2))
+                    :type '(wrong-type-argument symbolp "a"))
+      (should-error (json-serialize '(:a 1 2))
+                    :type '(wrong-type-argument consp nil))
+      (should-error (json-serialize
+                     (let ((ht (make-hash-table)))
+                       (puthash 'a 1 ht)
+                       ht))
+                    :type '(wrong-type-argument stringp a)))))
+
 (compat-deftest compat-lookup-key
   (let ((a-map (make-sparse-keymap))
         (b-map (make-sparse-keymap)))