json.el 26.4 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 54

;;; Code:

55
(require 'map)
56
(require 'subr-x)
57

58 59 60 61
;; Parameters

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

(defvar json-array-type 'vector
  "Type to convert JSON arrays to.
Juanma Barranquero's avatar
Juanma Barranquero committed
68
Must be one of `vector' or `list'.  Consider let-binding this around
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
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
84
Sufficiently Weird keys.  Consider let-binding this around your call to
85 86 87 88 89
`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
90
the difference between `false' and `null'.  Consider let-binding this
91 92 93 94 95
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
96
tell the difference between `false' and `null'.  Consider let-binding
97 98
this around your call to `json-read' instead of `setq'ing it.")

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

(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.")

117 118 119 120 121 122 123
(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.")

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

135 136 137 138 139 140 141 142 143


;;; Utilities

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

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

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

161 162 163 164 165 166 167 168 169 170 171
(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))

172 173 174 175 176 177 178 179 180
(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)))

181 182 183 184 185 186 187 188
(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))

189 190
;; Reader utilities

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

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

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

(define-inline json-skip-whitespace ()
209
  "Skip past the whitespace at point."
210 211 212 213
  ;; 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
214
  (inline-quote (skip-chars-forward "\t\r\n ")))
215 216 217 218 219



;; Error conditions

220 221 222 223 224 225 226 227
(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)
228 229
(define-error 'json-end-of-file "End of file while parsing JSON"
  '(end-of-file json-error))
230 231 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
;;; 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))))

