Commit 29d740aa authored by Simen Heggestøyl's avatar Simen Heggestøyl

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-element-read-function)
(json-post-element-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-element-read-function' and `json-post-element-read-function'
when set.

* test/automated/json-tests.el (test-json-path-to-position-with-objects)
(test-json-path-to-position-with-arrays)
(test-json-path-to-position-no-match): New tests for
`json-path-to-position'.
parent 5193ad1b
......@@ -111,6 +111,17 @@ Used only when `json-encoding-pretty-print' is non-nil.")
"If non-nil, ] and } closings will be formatted lisp-style,
without indentation.")
(defvar json-pre-element-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. The function is called with one argument, which is
the current JSON key.")
(defvar json-post-element-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.")
;;; Utilities
......@@ -196,6 +207,61 @@ Unlike `reverse', this keeps the property-value pairs intact."
;;; 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-element-read-function #'json--record-path)
(json-post-element-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 +469,12 @@ Please see the documentation of `json-object-type' and `json-key-type'."
(if (char-equal (json-peek) ?:)
(json-advance)
(signal 'json-object-format (list ":" (json-peek))))
(json-skip-whitespace)
(when json-pre-element-read-function
(funcall json-pre-element-read-function key))
(setq value (json-read))
(when json-post-element-read-function
(funcall json-post-element-read-function))
(setq elements (json-add-to-object elements key value))
(json-skip-whitespace)
(unless (char-equal (json-peek) ?})
......@@ -509,7 +580,12 @@ become JSON objects."
;; read values until "]"
(let (elements)
(while (not (char-equal (json-peek) ?\]))
(json-skip-whitespace)
(when json-pre-element-read-function
(funcall json-pre-element-read-function (length elements)))
(push (json-read) elements)
(when json-post-element-read-function
(funcall json-post-element-read-function))
(json-skip-whitespace)
(unless (char-equal (json-peek) ?\])
(if (char-equal (json-peek) ?,)
......
......@@ -49,5 +49,24 @@
(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))))
(ert-deftest test-json-path-to-position-no-match ()
(let* ((json-string "{\"foo\": {\"bar\": \"baz\"}}")
(matched-path (json-path-to-position 5 json-string)))
(should (null matched-path))))
(provide 'json-tests)
;;; json-tests.el ends here
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment