json.el 26.2 KB
Newer Older
1
;;; json.el --- JavaScript Object Notation parser / generator -*- lexical-binding: t -*-
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2006-2019 Free Software Foundation, Inc.
4

Glenn Morris's avatar
Glenn Morris committed
5
;; Author: Theresa O'Connor <ted@oconnor.cx>
6
;; Version: 1.4
7 8 9 10
;; Keywords: convenience

;; 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 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
15 16 17 18 19 20 21

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
22
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49

;;; Commentary:

;; This is a library for parsing and generating JSON (JavaScript Object
;; Notation).

;; Learn all about JSON here: <URL:http://json.org/>.

;; The user-serviceable entry points for the parser are the functions
;; `json-read' and `json-read-from-string'. The encoder has a single
;; entry point, `json-encode'.

;; Since there are several natural representations of key-value pair
;; mappings in elisp (alist, plist, hash-table), `json-read' allows you
;; to specify which you'd prefer (see `json-object-type' and
;; `json-array-type').

;; Similarly, since `false' and `null' are distinct in JSON, you can
;; distinguish them by binding `json-false' and `json-null' as desired.

;;; History:

;; 2006-03-11 - Initial version.
;; 2006-03-13 - Added JSON generation in addition to parsing. Various
;;              other cleanups, bugfixes, and improvements.
;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>.
;; 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)
52 53
;; 2019-02-02 - Pretty-printing now uses replace-region-contents and support for
;;              minimization -tsdh
54 55 56

;;; Code:

