[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH] json: Add support for encoding structs
From: |
Vibhav Pant |
Subject: |
Re: [PATCH] json: Add support for encoding structs |
Date: |
Tue, 25 Apr 2017 21:56:16 +0530 |
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
- [PATCH] json: Add support for encoding structs, Vibhav Pant, 2017/04/23
- Re: [PATCH] json: Add support for encoding structs, Ted Zlatanov, 2017/04/24
- Re: [PATCH] json: Add support for encoding structs, Vibhav Pant, 2017/04/24
- Re: [PATCH] json: Add support for encoding structs, Ted Zlatanov, 2017/04/24
- Re: [PATCH] json: Add support for encoding structs, Ted Zlatanov, 2017/04/24
- Re: [PATCH] json: Add support for encoding structs, Stefan Monnier, 2017/04/24
- Re: [PATCH] json: Add support for encoding structs, Ted Zlatanov, 2017/04/25
- Re: [PATCH] json: Add support for encoding structs,
Vibhav Pant <=
- Re: [PATCH] json: Add support for encoding structs, Ted Zlatanov, 2017/04/25
- Re: [PATCH] json: Add support for encoding structs, Stefan Monnier, 2017/04/26
- Re: [PATCH] json: Add support for encoding structs, Vibhav Pant, 2017/04/27
- Re: [PATCH] json: Add support for encoding structs, Stefan Monnier, 2017/04/27
- Re: [PATCH] json: Add support for encoding structs, Vibhav Pant, 2017/04/25
- Re: [PATCH] json: Add support for encoding structs, Davis Herring, 2017/04/24
- Re: [PATCH] json: Add support for encoding structs, Vibhav Pant, 2017/04/25
Re: [PATCH] json: Add support for encoding structs, Clément Pit-Claudel, 2017/04/24