288 289 290 291 292 293 294 295 296 297 298 299 300
;;; 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
301
          (when (/= char (json-peek))
302 303
            (signal 'json-unknown-keyword
                    (list (save-excursion
304
                            (backward-word-strictly 1)
305
                            (thing-at-point 'word)))))
306 307
          (json-advance))
        keyword)
Mark Oteiza's avatar
Mark Oteiza committed
308
  (json-skip-whitespace)
309
  (unless (looking-at "\\([],}]\\|$\\)")
310 311
    (signal 'json-unknown-keyword
            (list (save-excursion
312
                    (backward-word-strictly 1)
313
                    (thing-at-point 'word)))))
314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329
  (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

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

334 335
N.B.: Only numbers which can fit in Emacs Lisp's native number
representation will be parsed correctly."
336 337 338
 ;; 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
339
   (cond ((and (null sign) (= (json-peek) ?-))
340 341
          (json-advance)
          (- (json-read-number t)))
Mark Oteiza's avatar
Mark Oteiza committed
342
         ((and (null sign) (= (json-peek) ?+))
343 344 345 346 347
          (json-advance)
          (json-read-number t))
         ((and (looking-at number-regexp)
               (or (match-beginning 1)
                   (match-beginning 2)))
348 349
          (goto-char (match-end 0))
          (string-to-number (match-string 0)))
350
         (t (signal 'json-number-format (list (point)))))))
351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371

;; 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

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

376 377 378 379 380 381 382 383 384
(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)
385
     ;; Special-case UTF-16 surrogate pairs,
386
     ;; cf. <https://tools.ietf.org/html/rfc7159#section-7>.  Note that
387 388 389
     ;; this clause overlaps with the next one and therefore has to
     ;; come first.
     ((looking-at
Mark Oteiza's avatar
Mark Oteiza committed
390 391
       (rx (group (any "Dd") (any "89ABab") (= 2 (any xdigit)))
           "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any xdigit)))))
392 393 394 395
      (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
396
     ((looking-at (rx (= 4 xdigit)))
397 398
      (let ((hex (match-string 0)))
        (json-advance 4)
399
        (string-to-number hex 16)))
400 401 402 403 404
     (t
      (signal 'json-string-escape (list (point)))))))

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

;; String encoding

(defun json-encode-string (string)
  "Return a JSON representation of STRING."
Dmitry Gutov's avatar
Dmitry Gutov committed
429 430 431 432 433
  ;; Reimplement the meat of `replace-regexp-in-string', for
  ;; performance (bug#20154).
  (let ((l (length string))
        (start 0)
        res mb)
434 435 436
    ;; 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
437 438 439 440 441 442 443 444 445 446 447 448 449
      (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))))
450

451 452 453 454 455 456 457 458 459
(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))

460 461 462 463 464 465 466 467
;;; 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
468
         ())))
469 470 471 472 473 474 475

(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
476
         (or json-key-type
477 478
             (cdr (assq json-object-type '((hash-table . string)
                                           (alist . symbol)
Mark Oteiza's avatar
Mark Oteiza committed
479
                                           (plist . keyword)))))))
480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504
    (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
505
    (while (not (= (json-peek) ?}))
506 507 508
      (json-skip-whitespace)
      (setq key (json-read-string))
      (json-skip-whitespace)
Mark Oteiza's avatar
Mark Oteiza committed
509
      (if (= (json-peek) ?:)
510 511
          (json-advance)
        (signal 'json-object-format (list ":" (json-peek))))
512 513 514
      (json-skip-whitespace)
      (when json-pre-element-read-function
        (funcall json-pre-element-read-function key))
515
      (setq value (json-read))
516 517
      (when json-post-element-read-function
        (funcall json-post-element-read-function))
518 519
      (setq elements (json-add-to-object elements key value))
      (json-skip-whitespace)
Mark Oteiza's avatar
Mark Oteiza committed
520 521
      (when (/= (json-peek) ?})
        (if (= (json-peek) ?,)
522 523 524 525
            (json-advance)
          (signal 'json-object-format (list "," (json-peek))))))
    ;; Skip over the "}"
    (json-advance)
526
    (pcase json-object-type
527 528
      ('alist (nreverse elements))
      ('plist (json--plist-reverse elements))
529
      (_ elements))))
530 531 532 533 534

;; Hash table encoding

(defun json-encode-hash-table (hash-table)
  "Return a JSON representation of HASH-TABLE."
535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557
  (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))))
558 559 560 561 562

;; List encoding (including alists and plists)

(defun json-encode-alist (alist)
  "Return a JSON representation of ALIST."
563 564 565 566 567
  (when json-encoding-object-sort-predicate
    (setq alist
          (sort alist (lambda (a b)
                        (funcall json-encoding-object-sort-predicate
                                 (car a) (car b))))))
568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583
  (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)))
584 585 586

(defun json-encode-plist (plist)
  "Return a JSON representation of PLIST."
587 588 589 590 591 592
  (if json-encoding-object-sort-predicate
      (json-encode-alist (json--plist-to-alist plist))
    (let (result)
      (json--with-indentation
       (while plist
         (push (concat
593
                json--encoding-current-indentation
594 595 596 597 598 599 600 601 602 603 604 605 606 607
                (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
                "")
              "}"))))
608 609 610 611 612

(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."
613
  (cond ((json-alist-p list) (json-encode-alist list))
614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629
        ((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
630
    (while (not (= (json-peek) ?\]))
631 632 633
      (json-skip-whitespace)
      (when json-pre-element-read-function
        (funcall json-pre-element-read-function (length elements)))
634
      (push (json-read) elements)
635 636
      (when json-post-element-read-function
        (funcall json-post-element-read-function))
637
      (json-skip-whitespace)
Mark Oteiza's avatar
Mark Oteiza committed
638 639
      (when (/= (json-peek) ?\])
        (if (= (json-peek) ?,)
640 641 642 643
            (json-advance)
          (signal 'json-error (list 'bleah)))))
    ;; Skip over the "]"
    (json-advance)
644
    (pcase json-array-type
645 646
      ('vector (nreverse (vconcat elements)))
      ('list (nreverse elements)))))
647 648 649 650 651

;; Array encoding

(defun json-encode-array (array)
  "Return a JSON representation of ARRAY."
652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667
  (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)
            "]")))
668 669 670 671 672



;;; JSON reader.

673 674 675
(defmacro json-readtable-dispatch (char)
  "Dispatch reader function for CHAR."
  (declare (debug (symbolp)))
676 677 678 679 680 681
  (let ((table
         '((?t json-read-keyword "true")
           (?f json-read-keyword "false")
           (?n json-read-keyword "null")
           (?{ json-read-object)
           (?\[ json-read-array)
682 683 684 685 686 687
           (?\" 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))
688
    `(cond ,@res (t (signal 'json-readtable-error (list ,char))))))
689 690 691

(defun json-read ()
  "Parse and return the JSON object following point.
692 693 694 695 696 697 698 699 700 701 702 703 704
Advances point just past JSON object.

If called with the following JSON after point

  {\"a\": [1, 2, {\"c\": false}],
   \"b\": \"foo\"}

you will get the following structure returned:

  ((a .
      [1 2
         ((c . :json-false))])
   (b . \"foo\"))"
705 706
  (json-skip-whitespace)
  (let ((char (json-peek)))
707 708
    (if (zerop char)
        (signal 'json-end-of-file nil)
709
      (json-readtable-dispatch char))))
710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731

;; 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)
732 733 734
  "Return a JSON representation of OBJECT as a string.

OBJECT should have a structure like one returned by `json-read'.
735 736
If an error is detected during encoding, an error based on
`json-error' is signalled."
737 738 739 740 741
  (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)))
742
        ((listp object)        (json-encode-list object))
743 744 745 746 747 748 749
        ((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)))))

750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765
;; 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))

(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
766
        (json-object-type 'alist)
Lars Ingebrigtsen's avatar
Lars Ingebrigtsen committed
767
        (err (gensym))
768 769 770 771
        json)
    (save-restriction
      (narrow-to-region begin end)
      (goto-char begin)
Lars Ingebrigtsen's avatar
Lars Ingebrigtsen committed
772 773 774 775
      (while (not (eq (setq json (condition-case _
                                     (json-read)
                                   (json-error err)))
                      err))
776 777 778
        (delete-region begin (point))
        (insert (json-encode json))
        (setq begin (point))))))
779 780 781 782

(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
783
  (interactive "P")
784
  (let ((json-encoding-object-sort-predicate 'string<))
785
    (json-pretty-print-buffer minimize)))
786

787 788 789 790
(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")
791
  (let ((json-encoding-object-sort-predicate 'string<))
792
    (json-pretty-print begin end minimize)))
793

794 795 796
(provide 'json)

;;; json.el ends here