bug#21798: 25.0.50; [PATCH] Add support for retrieving paths to JSON elements

["Simen Heggestøyl" <simenheg@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 561 bytes --]

On Fri, Nov 6, 2015 at 6:15 PM, Dmitry Gutov <dgutov@yandex.ru> wrote:
> That sounds fine to me in terms of design, but it might add some 
> performance overhead. So some testing is needed.

Good! A revised patch is attached.

Benchmarks follow below, with the same setup as last time.

Before the patch:

(benchmark-run 100 (json-read-from-string huge-json))
     ⇒ (16.84457266 1007 4.886441912999999)

After the patch:

(benchmark-run 100 (json-read-from-string huge-json))
     ⇒ (16.905379125000003 1007 4.722544520000007)

-- Simen

[-- Attachment #1.2: Type: text/html, Size: 860 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-support-for-retrieving-paths-to-JSON-elements.patch --]
[-- Type: text/x-patch, Size: 6306 bytes --]

From b6c10884b48770143468d93c6a816564834c77be Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= <simenheg@gmail.com>
Date: Sun, 25 Oct 2015 14:44:59 +0100
Subject: [PATCH] Add support for retrieving paths to JSON elements

Add support for retrieving the path to a JSON element. This can for
instance be useful to retrieve paths in deeply nested JSON
structures.

* lisp/json.el (json-pre-read-function, json-post-read-function): New
variables to hold pre- and post read callback functions for
`json-read-array' and `json-read-object'.
(json--path): New variable used internally by `json-path-to-position'.
(json--record-path, json--check-position): New functions used
internally by `json-path-to-position'.
(json-path-to-position): New function for retrieving the path to a
JSON element at a given position.
(json-read-object, json-read-array): Call `json-pre-read-function' and
`json-post-read-function' when set.

* test/automated/json-tests.el (test-json-path-to-position-with-objects)
(test-json-path-to-position-with-arrays): New tests for
`json-path-to-position'.
---
 lisp/json.el                 | 75 ++++++++++++++++++++++++++++++++++++++++++++
 test/automated/json-tests.el | 14 +++++++++
 2 files changed, 89 insertions(+)

diff --git a/lisp/json.el b/lisp/json.el
index b23d12a..4cc4f97 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -111,6 +111,16 @@ json-encoding-lisp-style-closings
   "If non-nil, ] and } closings will be formatted lisp-style,
 without indentation.")
 
+(defvar json-pre-read-function nil
+  "Function called (if non-nil) by `json-read-array' and
+`json-read-object' right before reading a JSON array or object,
+respectively.")
+
+(defvar json-post-read-function nil
+  "Function called (if non-nil) by `json-read-array' and
+`json-read-object' right after reading a JSON array or object,
+respectively.")
+
 \f
 
 ;;; Utilities
@@ -196,6 +206,61 @@ 'json-end-of-file
 
 \f
 
+;;; Paths
+
+(defvar json--path '()
+  "Used internally by `json-path-to-position' to keep track of
+the path during recursive calls to `json-read'.")
+
+(defun json--record-path (key)
+  "Record the KEY to the current JSON path. Used internally by
+`json-path-to-position'."
+  (push (cons (point) key) json--path))
+
+(defun json--check-position (position)
+  "Check if the last parsed JSON structure passed POSITION.  Used
+internally by `json-path-to-position'."
+  (let ((start (caar json--path)))
+    (when (< start position (+ (point) 1))
+      (throw :json-path (list :path (nreverse (mapcar #'cdr json--path))
+                              :match-start start
+                              :match-end (point)))))
+  (pop json--path))
+
+(defun json-path-to-position (position &optional string)
+  "Return the path to the JSON element at POSITION.
+
+When STRING is provided, return the path to the position in the
+string, else to the position in the current buffer.
+
+The return value is a property list with the following
+properties:
+
+:path        -- A list of strings and numbers forming the path to
+                the JSON element at the given position.  Strings
+                denote object names, while numbers denote array
+                indexes.
+
+:match-start -- Position where the matched JSON element begins.
+
+:match-end   -- Position where the matched JSON element ends.
+
+This can for instance be useful to determine the path to a JSON
+element in a deeply nested structure."
+  (save-excursion
+    (unless string
+      (goto-char (point-min)))
+    (let* ((json--path '())
+           (json-pre-read-function #'json--record-path)
+           (json-post-read-function
+            (apply-partially #'json--check-position position))
+           (path (catch :json-path
+                   (if string
+                       (json-read-from-string string)
+                     (json-read)))))
+      (when (plist-get path :path)
+        path))))
+
 ;;; Keywords
 
 (defvar json-keywords '("true" "false" "null")
@@ -403,7 +468,12 @@ json-read-object
       (if (char-equal (json-peek) ?:)
           (json-advance)
         (signal 'json-object-format (list ":" (json-peek))))
+      (json-skip-whitespace)
+      (when json-pre-read-function
+        (funcall json-pre-read-function key))
       (setq value (json-read))
+      (when json-post-read-function
+        (funcall json-post-read-function))
       (setq elements (json-add-to-object elements key value))
       (json-skip-whitespace)
       (unless (char-equal (json-peek) ?})
@@ -509,7 +579,12 @@ json-read-array
   ;; read values until "]"
   (let (elements)
     (while (not (char-equal (json-peek) ?\]))
+      (json-skip-whitespace)
+      (when json-pre-read-function
+        (funcall json-pre-read-function (length elements)))
       (push (json-read) elements)
+      (when json-post-read-function
+        (funcall json-post-read-function))
       (json-skip-whitespace)
       (unless (char-equal (json-peek) ?\])
         (if (char-equal (json-peek) ?,)
diff --git a/test/automated/json-tests.el b/test/automated/json-tests.el
index d1b7a2f..e0672dd 100644
--- a/test/automated/json-tests.el
+++ b/test/automated/json-tests.el
@@ -49,5 +49,19 @@
   (should (equal (json-read-from-string "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"")
                  "\nasdфывfgh\t")))
 
+(ert-deftest test-json-path-to-position-with-objects ()
+  (let* ((json-string "{\"foo\": {\"bar\": {\"baz\": \"value\"}}}")
+         (matched-path (json-path-to-position 32 json-string)))
+    (should (equal (plist-get matched-path :path) '("foo" "bar" "baz")))
+    (should (equal (plist-get matched-path :match-start) 25))
+    (should (equal (plist-get matched-path :match-end) 32))))
+
+(ert-deftest test-json-path-to-position-with-arrays ()
+  (let* ((json-string "{\"foo\": [\"bar\", [\"baz\"]]}")
+         (matched-path (json-path-to-position 20 json-string)))
+    (should (equal (plist-get matched-path :path) '("foo" 1 0)))
+    (should (equal (plist-get matched-path :match-start) 18))
+    (should (equal (plist-get matched-path :match-end) 23))))
+
 (provide 'json-tests)
 ;;; json-tests.el ends here
-- 
2.6.2