From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Vibhav Pant Newsgroups: gmane.emacs.devel Subject: Re: [PATCH] json: Add support for encoding structs Date: Tue, 25 Apr 2017 21:56:16 +0530 Message-ID: References: <874lxeq6mz.fsf@lifelogs.com> <87pog1pqdn.fsf@lifelogs.com> <87d1c0pnqj.fsf@lifelogs.com> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Trace: blaine.gmane.org 1493137634 22193 195.159.176.226 (25 Apr 2017 16:27:14 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 25 Apr 2017 16:27:14 +0000 (UTC) To: "emacs-devel@gnu.org" Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Apr 25 18:27:10 2017 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d33Iy-0005bm-Gw for ged-emacs-devel@m.gmane.org; Tue, 25 Apr 2017 18:27:08 +0200 Original-Received: from localhost ([::1]:50375 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d33J4-0002yi-C3 for ged-emacs-devel@m.gmane.org; Tue, 25 Apr 2017 12:27:14 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:39942) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d33IW-0002yI-Fx for emacs-devel@gnu.org; Tue, 25 Apr 2017 12:26:41 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d33IV-0006Yy-C1 for emacs-devel@gnu.org; Tue, 25 Apr 2017 12:26:40 -0400 Original-Received: from mail-yw0-x232.google.com ([2607:f8b0:4002:c05::232]:35870) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d33IU-0006YY-TB for emacs-devel@gnu.org; Tue, 25 Apr 2017 12:26:39 -0400 Original-Received: by mail-yw0-x232.google.com with SMTP id l18so39013849ywh.3 for ; Tue, 25 Apr 2017 09:26:38 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=mime-version:in-reply-to:references:from:date:message-id:subject:to; bh=8z7tDIsGEe80H4K5hNRItea7I26qw4mp4Yb3Gx4Eoao=; b=HlpmJc4fsQn0/Fugnck6qpKs/agF07RVcIV24DnCI6d7BLbMtqxctdWY+AuWJfL27R YB0tqtQ23MfVQiGLZM7lAkcl9nd1rYyi6LGPY5MJL3Ah1aVR7s6EqfTbZHz1YkEHfLT9 XenD+F743Z0pHq+EJTkHL8cpYCmjJHbDP00pFPM0UBx9w6eui0slORR3YFH4vICI3E4L Wr3kAGAU+P8BWgrNgYPpQftAkdr8P8G0X/bflla/Y70jv1Z5AGyrPK7bisEU3WQ6JoVC UgUBNce7JQ+HeYqi5e0DL3/TAOZX3GztX8lqFg/aTebcECG5zNMrQL9JbEccR/mQL1WC n5Ig== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:mime-version:in-reply-to:references:from:date :message-id:subject:to; bh=8z7tDIsGEe80H4K5hNRItea7I26qw4mp4Yb3Gx4Eoao=; b=JKyw0BPsFK4mrSCtQ+38jf6c5wIpO/+nJANma2IhO2FsUjoy4OpFVeDEA1ahRf2rDQ zGTdEA6BlkIn35Snov9D3/a2uTn9YtQ99ZUH4t3BNGradT0GCMa4JK/JD4VvTnV19cI7 aCacB23gsMxzEDTV/ElYdeWRR9Y7u5jEMjjtKKdOmEwX5+4icJL1ceOuav1j4nZtcBdA HM7xlCXHzT8luuDmPeK54hrm1uYiOqtPtxmoOxuE9bFURSWO/qeUrtNRHI+JL68QArEZ XdrQkOmJqPzVv692zjBe7LqKI4UDoG5qU9ICHAIxpXNKCsg75CrhKSWkFFEfuQhqxhoR IHuQ== X-Gm-Message-State: AN3rC/4m3g6uFQlvLwU8+moMGVeLH3HbkBFN5noiwgYhQU7O8dDWCKVg BfjEygDyo+TYIDRujKEtdcfwmWQm6vw3 X-Received: by 10.13.214.209 with SMTP id y200mr10973698ywd.25.1493137597713; Tue, 25 Apr 2017 09:26:37 -0700 (PDT) Original-Received: by 10.129.117.85 with HTTP; Tue, 25 Apr 2017 09:26:16 -0700 (PDT) In-Reply-To: <87d1c0pnqj.fsf@lifelogs.com> X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2607:f8b0:4002:c05::232 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:214285 Archived-At: On Tue, Apr 25, 2017 at 7:56 PM, Ted Zlatanov 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 vibhavp@gmail.com