57
(require 'map)
58
(require 'subr-x)
59

60 61 62 63
;; Parameters

(defvar json-object-type 'alist
  "Type to convert JSON objects to.
Juanma Barranquero's avatar
Juanma Barranquero committed
64
Must be one of `alist', `plist', or `hash-table'.  Consider let-binding
65 66
this around your call to `json-read' instead of `setq'ing it.  Ordering
is maintained for `alist' and `plist', but not for `hash-table'.")
67 68 69

(defvar json-array-type 'vector
  "Type to convert JSON arrays to.
Juanma Barranquero's avatar
Juanma Barranquero committed
70
Must be one of `vector' or `list'.  Consider let-binding this around
71 72 73 74 75 76 77 78 79 80 81 82 83 84 85
your call to `json-read' instead of `setq'ing it.")

(defvar json-key-type nil
  "Type to convert JSON keys to.
Must be one of `string', `symbol', `keyword', or nil.

If nil, `json-read' will guess the type based on the value of
`json-object-type':

    If `json-object-type' is:   nil will be interpreted as:
      `hash-table'                `string'
      `alist'                     `symbol'
      `plist'                     `keyword'

Note that values other than `string' might behave strangely for
Juanma Barranquero's avatar
Juanma Barranquero committed
86
Sufficiently Weird keys.  Consider let-binding this around your call to
87 88 89 90 91
`json-read' instead of `setq'ing it.")

(defvar json-false :json-false
  "Value to use when reading JSON `false'.
If this has the same value as `json-null', you might not be able to tell
Juanma Barranquero's avatar
Juanma Barranquero committed
92
the difference between `false' and `null'.  Consider let-binding this
93 94 95 96 97
around your call to `json-read' instead of `setq'ing it.")

(defvar json-null nil
  "Value to use when reading JSON `null'.
If this has the same value as `json-false', you might not be able to
Juanma Barranquero's avatar
Juanma Barranquero committed
98
tell the difference between `false' and `null'.  Consider let-binding
99 100
this around your call to `json-read' instead of `setq'ing it.")

101
(defvar json-encoding-separator ","
Paul Eggert's avatar
Paul Eggert committed
102
  "Value to use as an element separator when encoding.")
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118

(defvar json-encoding-default-indentation "  "
  "The default indentation level for encoding.
Used only when `json-encoding-pretty-print' is non-nil.")

(defvar json--encoding-current-indentation "\n"
  "Internally used to keep track of the current indentation level of encoding.
Used only when `json-encoding-pretty-print' is non-nil.")

(defvar json-encoding-pretty-print nil
  "If non-nil, then the output of `json-encode' will be pretty-printed.")

(defvar json-encoding-lisp-style-closings nil
  "If non-nil, ] and } closings will be formatted lisp-style,
without indentation.")

119 120 121 122 123 124 125
(defvar json-encoding-object-sort-predicate nil
  "Sorting predicate for JSON object keys during encoding.
If nil, no sorting is performed.  Else, JSON object keys are
ordered by the specified sort predicate during encoding.  For
instance, setting this to `string<' will have JSON object keys
ordered alphabetically.")

126 127 128 129 130 131 132 133 134 135 136
(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.")

137 138 139 140 141 142 143 144 145


;;; Utilities

(defun json-join (strings separator)
  "Join STRINGS with SEPARATOR."
  (mapconcat 'identity strings separator))

(defun json-alist-p (list)
146
  "Non-null if and only if LIST is an alist with simple keys."
147
  (while (consp list)
148 149
    (setq list (if (and (consp (car list))
                        (atom (caar list)))
150 151 152
                   (cdr list)
                 'not-alist)))
  (null list))
153 154

(defun json-plist-p (list)
155
  "Non-null if and only if LIST is a plist with keyword keys."
156 157 158 159 160 161
  (while (consp list)
    (setq list (if (and (keywordp (car list))
                        (consp (cdr list)))
                   (cddr list)
                 'not-plist)))
  (null list))
162

163 164 165 166 167 168 169 170 171 172 173
(defun json--plist-reverse (plist)
  "Return a copy of PLIST in reverse order.
Unlike `reverse', this keeps the property-value pairs intact."
  (let (res)
    (while plist
      (let ((prop (pop plist))
            (val (pop plist)))
        (push val res)
        (push prop res)))
    res))

174 175 176 177 178 179 180 181 182
(defun json--plist-to-alist (plist)
  "Return an alist of the property-value pairs in PLIST."
  (let (res)
    (while plist
      (let ((prop (pop plist))
            (val (pop plist)))
        (push (cons prop val) res)))
    (nreverse res)))

183 184 185 186 187 188 189 190
(defmacro json--with-indentation (body)
  `(let ((json--encoding-current-indentation
          (if json-encoding-pretty-print
              (concat json--encoding-current-indentation
                      json-encoding-default-indentation)
            "")))
     ,body))

191 192
;; Reader utilities

Mark Oteiza's avatar
Mark Oteiza committed
193
(define-inline json-advance (&optional n)
Mark Oteiza's avatar
Mark Oteiza committed
194
  "Advance N characters forward."
Mark Oteiza's avatar
Mark Oteiza committed
195
  (inline-quote (forward-char ,n)))
196

Mark Oteiza's avatar
Mark Oteiza committed
197
(define-inline json-peek ()
198
  "Return the character at point."
Mark Oteiza's avatar
Mark Oteiza committed
199
  (inline-quote (following-char)))
200

Mark Oteiza's avatar
Mark Oteiza committed
201
(define-inline json-pop ()
202
  "Advance past the character at point, returning it."
203 204 205
  (inline-quote
   (let ((char (json-peek)))
     (if (zerop char)
Mark Oteiza's avatar
Mark Oteiza committed
206 207
         (signal 'json-end-of-file nil)
       (json-advance)
208
       char))))
Mark Oteiza's avatar
Mark Oteiza committed
209 210

(define-inline json-skip-whitespace ()
211
  "Skip past the whitespace at point."
212 213 214 215
  ;; See
  ;; https://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf
  ;; or https://tools.ietf.org/html/rfc7159#section-2 for the
  ;; definition of whitespace in JSON.
Mark Oteiza's avatar
Mark Oteiza committed
216
  (inline-quote (skip-chars-forward "\t\r\n ")))
217 218 219 220 221



;; Error conditions

222 223 224 225 226 227 228 229
(define-error 'json-error "Unknown JSON error")
(define-error 'json-readtable-error "JSON readtable error" 'json-error)
(define-error 'json-unknown-keyword "Unrecognized keyword" 'json-error)
(define-error 'json-number-format "Invalid number format" 'json-error)
(define-error 'json-string-escape "Bad Unicode escape" 'json-error)
(define-error 'json-string-format "Bad string format" 'json-error)
(define-error 'json-key-format "Bad JSON object key" 'json-error)
(define-error 'json-object-format "Bad JSON object" 'json-error)
230 231
(define-error 'json-end-of-file "End of file while parsing JSON"
  '(end-of-file json-error))
232 233 234



235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289
;;; 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))))

290 291 292 293 294 295 296 297 298 299 300 301 302
;;; Keywords

(defvar json-keywords '("true" "false" "null")
  "List of JSON keywords.")

;; Keyword parsing

(defun json-read-keyword (keyword)
  "Read a JSON keyword at point.
KEYWORD is the keyword expected."
  (unless (member keyword json-keywords)
    (signal 'json-unknown-keyword (list keyword)))
  (mapc (lambda (char)
Mark Oteiza's avatar
Mark Oteiza committed
303
          (when (/= char (json-peek))
304 305
            (signal 'json-unknown-keyword
                    (list (save-excursion
306
                            (backward-word-strictly 1)
307
                            (thing-at-point 'word)))))
308 309
          (json-advance))
        keyword)
Mark Oteiza's avatar
Mark Oteiza committed
310
  (json-skip-whitespace)
311
  (unless (looking-at "\\([],}]\\|$\\)")
312 313
    (signal 'json-unknown-keyword
            (list (save-excursion
314
                    (backward-word-strictly 1)
315
                    (thing-at-point 'word)))))
316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331
  (cond ((string-equal keyword "true") t)
        ((string-equal keyword "false") json-false)
        ((string-equal keyword "null") json-null)))

;; Keyword encoding

(defun json-encode-keyword (keyword)
  "Encode KEYWORD as a JSON value."
  (cond ((eq keyword t)          "true")
        ((eq keyword json-false) "false")
        ((eq keyword json-null)  "null")))

;;; Numbers

;; Number parsing

332 333
(defun json-read-number (&optional sign)
 "Read the JSON number following point.
Juanma Barranquero's avatar
Juanma Barranquero committed
334
The optional SIGN argument is for internal use.
335

336 337
N.B.: Only numbers which can fit in Emacs Lisp's native number
representation will be parsed correctly."
338 339 340
 ;; If SIGN is non-nil, the number is explicitly signed.
 (let ((number-regexp
        "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
Mark Oteiza's avatar
Mark Oteiza committed
341
   (cond ((and (null sign) (= (json-peek) ?-))
342 343
          (json-advance)
          (- (json-read-number t)))
Mark Oteiza's avatar
Mark Oteiza committed
344
         ((and (null sign) (= (json-peek) ?+))
345 346 347 348 349
          (json-advance)
          (json-read-number t))
         ((and (looking-at number-regexp)
               (or (match-beginning 1)
                   (match-beginning 2)))
350 351
          (goto-char (match-end 0))
          (string-to-number (match-string 0)))
352
         (t (signal 'json-number-format (list (point)))))))
353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373

;; Number encoding

(defun json-encode-number (number)
  "Return a JSON representation of NUMBER."
  (format "%s" number))

;;; Strings

(defvar json-special-chars
  '((?\" . ?\")
    (?\\ . ?\\)
    (?b . ?\b)
    (?f . ?\f)
    (?n . ?\n)
    (?r . ?\r)
    (?t . ?\t))
  "Characters which are escaped in JSON, with their elisp counterparts.")

;; String parsing

374 375
(defun json--decode-utf-16-surrogates (high low)
  "Return the code point represented by the UTF-16 surrogates HIGH and LOW."
376
  (+ (ash (- high #xD800) 10) (- low #xDC00) #x10000))
377

378 379 380 381 382 383 384 385 386
(defun json-read-escaped-char ()
  "Read the JSON string escaped character at point."
  ;; Skip over the '\'
  (json-advance)
  (let* ((char (json-pop))
         (special (assq char json-special-chars)))
    (cond
     (special (cdr special))
     ((not (eq char ?u)) char)
387
     ;; Special-case UTF-16 surrogate pairs,
388
     ;; cf. <https://tools.ietf.org/html/rfc7159#section-7>.  Note that
389 390 391
     ;; this clause overlaps with the next one and therefore has to
     ;; come first.
     ((looking-at
Mark Oteiza's avatar
Mark Oteiza committed
392 393
       (rx (group (any "Dd") (any "89ABab") (= 2 (any xdigit)))
           "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any xdigit)))))
394 395 396 397
      (json-advance 10)
      (json--decode-utf-16-surrogates
       (string-to-number (match-string 1) 16)
       (string-to-number (match-string 2) 16)))
Mark Oteiza's avatar
Mark Oteiza committed
398
     ((looking-at (rx (= 4 xdigit)))
399 400
      (let ((hex (match-string 0)))
        (json-advance 4)
401
        (string-to-number hex 16)))
402 403 404 405 406
     (t
      (signal 'json-string-escape (list (point)))))))

(defun json-read-string ()
  "Read the JSON string at point."
Mark Oteiza's avatar
Mark Oteiza committed
407
  (unless (= (json-peek) ?\")
408
    (signal 'json-string-format (list "doesn't start with `\"'!")))
409 410 411 412
  ;; Skip over the '"'
  (json-advance)
  (let ((characters '())
        (char (json-peek)))
Mark Oteiza's avatar
Mark Oteiza committed
413
    (while (not (= char ?\"))
414 415
      (when (< char 32)
        (signal 'json-string-format (list (prin1-char char))))
Mark Oteiza's avatar
Mark Oteiza committed
416
      (push (if (= char ?\\)
417 418 419 420 421 422 423
                (json-read-escaped-char)
              (json-pop))
            characters)
      (setq char (json-peek)))
    ;; Skip over the '"'
    (json-advance)
    (if characters
424
        (concat (nreverse characters))
425 426 427 428 429 430
      "")))

;; String encoding

(defun json-encode-string (string)
  "Return a JSON representation of STRING."
Dmitry Gutov's avatar
Dmitry Gutov committed
431 432 433 434 435
  ;; Reimplement the meat of `replace-regexp-in-string', for
  ;; performance (bug#20154).
  (let ((l (length string))
        (start 0)
        res mb)
436 437 438
    ;; Only escape quotation mark, backslash and the control
    ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
    (while (setq mb (string-match "[\"\\[:cntrl:]]" string start))
Dmitry Gutov's avatar
Dmitry Gutov committed
439 440 441 442 443 444 445 446 447 448 449 450 451
      (let* ((c (aref string mb))
             (special (rassq c json-special-chars)))
        (push (substring string start mb) res)
        (push (if special
                  ;; Special JSON character (\n, \r, etc.).
                  (string ?\\ (car special))
                ;; Fallback: UCS code point in \uNNNN form.
                (format "\\u%04x" c))
              res)
        (setq start (1+ mb))))
    (push (substring string start l) res)
    (push "\"" res)
    (apply #'concat "\"" (nreverse res))))
452

453 454 455 456 457 458 459 460 461
(defun json-encode-key (object)
  "Return a JSON representation of OBJECT.
If the resulting JSON object isn't a valid JSON object key,
this signals `json-key-format'."
  (let ((encoded (json-encode object)))
    (unless (stringp (json-read-from-string encoded))
      (signal 'json-key-format (list object)))
    encoded))

462 463 464 465 466 467 468 469
;;; JSON Objects

(defun json-new-object ()
  "Create a new Elisp object corresponding to a JSON object.
Please see the documentation of `json-object-type'."
  (cond ((eq json-object-type 'hash-table)
         (make-hash-table :test 'equal))
        (t
470
         ())))
471 472 473 474 475 476 477

(defun json-add-to-object (object key value)
  "Add a new KEY -> VALUE association to OBJECT.
Returns the updated object, which you should save, e.g.:
    (setq obj (json-add-to-object obj \"foo\" \"bar\"))
Please see the documentation of `json-object-type' and `json-key-type'."
  (let ((json-key-type
Mark Oteiza's avatar
Mark Oteiza committed
478
         (or json-key-type
479 480
             (cdr (assq json-object-type '((hash-table . string)
                                           (alist . symbol)
Mark Oteiza's avatar
Mark Oteiza committed
481
                                           (plist . keyword)))))))
482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506
    (setq key
          (cond ((eq json-key-type 'string)
                 key)
                ((eq json-key-type 'symbol)
                 (intern key))
                ((eq json-key-type 'keyword)
                 (intern (concat ":" key)))))
    (cond ((eq json-object-type 'hash-table)
           (puthash key value object)
           object)
          ((eq json-object-type 'alist)
           (cons (cons key value) object))
          ((eq json-object-type 'plist)
           (cons key (cons value object))))))

;; JSON object parsing

(defun json-read-object ()
  "Read the JSON object at point."
  ;; Skip over the "{"
  (json-advance)
  (json-skip-whitespace)
  ;; read key/value pairs until "}"
  (let ((elements (json-new-object))
        key value)
Mark Oteiza's avatar
Mark Oteiza committed
507
    (while (not (= (json-peek) ?}))
508 509 510
      (json-skip-whitespace)
      (setq key (json-read-string))
      (json-skip-whitespace)
Mark Oteiza's avatar
Mark Oteiza committed
511
      (if (= (json-peek) ?:)
512 513
          (json-advance)
        (signal 'json-object-format (list ":" (json-peek))))
514 515 516
      (json-skip-whitespace)
      (when json-pre-element-read-function
        (funcall json-pre-element-read-function key))
517
      (setq value (json-read))
518 519
      (when json-post-element-read-function
        (funcall json-post-element-read-function))
520 521
      (setq elements (json-add-to-object elements key value))
      (json-skip-whitespace)
Mark Oteiza's avatar
Mark Oteiza committed
522 523
      (when (/= (json-peek) ?})
        (if (= (json-peek) ?,)
524 525 526 527
            (json-advance)
          (signal 'json-object-format (list "," (json-peek))))))
    ;; Skip over the "}"
    (json-advance)
528
    (pcase json-object-type
529 530
      ('alist (nreverse elements))
      ('plist (json--plist-reverse elements))
531
      (_ elements))))
532 533 534 535 536

;; Hash table encoding

(defun json-encode-hash-table (hash-table)
  "Return a JSON representation of HASH-TABLE."
537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559
  (if json-encoding-object-sort-predicate
      (json-encode-alist (map-into hash-table 'list))
    (format "{%s%s}"
            (json-join
             (let (r)
               (json--with-indentation
                (maphash
                 (lambda (k v)
                   (push (format
                          (if json-encoding-pretty-print
                              "%s%s: %s"
                            "%s%s:%s")
                          json--encoding-current-indentation
                          (json-encode-key k)
                          (json-encode v))
                         r))
                 hash-table))
               r)
             json-encoding-separator)
            (if (or (not json-encoding-pretty-print)
                    json-encoding-lisp-style-closings)
                ""
              json--encoding-current-indentation))))
560 561 562 563 564

;; List encoding (including alists and plists)

(defun json-encode-alist (alist)
  "Return a JSON representation of ALIST."
565 566 567 568 569
  (when json-encoding-object-sort-predicate
    (setq alist
          (sort alist (lambda (a b)
                        (funcall json-encoding-object-sort-predicate
                                 (car a) (car b))))))
570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585
  (format "{%s%s}"
          (json-join
           (json--with-indentation
            (mapcar (lambda (cons)
                      (format (if json-encoding-pretty-print
                                  "%s%s: %s"
                                "%s%s:%s")
                              json--encoding-current-indentation
                              (json-encode-key (car cons))
                              (json-encode (cdr cons))))
                    alist))
           json-encoding-separator)
          (if (or (not json-encoding-pretty-print)
                  json-encoding-lisp-style-closings)
              ""
            json--encoding-current-indentation)))
586 587 588

(defun json-encode-plist (plist)
  "Return a JSON representation of PLIST."
589 590 591 592 593 594
  (if json-encoding-object-sort-predicate
      (json-encode-alist (json--plist-to-alist plist))
    (let (result)
      (json--with-indentation
       (while plist
         (push (concat
595
                json--encoding-current-indentation
596 597 598 599 600 601 602 603 604 605 606 607 608 609
                (json-encode-key (car plist))
                (if json-encoding-pretty-print
                    ": "
                  ":")
                (json-encode (cadr plist)))
               result)
         (setq plist (cddr plist))))
      (concat "{"
              (json-join (nreverse result) json-encoding-separator)
              (if (and json-encoding-pretty-print
                       (not json-encoding-lisp-style-closings))
                  json--encoding-current-indentation
                "")
              "}"))))
610 611 612 613 614

(defun json-encode-list (list)
  "Return a JSON representation of LIST.
Tries to DWIM: simple lists become JSON arrays, while alists and plists
become JSON objects."
615
  (cond ((json-alist-p list) (json-encode-alist list))
616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631
        ((json-plist-p list) (json-encode-plist list))
        ((listp list)        (json-encode-array list))
        (t
         (signal 'json-error (list list)))))

;;; Arrays

;; Array parsing

(defun json-read-array ()
  "Read the JSON array at point."
  ;; Skip over the "["
  (json-advance)
  (json-skip-whitespace)
  ;; read values until "]"
  (let (elements)
Mark Oteiza's avatar
Mark Oteiza committed
632
    (while (not (= (json-peek) ?\]))
633 634 635
      (json-skip-whitespace)
      (when json-pre-element-read-function
        (funcall json-pre-element-read-function (length elements)))
636
      (push (json-read) elements)
637 638
      (when json-post-element-read-function
        (funcall json-post-element-read-function))
639
      (json-skip-whitespace)
Mark Oteiza's avatar
Mark Oteiza committed
640 641
      (when (/= (json-peek) ?\])
        (if (= (json-peek) ?,)
642 643 644 645
            (json-advance)
          (signal 'json-error (list 'bleah)))))
    ;; Skip over the "]"
    (json-advance)
646
    (pcase json-array-type
647 648
      ('vector (nreverse (vconcat elements)))
      ('list (nreverse elements)))))
649 650 651 652 653

;; Array encoding

(defun json-encode-array (array)
  "Return a JSON representation of ARRAY."
654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669
  (if (and json-encoding-pretty-print
           (> (length array) 0))
      (concat
       (json--with-indentation
         (concat (format "[%s" json--encoding-current-indentation)
                 (json-join (mapcar 'json-encode array)
                            (format "%s%s"
                                    json-encoding-separator
                                    json--encoding-current-indentation))))
       (format "%s]"
               (if json-encoding-lisp-style-closings
                   ""
                 json--encoding-current-indentation)))
    (concat "["
            (mapconcat 'json-encode array json-encoding-separator)
            "]")))
670 671 672 673 674



;;; JSON reader.

675 676 677
(defmacro json-readtable-dispatch (char)
  "Dispatch reader function for CHAR."
  (declare (debug (symbolp)))
678 679 680 681 682 683
  (let ((table
         '((?t json-read-keyword "true")
           (?f json-read-keyword "false")
           (?n json-read-keyword "null")
           (?{ json-read-object)
           (?\[ json-read-array)
684 685 686 687 688 689
           (?\" json-read-string)))
        res)
    (dolist (c '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
      (push (list c 'json-read-number) table))
    (pcase-dolist (`(,c . ,rest) table)
      (push `((eq ,char ,c) (,@rest)) res))
690
    `(cond ,@res (t (signal 'json-readtable-error (list ,char))))))
691 692 693 694 695 696

(defun json-read ()
  "Parse and return the JSON object following point.
Advances point just past JSON object."
  (json-skip-whitespace)
  (let ((char (json-peek)))
697 698
    (if (zerop char)
        (signal 'json-end-of-file nil)
699
      (json-readtable-dispatch char))))
700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727

;; Syntactic sugar for the reader

(defun json-read-from-string (string)
  "Read the JSON object contained in STRING and return it."
  (with-temp-buffer
    (insert string)
    (goto-char (point-min))
    (json-read)))

(defun json-read-file (file)
  "Read the first JSON object contained in FILE and return it."
  (with-temp-buffer
    (insert-file-contents file)
    (goto-char (point-min))
    (json-read)))



;;; JSON encoder

(defun json-encode (object)
  "Return a JSON representation of OBJECT as a string."
  (cond ((memq object (list t json-null json-false))
         (json-encode-keyword object))
        ((stringp object)      (json-encode-string object))
        ((keywordp object)     (json-encode-string
                                (substring (symbol-name object) 1)))
728
        ((listp object)        (json-encode-list object))
729 730 731 732 733 734 735
        ((symbolp object)      (json-encode-string
                                (symbol-name object)))
        ((numberp object)      (json-encode-number object))
        ((arrayp object)       (json-encode-array object))
        ((hash-table-p object) (json-encode-hash-table object))
        (t                     (signal 'json-error (list object)))))

736 737 738 739 740 741 742 743
;; Pretty printing & minimizing

(defun json-pretty-print-buffer (&optional minimize)
  "Pretty-print current buffer.
With prefix argument MINIMIZE, minimize it instead."
  (interactive "P")
  (json-pretty-print (point-min) (point-max) minimize))

744 745 746 747 748 749
(defvar json-pretty-print-max-secs 2.0
  "Maximum time for `json-pretty-print's comparison.
The function `json-pretty-print' uses `replace-region-contents'
(which see) passing the value of this variable as argument
MAX-SECS.")

750 751 752 753 754 755 756 757 758 759 760
(defun json-pretty-print (begin end &optional minimize)
  "Pretty-print selected region.
With prefix argument MINIMIZE, minimize it instead."
  (interactive "r\nP")
  (let ((json-encoding-pretty-print (null minimize))
        ;; Distinguish an empty objects from 'null'
        (json-null :json-null)
        ;; Ensure that ordering is maintained
        (json-object-type 'alist))
    (replace-region-contents
     begin end
761 762 763 764 765
     (lambda () (json-encode (json-read)))
     json-pretty-print-max-secs
     ;; FIXME: What's a good value here?  Can we use something better,
     ;; e.g., by deriving a value from the size of the region?
     64)))
766 767 768 769

(defun json-pretty-print-buffer-ordered (&optional minimize)
  "Pretty-print current buffer with object keys ordered.
With prefix argument MINIMIZE, minimize it instead."
Tassilo Horn's avatar
Tassilo Horn committed
770
  (interactive "P")
771
  (let ((json-encoding-object-sort-predicate 'string<))
772
    (json-pretty-print-buffer minimize)))
773

774 775 776 777
(defun json-pretty-print-ordered (begin end &optional minimize)
  "Pretty-print the region with object keys ordered.
With prefix argument MINIMIZE, minimize it instead."
  (interactive "r\nP")
778
  (let ((json-encoding-object-sort-predicate 'string<))
779
    (json-pretty-print begin end minimize)))
780

781 782 783
(provide 'json)

;;; json.el ends here