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: Mon, 24 Apr 2017 23:24:13 +0530 Message-ID: References: <874lxeq6mz.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 1493056572 12332 195.159.176.226 (24 Apr 2017 17:56:12 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Mon, 24 Apr 2017 17:56:12 +0000 (UTC) To: "emacs-devel@gnu.org" Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Apr 24 19:56:06 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 1d2iDT-0002vB-9u for ged-emacs-devel@m.gmane.org; Mon, 24 Apr 2017 19:56:03 +0200 Original-Received: from localhost ([::1]:45309 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d2iDU-0007NP-2E for ged-emacs-devel@m.gmane.org; Mon, 24 Apr 2017 13:56:04 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:58592) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d2iC4-0006oj-LQ for emacs-devel@gnu.org; Mon, 24 Apr 2017 13:54:37 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d2iC3-0006iA-MN for emacs-devel@gnu.org; Mon, 24 Apr 2017 13:54:36 -0400 Original-Received: from mail-yw0-x22d.google.com ([2607:f8b0:4002:c05::22d]:33448) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d2iC3-0006hq-H2 for emacs-devel@gnu.org; Mon, 24 Apr 2017 13:54:35 -0400 Original-Received: by mail-yw0-x22d.google.com with SMTP id 203so82196876ywe.0 for ; Mon, 24 Apr 2017 10:54:35 -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=8LbLQ+D8g0xXpyFUoOdBXb6ty62ByjMNLaTCXDpdS7Y=; b=X+lCSXrFJILrFflITXkDao9mqzwN5J9cOax5VeUFAMdLuYDMcIQey/EwVY7sscnN13 JxYpkdotDBmOU2+W3CEj4uBW72wRHNcwhQT5VKAHhXTmIWQJCH+d6UihJIsDXOOv19h4 Nup/xo/6gKRFqkwJCtBsqkD55k2wTl/8ZJ+1H/xlgawhRqLkmu07yOcrvI+jSQMdKFBr RtfL1AsAAXNenCag2eO0dPXaWxMTBDLjptq0kBN2+IU+ltaQjSDN0kEVnQ1YKoA0DSfz jhfkx+1ACL1/83VbzWVw184ujjmo1PDU9D6KkwBt7ZZ43Eor5H/MgBF3IBRpTUTj1UOv /rxA== 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=8LbLQ+D8g0xXpyFUoOdBXb6ty62ByjMNLaTCXDpdS7Y=; b=tM0kxT/xivI94sm0VY1hr/MzBEIbR5CX+khgh5cwYq8L79qyt6PuuaBQlGgYD1sesh RhgndFo2NaRAo9G4ugqBhqRDt7n9h/W7UTupE96otpXLXS/MwYLR6rJw28pjO4fLOxf2 N1rLqmSK/fDM1BflmQ7pQV7uOYMcgHrg1CO0xoJZ2x4WtAqebr4BzrhcZBOF3RqlD/C7 Q7qSttoxgKmkrmjN74E1KkV3wiPOGGWSZAhVBiORKlj6Sq6kVYsbQQdpRtOstH188HIR /u9U03LET8im59WdnxizBmPbimVoWc+1jVBHvfS4U4YPFOAtRIm1r/7Q1maNfL+zKw+f xMrg== X-Gm-Message-State: AN3rC/4V3CEbSV+nSugT9cG4FmNwWBNypbnGms724LtY3qOIhH6yzEcR fmPMDkfE469jxLWigqeWBoIXBU58cOZI X-Received: by 10.129.98.212 with SMTP id w203mr5789329ywb.79.1493056474278; Mon, 24 Apr 2017 10:54:34 -0700 (PDT) Original-Received: by 10.129.117.85 with HTTP; Mon, 24 Apr 2017 10:54:13 -0700 (PDT) In-Reply-To: <874lxeq6mz.fsf@lifelogs.com> X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2607:f8b0:4002:c05::22d 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:214264 Archived-At: On Mon, Apr 24, 2017 at 6:55 PM, Ted Zlatanov 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