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

[Vibhav Pant <vibhavp@gmail.com>]

On Mon, Apr 24, 2017 at 6:55 PM, Ted Zlatanov <tzz@lifelogs.com> wrote:
> Nice! I hope that goes in. Can you please write tests for it?
Done.


> Is it possible to also exclude fields with :json nil? I think that's
> very useful.
That would mean that all struct field will have to be explicitly declared
with a :json option to not be ignored. Instead, I've added a :json-ignore
option that makes json-encode-struct ignore the slot ignore it when it's
non-nil.

> Finally, it would be great to be able to declare the JSON type of the
> field.
Yep, done.


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

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

 ;; Parameters

@@ -549,6 +550,60 @@ 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 (error "Unknown :json-type value."))))
+
+;; 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))
+                                  (key (or (plist-get opts :json) slot-name))
+                                  (ignore (plist-get opts :json-ignore))
+                                  (type (plist-get opts :json-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 +776,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..58065d22e5 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -31,6 +31,30 @@ json-tests--with-temp-buffer
      (goto-char (point-min))
      ,@body))

+;;; Structs
+
+(cl-defstruct json-test-struct
+  (f1 1 :json "field-1" :json-type number)
+  (f2 'foo :json "field-2" :json-type string)
+  (f3 (current-buffer) :json-ignore t) ;; this field should be ignored
+  (f4 "1" :json "field-4" :json-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))
+
 ;;; Utilities

 (ert-deftest test-json-join ()


-- 
Vibhav Pant
vibhavp@gmail.com