1 ;;; json.el --- JavaScript Object Notation parser / generator -*- lexical-binding: t -*-
3 ;; Copyright (C) 2006-2017 Free Software Foundation, Inc.
5 ;; Author: Theresa O'Connor <ted@oconnor.cx>
7 ;; Keywords: convenience
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; This is a library for parsing and generating JSON (JavaScript Object
29 ;; Learn all about JSON here: <URL:http://json.org/>.
31 ;; The user-serviceable entry points for the parser are the functions
32 ;; `json-read' and `json-read-from-string'. The encoder has a single
33 ;; entry point, `json-encode'.
35 ;; Since there are several natural representations of key-value pair
36 ;; mappings in elisp (alist, plist, hash-table), `json-read' allows you
37 ;; to specify which you'd prefer (see `json-object-type' and
38 ;; `json-array-type').
40 ;; Similarly, since `false' and `null' are distinct in JSON, you can
41 ;; distinguish them by binding `json-false' and `json-null' as desired.
45 ;; 2006-03-11 - Initial version.
46 ;; 2006-03-13 - Added JSON generation in addition to parsing. Various
47 ;; other cleanups, bugfixes, and improvements.
48 ;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>.
49 ;; 2008-02-21 - Installed in GNU Emacs.
50 ;; 2011-10-17 - Patch `json-alist-p' and `json-plist-p' to avoid recursion -tzz
51 ;; 2012-10-25 - Added pretty-printed reformatting -Ryan Crum (ryan@ryancrum.org)
59 (defvar json-object-type
'alist
60 "Type to convert JSON objects to.
61 Must be one of `alist', `plist', or `hash-table'. Consider let-binding
62 this around your call to `json-read' instead of `setq'ing it. Ordering
63 is maintained for `alist' and `plist', but not for `hash-table'.")
65 (defvar json-array-type
'vector
66 "Type to convert JSON arrays to.
67 Must be one of `vector' or `list'. Consider let-binding this around
68 your call to `json-read' instead of `setq'ing it.")
70 (defvar json-key-type nil
71 "Type to convert JSON keys to.
72 Must be one of `string', `symbol', `keyword', or nil.
74 If nil, `json-read' will guess the type based on the value of
77 If `json-object-type' is: nil will be interpreted as:
82 Note that values other than `string' might behave strangely for
83 Sufficiently Weird keys. Consider let-binding this around your call to
84 `json-read' instead of `setq'ing it.")
86 (defvar json-false
:json-false
87 "Value to use when reading JSON `false'.
88 If this has the same value as `json-null', you might not be able to tell
89 the difference between `false' and `null'. Consider let-binding this
90 around your call to `json-read' instead of `setq'ing it.")
93 "Value to use when reading JSON `null'.
94 If this has the same value as `json-false', you might not be able to
95 tell the difference between `false' and `null'. Consider let-binding
96 this around your call to `json-read' instead of `setq'ing it.")
98 (defvar json-encoding-separator
","
99 "Value to use as an element separator when encoding.")
101 (defvar json-encoding-default-indentation
" "
102 "The default indentation level for encoding.
103 Used only when `json-encoding-pretty-print' is non-nil.")
105 (defvar json--encoding-current-indentation
"\n"
106 "Internally used to keep track of the current indentation level of encoding.
107 Used only when `json-encoding-pretty-print' is non-nil.")
109 (defvar json-encoding-pretty-print nil
110 "If non-nil, then the output of `json-encode' will be pretty-printed.")
112 (defvar json-encoding-lisp-style-closings nil
113 "If non-nil, ] and } closings will be formatted lisp-style,
114 without indentation.")
116 (defvar json-encoding-object-sort-predicate nil
117 "Sorting predicate for JSON object keys during encoding.
118 If nil, no sorting is performed. Else, JSON object keys are
119 ordered by the specified sort predicate during encoding. For
120 instance, setting this to `string<' will have JSON object keys
121 ordered alphabetically.")
123 (defvar json-pre-element-read-function nil
124 "Function called (if non-nil) by `json-read-array' and
125 `json-read-object' right before reading a JSON array or object,
126 respectively. The function is called with one argument, which is
127 the current JSON key.")
129 (defvar json-post-element-read-function nil
130 "Function called (if non-nil) by `json-read-array' and
131 `json-read-object' right after reading a JSON array or object,
138 (defun json-join (strings separator
)
139 "Join STRINGS with SEPARATOR."
140 (mapconcat 'identity strings separator
))
142 (defun json-alist-p (list)
143 "Non-null if and only if LIST is an alist with simple keys."
145 (setq list
(if (and (consp (car list
))
151 (defun json-plist-p (list)
152 "Non-null if and only if LIST is a plist with keyword keys."
154 (setq list
(if (and (keywordp (car list
))
160 (defun json--plist-reverse (plist)
161 "Return a copy of PLIST in reverse order.
162 Unlike `reverse', this keeps the property-value pairs intact."
165 (let ((prop (pop plist
))
171 (defun json--plist-to-alist (plist)
172 "Return an alist of the property-value pairs in PLIST."
175 (let ((prop (pop plist
))
177 (push (cons prop val
) res
)))
180 (defmacro json--with-indentation
(body)
181 `(let ((json--encoding-current-indentation
182 (if json-encoding-pretty-print
183 (concat json--encoding-current-indentation
184 json-encoding-default-indentation
)
190 (defsubst json-advance
(&optional n
)
191 "Advance N characters forward."
194 (defsubst json-peek
()
195 "Return the character at point."
196 (let ((char (char-after (point))))
197 (or char
:json-eof
)))
199 (defsubst json-pop
()
200 "Advance past the character at point, returning it."
201 (let ((char (json-peek)))
202 (if (eq char
:json-eof
)
203 (signal 'json-end-of-file nil
)
207 (defun json-skip-whitespace ()
208 "Skip past the whitespace at point."
210 ;; https://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf
211 ;; or https://tools.ietf.org/html/rfc7159#section-2 for the
212 ;; definition of whitespace in JSON.
213 (skip-chars-forward "\t\r\n "))
219 (define-error 'json-error
"Unknown JSON error")
220 (define-error 'json-readtable-error
"JSON readtable error" 'json-error
)
221 (define-error 'json-unknown-keyword
"Unrecognized keyword" 'json-error
)
222 (define-error 'json-number-format
"Invalid number format" 'json-error
)
223 (define-error 'json-string-escape
"Bad Unicode escape" 'json-error
)
224 (define-error 'json-string-format
"Bad string format" 'json-error
)
225 (define-error 'json-key-format
"Bad JSON object key" 'json-error
)
226 (define-error 'json-object-format
"Bad JSON object" 'json-error
)
227 (define-error 'json-end-of-file
"End of file while parsing JSON"
228 '(end-of-file json-error
))
234 (defvar json--path
'()
235 "Used internally by `json-path-to-position' to keep track of
236 the path during recursive calls to `json-read'.")
238 (defun json--record-path (key)
239 "Record the KEY to the current JSON path.
240 Used internally by `json-path-to-position'."
241 (push (cons (point) key
) json--path
))
243 (defun json--check-position (position)
244 "Check if the last parsed JSON structure passed POSITION.
245 Used internally by `json-path-to-position'."
246 (let ((start (caar json--path
)))
247 (when (< start position
(+ (point) 1))
248 (throw :json-path
(list :path
(nreverse (mapcar #'cdr json--path
))
250 :match-end
(point)))))
253 (defun json-path-to-position (position &optional string
)
254 "Return the path to the JSON element at POSITION.
256 When STRING is provided, return the path to the position in the
257 string, else to the position in the current buffer.
259 The return value is a property list with the following
262 :path -- A list of strings and numbers forming the path to
263 the JSON element at the given position. Strings
264 denote object names, while numbers denote array
267 :match-start -- Position where the matched JSON element begins.
269 :match-end -- Position where the matched JSON element ends.
271 This can for instance be useful to determine the path to a JSON
272 element in a deeply nested structure."
275 (goto-char (point-min)))
276 (let* ((json--path '())
277 (json-pre-element-read-function #'json--record-path
)
278 (json-post-element-read-function
279 (apply-partially #'json--check-position position
))
280 (path (catch :json-path
282 (json-read-from-string string
)
284 (when (plist-get path
:path
)
289 (defvar json-keywords
'("true" "false" "null")
290 "List of JSON keywords.")
294 (defun json-read-keyword (keyword)
295 "Read a JSON keyword at point.
296 KEYWORD is the keyword expected."
297 (unless (member keyword json-keywords
)
298 (signal 'json-unknown-keyword
(list keyword
)))
300 (when (/= char
(json-peek))
301 (signal 'json-unknown-keyword
302 (list (save-excursion
303 (backward-word-strictly 1)
304 (thing-at-point 'word
)))))
307 (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
308 (signal 'json-unknown-keyword
309 (list (save-excursion
310 (backward-word-strictly 1)
311 (thing-at-point 'word
)))))
312 (cond ((string-equal keyword
"true") t
)
313 ((string-equal keyword
"false") json-false
)
314 ((string-equal keyword
"null") json-null
)))
318 (defun json-encode-keyword (keyword)
319 "Encode KEYWORD as a JSON value."
320 (cond ((eq keyword t
) "true")
321 ((eq keyword json-false
) "false")
322 ((eq keyword json-null
) "null")))
328 (defun json-read-number (&optional sign
)
329 "Read the JSON number following point.
330 The optional SIGN argument is for internal use.
332 N.B.: Only numbers which can fit in Emacs Lisp's native number
333 representation will be parsed correctly."
334 ;; If SIGN is non-nil, the number is explicitly signed.
336 "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
337 (cond ((and (null sign
) (= (json-peek) ?-
))
339 (- (json-read-number t
)))
340 ((and (null sign
) (= (json-peek) ?
+))
342 (json-read-number t
))
343 ((and (looking-at number-regexp
)
344 (or (match-beginning 1)
345 (match-beginning 2)))
346 (goto-char (match-end 0))
347 (string-to-number (match-string 0)))
348 (t (signal 'json-number-format
(list (point)))))))
352 (defun json-encode-number (number)
353 "Return a JSON representation of NUMBER."
354 (format "%s" number
))
358 (defvar json-special-chars
366 "Characters which are escaped in JSON, with their elisp counterparts.")
370 (defun json--decode-utf-16-surrogates (high low
)
371 "Return the code point represented by the UTF-16 surrogates HIGH and LOW."
372 (+ (lsh (- high
#xD800
) 10) (- low
#xDC00
) #x10000
))
374 (defun json-read-escaped-char ()
375 "Read the JSON string escaped character at point."
378 (let* ((char (json-pop))
379 (special (assq char json-special-chars
)))
381 (special (cdr special
))
382 ((not (eq char ?u
)) char
)
383 ;; Special-case UTF-16 surrogate pairs,
384 ;; cf. https://tools.ietf.org/html/rfc7159#section-7. Note that
385 ;; this clause overlaps with the next one and therefore has to
388 (rx (group (any "Dd") (any "89ABab") (= 2 (any xdigit
)))
389 "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any xdigit
)))))
391 (json--decode-utf-16-surrogates
392 (string-to-number (match-string 1) 16)
393 (string-to-number (match-string 2) 16)))
394 ((looking-at (rx (= 4 xdigit
)))
395 (let ((hex (match-string 0)))
397 (string-to-number hex
16)))
399 (signal 'json-string-escape
(list (point)))))))
401 (defun json-read-string ()
402 "Read the JSON string at point."
403 (unless (= (json-peek) ?
\")
404 (signal 'json-string-format
(list "doesn't start with `\"'!")))
407 (let ((characters '())
409 (while (not (= char ?
\"))
410 (push (if (= char ?
\\)
411 (json-read-escaped-char)
414 (setq char
(json-peek)))
418 (apply 'string
(nreverse characters
))
423 (defun json-encode-string (string)
424 "Return a JSON representation of STRING."
425 ;; Reimplement the meat of `replace-regexp-in-string', for
426 ;; performance (bug#20154).
427 (let ((l (length string
))
430 ;; Only escape quotation mark, backslash and the control
431 ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
432 (while (setq mb
(string-match "[\"\\[:cntrl:]]" string start
))
433 (let* ((c (aref string mb
))
434 (special (rassq c json-special-chars
)))
435 (push (substring string start mb
) res
)
437 ;; Special JSON character (\n, \r, etc.).
438 (string ?
\\ (car special
))
439 ;; Fallback: UCS code point in \uNNNN form.
440 (format "\\u%04x" c
))
442 (setq start
(1+ mb
))))
443 (push (substring string start l
) res
)
445 (apply #'concat
"\"" (nreverse res
))))
447 (defun json-encode-key (object)
448 "Return a JSON representation of OBJECT.
449 If the resulting JSON object isn't a valid JSON object key,
450 this signals `json-key-format'."
451 (let ((encoded (json-encode object
)))
452 (unless (stringp (json-read-from-string encoded
))
453 (signal 'json-key-format
(list object
)))
458 (defun json-new-object ()
459 "Create a new Elisp object corresponding to a JSON object.
460 Please see the documentation of `json-object-type'."
461 (cond ((eq json-object-type
'hash-table
)
462 (make-hash-table :test
'equal
))
466 (defun json-add-to-object (object key value
)
467 "Add a new KEY -> VALUE association to OBJECT.
468 Returns the updated object, which you should save, e.g.:
469 (setq obj (json-add-to-object obj \"foo\" \"bar\"))
470 Please see the documentation of `json-object-type' and `json-key-type'."
472 (if (eq json-key-type nil
)
473 (cdr (assq json-object-type
'((hash-table . string
)
478 (cond ((eq json-key-type
'string
)
480 ((eq json-key-type
'symbol
)
482 ((eq json-key-type
'keyword
)
483 (intern (concat ":" key
)))))
484 (cond ((eq json-object-type
'hash-table
)
485 (puthash key value object
)
487 ((eq json-object-type
'alist
)
488 (cons (cons key value
) object
))
489 ((eq json-object-type
'plist
)
490 (cons key
(cons value object
))))))
492 ;; JSON object parsing
494 (defun json-read-object ()
495 "Read the JSON object at point."
498 (json-skip-whitespace)
499 ;; read key/value pairs until "}"
500 (let ((elements (json-new-object))
502 (while (not (= (json-peek) ?
}))
503 (json-skip-whitespace)
504 (setq key
(json-read-string))
505 (json-skip-whitespace)
506 (if (= (json-peek) ?
:)
508 (signal 'json-object-format
(list ":" (json-peek))))
509 (json-skip-whitespace)
510 (when json-pre-element-read-function
511 (funcall json-pre-element-read-function key
))
512 (setq value
(json-read))
513 (when json-post-element-read-function
514 (funcall json-post-element-read-function
))
515 (setq elements
(json-add-to-object elements key value
))
516 (json-skip-whitespace)
517 (when (/= (json-peek) ?
})
518 (if (= (json-peek) ?
,)
520 (signal 'json-object-format
(list "," (json-peek))))))
523 (pcase json-object-type
524 (`alist
(nreverse elements
))
525 (`plist
(json--plist-reverse elements
))
528 ;; Hash table encoding
530 (defun json-encode-hash-table (hash-table)
531 "Return a JSON representation of HASH-TABLE."
532 (if json-encoding-object-sort-predicate
533 (json-encode-alist (map-into hash-table
'list
))
537 (json--with-indentation
541 (if json-encoding-pretty-print
544 json--encoding-current-indentation
550 json-encoding-separator
)
551 (if (or (not json-encoding-pretty-print
)
552 json-encoding-lisp-style-closings
)
554 json--encoding-current-indentation
))))
556 ;; List encoding (including alists and plists)
558 (defun json-encode-alist (alist)
559 "Return a JSON representation of ALIST."
560 (when json-encoding-object-sort-predicate
562 (sort alist
(lambda (a b
)
563 (funcall json-encoding-object-sort-predicate
567 (json--with-indentation
568 (mapcar (lambda (cons)
569 (format (if json-encoding-pretty-print
572 json--encoding-current-indentation
573 (json-encode-key (car cons
))
574 (json-encode (cdr cons
))))
576 json-encoding-separator
)
577 (if (or (not json-encoding-pretty-print
)
578 json-encoding-lisp-style-closings
)
580 json--encoding-current-indentation
)))
582 (defun json-encode-plist (plist)
583 "Return a JSON representation of PLIST."
584 (if json-encoding-object-sort-predicate
585 (json-encode-alist (json--plist-to-alist plist
))
587 (json--with-indentation
590 json--encoding-current-indentation
591 (json-encode-key (car plist
))
592 (if json-encoding-pretty-print
595 (json-encode (cadr plist
)))
597 (setq plist
(cddr plist
))))
599 (json-join (nreverse result
) json-encoding-separator
)
600 (if (and json-encoding-pretty-print
601 (not json-encoding-lisp-style-closings
))
602 json--encoding-current-indentation
606 (defun json-encode-list (list)
607 "Return a JSON representation of LIST.
608 Tries to DWIM: simple lists become JSON arrays, while alists and plists
609 become JSON objects."
610 (cond ((null list
) "null")
611 ((json-alist-p list
) (json-encode-alist list
))
612 ((json-plist-p list
) (json-encode-plist list
))
613 ((listp list
) (json-encode-array list
))
615 (signal 'json-error
(list list
)))))
621 (defun json-read-array ()
622 "Read the JSON array at point."
625 (json-skip-whitespace)
626 ;; read values until "]"
628 (while (not (= (json-peek) ?\
]))
629 (json-skip-whitespace)
630 (when json-pre-element-read-function
631 (funcall json-pre-element-read-function
(length elements
)))
632 (push (json-read) elements
)
633 (when json-post-element-read-function
634 (funcall json-post-element-read-function
))
635 (json-skip-whitespace)
636 (when (/= (json-peek) ?\
])
637 (if (= (json-peek) ?
,)
639 (signal 'json-error
(list 'bleah
)))))
642 (apply json-array-type
(nreverse elements
))))
646 (defun json-encode-array (array)
647 "Return a JSON representation of ARRAY."
648 (if (and json-encoding-pretty-print
649 (> (length array
) 0))
651 (json--with-indentation
652 (concat (format "[%s" json--encoding-current-indentation
)
653 (json-join (mapcar 'json-encode array
)
655 json-encoding-separator
656 json--encoding-current-indentation
))))
658 (if json-encoding-lisp-style-closings
660 json--encoding-current-indentation
)))
662 (mapconcat 'json-encode array json-encoding-separator
)
669 (defvar json-readtable
671 '((?t json-read-keyword
"true")
672 (?f json-read-keyword
"false")
673 (?n json-read-keyword
"null")
674 (?
{ json-read-object
)
675 (?\
[ json-read-array
)
676 (?
\" json-read-string
))))
678 (push (list char
'json-read-number
) table
))
679 '(?- ?
+ ?. ?
0 ?
1 ?
2 ?
3 ?
4 ?
5 ?
6 ?
7 ?
8 ?
9))
681 "Readtable for JSON reader.")
684 "Parse and return the JSON object following point.
685 Advances point just past JSON object."
686 (json-skip-whitespace)
687 (let ((char (json-peek)))
688 (if (not (eq char
:json-eof
))
689 (let ((record (cdr (assq char json-readtable
))))
690 (if (functionp (car record
))
691 (apply (car record
) (cdr record
))
692 (signal 'json-readtable-error record
)))
693 (signal 'json-end-of-file nil
))))
695 ;; Syntactic sugar for the reader
697 (defun json-read-from-string (string)
698 "Read the JSON object contained in STRING and return it."
701 (goto-char (point-min))
704 (defun json-read-file (file)
705 "Read the first JSON object contained in FILE and return it."
707 (insert-file-contents file
)
708 (goto-char (point-min))
715 (defun json-encode (object)
716 "Return a JSON representation of OBJECT as a string."
717 (cond ((memq object
(list t json-null json-false
))
718 (json-encode-keyword object
))
719 ((stringp object
) (json-encode-string object
))
720 ((keywordp object
) (json-encode-string
721 (substring (symbol-name object
) 1)))
722 ((symbolp object
) (json-encode-string
723 (symbol-name object
)))
724 ((numberp object
) (json-encode-number object
))
725 ((arrayp object
) (json-encode-array object
))
726 ((hash-table-p object
) (json-encode-hash-table object
))
727 ((listp object
) (json-encode-list object
))
728 (t (signal 'json-error
(list object
)))))
732 (defun json-pretty-print-buffer ()
733 "Pretty-print current buffer."
735 (json-pretty-print (point-min) (point-max)))
737 (defun json-pretty-print (begin end
)
738 "Pretty-print selected region."
741 (let ((json-encoding-pretty-print t
)
742 ;; Ensure that ordering is maintained
743 (json-object-type 'alist
)
744 (txt (delete-and-extract-region begin end
)))
745 (insert (json-encode (json-read-from-string txt
))))))
747 (defun json-pretty-print-buffer-ordered ()
748 "Pretty-print current buffer with object keys ordered."
750 (let ((json-encoding-object-sort-predicate 'string
<))
751 (json-pretty-print-buffer)))
753 (defun json-pretty-print-ordered (begin end
)
754 "Pretty-print the region with object keys ordered."
756 (let ((json-encoding-object-sort-predicate 'string
<))
757 (json-pretty-print begin end
)))
761 ;;; json.el ends here