Re: [PATCH] json: Add support for encoding structs

[Vibhav Pant]

On Tue, Apr 25, 2017 at 7:56 PM, Ted Zlatanov <address@hidden> wrote:
> Maybe one way is to distinguish '(:serialize-field nil) from '() by
> checking with memq for the key?

Good idea. `plist-member' seems to do the job. I've updated the patch
accordingly, thanks.


---
diff --git a/lisp/json.el b/lisp/json.el
index 049c9b1951..0d4503fe3b 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -53,6 +53,7 @@
 ;;; Code:

 (require 'map)
+(require 'cl-lib)

 ;; Parameters

@@ -222,6 +223,8 @@ 'json-key-format
 (define-error 'json-object-format "Bad JSON object" 'json-error)
 (define-error 'json-end-of-file "End of file while parsing JSON"
   '(end-of-file json-error))
+(define-error 'json-unkown-serialize-type "Unknown :serialize-to-type value"
+  'json-error)



@@ -549,6 +552,62 @@ json-encode-hash-table
                 ""
               json--encoding-current-indentation))))

+(defun json-to-string (object)
+  (if (numberp object)
+      (number-to-string object)
+    object))
+
+(defun json-to-number (object)
+  (if (stringp object)
+      (string-to-number object)
+    object))
+
+(defun json-convert-to-type (object type)
+  (cond ((memq type '(number integer))
+         (json-to-number object))
+        ((eq type 'float)
+         (float (string-to-number object)))
+        ((eq type 'string)
+         (json-to-string object))
+        ((eq type nil) object)
+        (t (signal 'json-unkown-serialize-type type))))
+
+;; Struct encoding
+(defun json-encode-struct (struct)
+  "Return a JSON representation of STRUCT."
+  (let* ((struct-type (type-of struct))
+         (slots-info (cdr (cl-struct-slot-info struct-type))))
+    (format "{%s%s}"
+            (json-join
+             (json--with-indentation
+              (remq
+               nil
+               (mapcar #'(lambda (slot)
+                           (let* ((slot-name (car slot))
+                                  (opts (cddr slot))
+                                  (serialize-field (plist-get opts
:serialize-field))
+                                  (key (or serialize-field slot-name))
+                                  (ignore (and (null serialize-field)
+                                               (plist-member opts
:serialize-field)))
+                                  (type (plist-get opts :serialize-to-type))
+                                  (slot-value (cl-struct-slot-value struct-type
+                                                                    slot-name
+                                                                    struct)))
+                             (unless ignore
+                               (format (if json-encoding-pretty-print
+                                           "%s%s: %s"
+                                         "%s%s:%s")
+                                       json--encoding-current-indentation
+                                       (json-encode-key key)
+                                       (json-encode (json-convert-to-type
+                                                     slot-value type))))))
+                       slots-info)))
+             json-encoding-separator)
+            (if (or (not json-encoding-pretty-print)
+                    json-encoding-lisp-style-closings)
+                ""
+              json--encoding-current-indentation))))
+
 ;; List encoding (including alists and plists)

 (defun json-encode-alist (alist)
@@ -721,6 +780,7 @@ json-encode
         ((arrayp object)       (json-encode-array object))
         ((hash-table-p object) (json-encode-hash-table object))
         ((listp object)        (json-encode-list object))
+        ((cl-struct-p object)  (json-encode-struct object))
         (t                     (signal 'json-error (list object)))))

 ;; Pretty printing
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el
index 38672de066..1b17c3c55d 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -294,6 +294,30 @@ json-tests--with-temp-buffer
     (should (equal (json-encode-array [1 2 "a" "b"])
                    "[1,2,\"a\",\"b\"]"))))

+;;; Structs
+
+(cl-defstruct json-test-struct
+  (f1 1 :serialize-field "field-1" :serialize-to-type number)
+  (f2 'foo :serialize-field "field-2" :serialize-to-type string)
+  (f3 (current-buffer) :serialize-field nil) ;; this field should be ignored
+  (f4 "1" :serialize-field "field-4" :serialize-to-type number))
+
+(ert-deftest test-json-structs ()
+  (should (equal (json-encode-struct (make-json-test-struct))
+                 "{\"field-1\":1,\"field-2\":\"foo\",\"field-4\":1}"))
+  (should (equal (json-encode-struct (make-json-test-struct
+                                      :f1 "123"
+                                      :f2 123
+                                      :f4 423))
+                 "{\"field-1\":123,\"field-2\":\"123\",\"field-4\":423}"))
+  (should (equal (json-encode-struct (make-json-test-struct
+                                      :f1 1.79e+308
+                                      :f2 -1.79e+308
+                                      :f4 423))
+
"{\"field-1\":1.79e+308,\"field-2\":\"-1.79e+308\",\"field-4\":423}"))
+  (should-error (json-encode (make-json-test-struct :f1 (current-buffer)))
+                :type 'json-error))
+
 ;;; Reader

 (ert-deftest test-json-read ()

-- 
Vibhav Pant
address@hidden