lisp/json.el

   1 ;;; json.el --- JavaScript Object Notation parser / generator -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2006-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Theresa O'Connor <ted@oconnor.cx>
   6 ;; Version: 1.4
   7 ;; Keywords: convenience
   8
   9 ;; This file is part of GNU Emacs.
  10
  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.
  15
  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.
  20
  21 ;; 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 ;;; Commentary:
  25
  26 ;; This is a library for parsing and generating JSON (JavaScript Object
  27 ;; Notation).
  28
  29 ;; Learn all about JSON here: <URL:http://json.org/>.
  30
  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'.
  34
  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').
  39
  40 ;; Similarly, since `false' and `null' are distinct in JSON, you can
  41 ;; distinguish them by binding `json-false' and `json-null' as desired.
  42
  43 ;;; History:
  44
  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)
  52
  53 ;;; Code:
  54
  55 (require 'map)
  56
  57 ;; Parameters
  58
  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'.")
  64
  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.")
  69
  70 (defvar json-key-type nil
  71   "Type to convert JSON keys to.
  72 Must be one of `string', `symbol', `keyword', or nil.
  73
  74 If nil, `json-read' will guess the type based on the value of
  75 `json-object-type':
  76
  77     If `json-object-type' is:   nil will be interpreted as:
  78       `hash-table'                `string'
  79       `alist'                     `symbol'
  80       `plist'                     `keyword'
  81
  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.")
  85
  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.")
  91
  92 (defvar json-null nil
  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.")
  97
  98 (defvar json-encoding-separator ","
  99   "Value to use as an element separator when encoding.")
 100
 101 (defvar json-encoding-default-indentation "  "
 102   "The default indentation level for encoding.
 103 Used only when `json-encoding-pretty-print' is non-nil.")
 104
 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.")
 108
 109 (defvar json-encoding-pretty-print nil
 110   "If non-nil, then the output of `json-encode' will be pretty-printed.")
 111
 112 (defvar json-encoding-lisp-style-closings nil
 113   "If non-nil, ] and } closings will be formatted lisp-style,
 114 without indentation.")
 115
 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.")
 122
 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.")
 128
 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,
 132 respectively.")
 133
 134 \f
 135
 136 ;;; Utilities
 137
 138 (defun json-join (strings separator)
 139   "Join STRINGS with SEPARATOR."
 140   (mapconcat 'identity strings separator))
 141
 142 (defun json-alist-p (list)
 143   "Non-null if and only if LIST is an alist with simple keys."
 144   (while (consp list)
 145     (setq list (if (and (consp (car list))
 146                         (atom (caar list)))
 147                    (cdr list)
 148                  'not-alist)))
 149   (null list))
 150
 151 (defun json-plist-p (list)
 152   "Non-null if and only if LIST is a plist with keyword keys."
 153   (while (consp list)
 154     (setq list (if (and (keywordp (car list))
 155                         (consp (cdr list)))
 156                    (cddr list)
 157                  'not-plist)))
 158   (null list))
 159
 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."
 163   (let (res)
 164     (while plist
 165       (let ((prop (pop plist))
 166             (val (pop plist)))
 167         (push val res)
 168         (push prop res)))
 169     res))
 170
 171 (defun json--plist-to-alist (plist)
 172   "Return an alist of the property-value pairs in PLIST."
 173   (let (res)
 174     (while plist
 175       (let ((prop (pop plist))
 176             (val (pop plist)))
 177         (push (cons prop val) res)))
 178     (nreverse res)))
 179
 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)
 185             "")))
 186      ,body))
 187
 188 ;; Reader utilities
 189
 190 (define-inline json-advance (&optional n)
 191   "Advance N characters forward."
 192   (inline-quote (forward-char ,n)))
 193
 194 (define-inline json-peek ()
 195   "Return the character at point."
 196   (inline-quote (following-char)))
 197
 198 (define-inline json-pop ()
 199   "Advance past the character at point, returning it."
 200   (inline-quote
 201    (let ((char (json-peek)))
 202      (if (zerop char)
 203          (signal 'json-end-of-file nil)
 204        (json-advance)
 205        char))))
 206
 207 (define-inline json-skip-whitespace ()
 208   "Skip past the whitespace at point."
 209   ;; See
 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   (inline-quote (skip-chars-forward "\t\r\n ")))
 214
 215 \f
 216
 217 ;; Error conditions
 218
 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))
 229
 230 \f
 231
 232 ;;; Paths
 233
 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'.")
 237
 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))
 242
 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))
 249                               :match-start start
 250                               :match-end (point)))))
 251   (pop json--path))
 252
 253 (defun json-path-to-position (position &optional string)
 254   "Return the path to the JSON element at POSITION.
 255
 256 When STRING is provided, return the path to the position in the
 257 string, else to the position in the current buffer.
 258
 259 The return value is a property list with the following
 260 properties:
 261
 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
 265                 indexes.
 266
 267 :match-start -- Position where the matched JSON element begins.
 268
 269 :match-end   -- Position where the matched JSON element ends.
 270
 271 This can for instance be useful to determine the path to a JSON
 272 element in a deeply nested structure."
 273   (save-excursion
 274     (unless string
 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
 281                    (if string
 282                        (json-read-from-string string)
 283                      (json-read)))))
 284       (when (plist-get path :path)
 285         path))))
 286
 287 ;;; Keywords
 288
 289 (defvar json-keywords '("true" "false" "null")
 290   "List of JSON keywords.")
 291
 292 ;; Keyword parsing
 293
 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)))
 299   (mapc (lambda (char)
 300           (when (/= char (json-peek))
 301             (signal 'json-unknown-keyword
 302                     (list (save-excursion
 303                             (backward-word-strictly 1)
 304                             (thing-at-point 'word)))))
 305           (json-advance))
 306         keyword)
 307   (json-skip-whitespace)
 308   (unless (looking-at "\\([],}]\\|$\\)")
 309     (signal 'json-unknown-keyword
 310             (list (save-excursion
 311                     (backward-word-strictly 1)
 312                     (thing-at-point 'word)))))
 313   (cond ((string-equal keyword "true") t)
 314         ((string-equal keyword "false") json-false)
 315         ((string-equal keyword "null") json-null)))
 316
 317 ;; Keyword encoding
 318
 319 (defun json-encode-keyword (keyword)
 320   "Encode KEYWORD as a JSON value."
 321   (cond ((eq keyword t)          "true")
 322         ((eq keyword json-false) "false")
 323         ((eq keyword json-null)  "null")))
 324
 325 ;;; Numbers
 326
 327 ;; Number parsing
 328
 329 (defun json-read-number (&optional sign)
 330  "Read the JSON number following point.
 331 The optional SIGN argument is for internal use.
 332
 333 N.B.: Only numbers which can fit in Emacs Lisp's native number
 334 representation will be parsed correctly."
 335  ;; If SIGN is non-nil, the number is explicitly signed.
 336  (let ((number-regexp
 337         "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
 338    (cond ((and (null sign) (= (json-peek) ?-))
 339           (json-advance)
 340           (- (json-read-number t)))
 341          ((and (null sign) (= (json-peek) ?+))
 342           (json-advance)
 343           (json-read-number t))
 344          ((and (looking-at number-regexp)
 345                (or (match-beginning 1)
 346                    (match-beginning 2)))
 347           (goto-char (match-end 0))
 348           (string-to-number (match-string 0)))
 349          (t (signal 'json-number-format (list (point)))))))
 350
 351 ;; Number encoding
 352
 353 (defun json-encode-number (number)
 354   "Return a JSON representation of NUMBER."
 355   (format "%s" number))
 356
 357 ;;; Strings
 358
 359 (defvar json-special-chars
 360   '((?\" . ?\")
 361     (?\\ . ?\\)
 362     (?b . ?\b)
 363     (?f . ?\f)
 364     (?n . ?\n)
 365     (?r . ?\r)
 366     (?t . ?\t))
 367   "Characters which are escaped in JSON, with their elisp counterparts.")
 368
 369 ;; String parsing
 370
 371 (defun json--decode-utf-16-surrogates (high low)
 372   "Return the code point represented by the UTF-16 surrogates HIGH and LOW."
 373   (+ (lsh (- high #xD800) 10) (- low #xDC00) #x10000))
 374
 375 (defun json-read-escaped-char ()
 376   "Read the JSON string escaped character at point."
 377   ;; Skip over the '\'
 378   (json-advance)
 379   (let* ((char (json-pop))
 380          (special (assq char json-special-chars)))
 381     (cond
 382      (special (cdr special))
 383      ((not (eq char ?u)) char)
 384      ;; Special-case UTF-16 surrogate pairs,
 385      ;; cf. <https://tools.ietf.org/html/rfc7159#section-7>.  Note that
 386      ;; this clause overlaps with the next one and therefore has to
 387      ;; come first.
 388      ((looking-at
 389        (rx (group (any "Dd") (any "89ABab") (= 2 (any xdigit)))
 390            "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any xdigit)))))
 391       (json-advance 10)
 392       (json--decode-utf-16-surrogates
 393        (string-to-number (match-string 1) 16)
 394        (string-to-number (match-string 2) 16)))
 395      ((looking-at (rx (= 4 xdigit)))
 396       (let ((hex (match-string 0)))
 397         (json-advance 4)
 398         (string-to-number hex 16)))
 399      (t
 400       (signal 'json-string-escape (list (point)))))))
 401
 402 (defun json-read-string ()
 403   "Read the JSON string at point."
 404   (unless (= (json-peek) ?\")
 405     (signal 'json-string-format (list "doesn't start with `\"'!")))
 406   ;; Skip over the '"'
 407   (json-advance)
 408   (let ((characters '())
 409         (char (json-peek)))
 410     (while (not (= char ?\"))
 411       (when (< char 32)
 412         (signal 'json-string-format (list (prin1-char char))))
 413       (push (if (= char ?\\)
 414                 (json-read-escaped-char)
 415               (json-pop))
 416             characters)
 417       (setq char (json-peek)))
 418     ;; Skip over the '"'
 419     (json-advance)
 420     (if characters
 421         (concat (nreverse characters))
 422       "")))
 423
 424 ;; String encoding
 425
 426 (defun json-encode-string (string)
 427   "Return a JSON representation of STRING."
 428   ;; Reimplement the meat of `replace-regexp-in-string', for
 429   ;; performance (bug#20154).
 430   (let ((l (length string))
 431         (start 0)
 432         res mb)
 433     ;; Only escape quotation mark, backslash and the control
 434     ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
 435     (while (setq mb (string-match "[\"\\[:cntrl:]]" string start))
 436       (let* ((c (aref string mb))
 437              (special (rassq c json-special-chars)))
 438         (push (substring string start mb) res)
 439         (push (if special
 440                   ;; Special JSON character (\n, \r, etc.).
 441                   (string ?\\ (car special))
 442                 ;; Fallback: UCS code point in \uNNNN form.
 443                 (format "\\u%04x" c))
 444               res)
 445         (setq start (1+ mb))))
 446     (push (substring string start l) res)
 447     (push "\"" res)
 448     (apply #'concat "\"" (nreverse res))))
 449
 450 (defun json-encode-key (object)
 451   "Return a JSON representation of OBJECT.
 452 If the resulting JSON object isn't a valid JSON object key,
 453 this signals `json-key-format'."
 454   (let ((encoded (json-encode object)))
 455     (unless (stringp (json-read-from-string encoded))
 456       (signal 'json-key-format (list object)))
 457     encoded))
 458
 459 ;;; JSON Objects
 460
 461 (defun json-new-object ()
 462   "Create a new Elisp object corresponding to a JSON object.
 463 Please see the documentation of `json-object-type'."
 464   (cond ((eq json-object-type 'hash-table)
 465          (make-hash-table :test 'equal))
 466         (t
 467          ())))
 468
 469 (defun json-add-to-object (object key value)
 470   "Add a new KEY -> VALUE association to OBJECT.
 471 Returns the updated object, which you should save, e.g.:
 472     (setq obj (json-add-to-object obj \"foo\" \"bar\"))
 473 Please see the documentation of `json-object-type' and `json-key-type'."
 474   (let ((json-key-type
 475          (or json-key-type
 476              (cdr (assq json-object-type '((hash-table . string)
 477                                            (alist . symbol)
 478                                            (plist . keyword)))))))
 479     (setq key
 480           (cond ((eq json-key-type 'string)
 481                  key)
 482                 ((eq json-key-type 'symbol)
 483                  (intern key))
 484                 ((eq json-key-type 'keyword)
 485                  (intern (concat ":" key)))))
 486     (cond ((eq json-object-type 'hash-table)
 487            (puthash key value object)
 488            object)
 489           ((eq json-object-type 'alist)
 490            (cons (cons key value) object))
 491           ((eq json-object-type 'plist)
 492            (cons key (cons value object))))))
 493
 494 ;; JSON object parsing
 495
 496 (defun json-read-object ()
 497   "Read the JSON object at point."
 498   ;; Skip over the "{"
 499   (json-advance)
 500   (json-skip-whitespace)
 501   ;; read key/value pairs until "}"
 502   (let ((elements (json-new-object))
 503         key value)
 504     (while (not (= (json-peek) ?}))
 505       (json-skip-whitespace)
 506       (setq key (json-read-string))
 507       (json-skip-whitespace)
 508       (if (= (json-peek) ?:)
 509           (json-advance)
 510         (signal 'json-object-format (list ":" (json-peek))))
 511       (json-skip-whitespace)
 512       (when json-pre-element-read-function
 513         (funcall json-pre-element-read-function key))
 514       (setq value (json-read))
 515       (when json-post-element-read-function
 516         (funcall json-post-element-read-function))
 517       (setq elements (json-add-to-object elements key value))
 518       (json-skip-whitespace)
 519       (when (/= (json-peek) ?})
 520         (if (= (json-peek) ?,)
 521             (json-advance)
 522           (signal 'json-object-format (list "," (json-peek))))))
 523     ;; Skip over the "}"
 524     (json-advance)
 525     (pcase json-object-type
 526       (`alist (nreverse elements))
 527       (`plist (json--plist-reverse elements))
 528       (_ elements))))
 529
 530 ;; Hash table encoding
 531
 532 (defun json-encode-hash-table (hash-table)
 533   "Return a JSON representation of HASH-TABLE."
 534   (if json-encoding-object-sort-predicate
 535       (json-encode-alist (map-into hash-table 'list))
 536     (format "{%s%s}"
 537             (json-join
 538              (let (r)
 539                (json--with-indentation
 540                 (maphash
 541                  (lambda (k v)
 542                    (push (format
 543                           (if json-encoding-pretty-print
 544                               "%s%s: %s"
 545                             "%s%s:%s")
 546                           json--encoding-current-indentation
 547                           (json-encode-key k)
 548                           (json-encode v))
 549                          r))
 550                  hash-table))
 551                r)
 552              json-encoding-separator)
 553             (if (or (not json-encoding-pretty-print)
 554                     json-encoding-lisp-style-closings)
 555                 ""
 556               json--encoding-current-indentation))))
 557
 558 ;; List encoding (including alists and plists)
 559
 560 (defun json-encode-alist (alist)
 561   "Return a JSON representation of ALIST."
 562   (when json-encoding-object-sort-predicate
 563     (setq alist
 564           (sort alist (lambda (a b)
 565                         (funcall json-encoding-object-sort-predicate
 566                                  (car a) (car b))))))
 567   (format "{%s%s}"
 568           (json-join
 569            (json--with-indentation
 570             (mapcar (lambda (cons)
 571                       (format (if json-encoding-pretty-print
 572                                   "%s%s: %s"
 573                                 "%s%s:%s")
 574                               json--encoding-current-indentation
 575                               (json-encode-key (car cons))
 576                               (json-encode (cdr cons))))
 577                     alist))
 578            json-encoding-separator)
 579           (if (or (not json-encoding-pretty-print)
 580                   json-encoding-lisp-style-closings)
 581               ""
 582             json--encoding-current-indentation)))
 583
 584 (defun json-encode-plist (plist)
 585   "Return a JSON representation of PLIST."
 586   (if json-encoding-object-sort-predicate
 587       (json-encode-alist (json--plist-to-alist plist))
 588     (let (result)
 589       (json--with-indentation
 590        (while plist
 591          (push (concat
 592                 json--encoding-current-indentation
 593                 (json-encode-key (car plist))
 594                 (if json-encoding-pretty-print
 595                     ": "
 596                   ":")
 597                 (json-encode (cadr plist)))
 598                result)
 599          (setq plist (cddr plist))))
 600       (concat "{"
 601               (json-join (nreverse result) json-encoding-separator)
 602               (if (and json-encoding-pretty-print
 603                        (not json-encoding-lisp-style-closings))
 604                   json--encoding-current-indentation
 605                 "")
 606               "}"))))
 607
 608 (defun json-encode-list (list)
 609   "Return a JSON representation of LIST.
 610 Tries to DWIM: simple lists become JSON arrays, while alists and plists
 611 become JSON objects."
 612   (cond ((null list)         "null")
 613         ((json-alist-p list) (json-encode-alist list))
 614         ((json-plist-p list) (json-encode-plist list))
 615         ((listp list)        (json-encode-array list))
 616         (t
 617          (signal 'json-error (list list)))))
 618
 619 ;;; Arrays
 620
 621 ;; Array parsing
 622
 623 (defun json-read-array ()
 624   "Read the JSON array at point."
 625   ;; Skip over the "["
 626   (json-advance)
 627   (json-skip-whitespace)
 628   ;; read values until "]"
 629   (let (elements)
 630     (while (not (= (json-peek) ?\]))
 631       (json-skip-whitespace)
 632       (when json-pre-element-read-function
 633         (funcall json-pre-element-read-function (length elements)))
 634       (push (json-read) elements)
 635       (when json-post-element-read-function
 636         (funcall json-post-element-read-function))
 637       (json-skip-whitespace)
 638       (when (/= (json-peek) ?\])
 639         (if (= (json-peek) ?,)
 640             (json-advance)
 641           (signal 'json-error (list 'bleah)))))
 642     ;; Skip over the "]"
 643     (json-advance)
 644     (pcase json-array-type
 645       (`vector (nreverse (vconcat elements)))
 646       (`list (nreverse elements)))))
 647
 648 ;; Array encoding
 649
 650 (defun json-encode-array (array)
 651   "Return a JSON representation of ARRAY."
 652   (if (and json-encoding-pretty-print
 653            (> (length array) 0))
 654       (concat
 655        (json--with-indentation
 656          (concat (format "[%s" json--encoding-current-indentation)
 657                  (json-join (mapcar 'json-encode array)
 658                             (format "%s%s"
 659                                     json-encoding-separator
 660                                     json--encoding-current-indentation))))
 661        (format "%s]"
 662                (if json-encoding-lisp-style-closings
 663                    ""
 664                  json--encoding-current-indentation)))
 665     (concat "["
 666             (mapconcat 'json-encode array json-encoding-separator)
 667             "]")))
 668
 669 \f
 670
 671 ;;; JSON reader.
 672
 673 (defmacro json-readtable-dispatch (char)
 674   "Dispatch reader function for CHAR."
 675   (declare (debug (symbolp)))
 676   (let ((table
 677          '((?t json-read-keyword "true")
 678            (?f json-read-keyword "false")
 679            (?n json-read-keyword "null")
 680            (?{ json-read-object)
 681            (?\[ json-read-array)
 682            (?\" json-read-string)))
 683         res)
 684     (dolist (c '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
 685       (push (list c 'json-read-number) table))
 686     (pcase-dolist (`(,c . ,rest) table)
 687       (push `((eq ,char ,c) (,@rest)) res))
 688     `(cond ,@res (t (signal 'json-readtable-error ,char)))))
 689
 690 (defun json-read ()
 691   "Parse and return the JSON object following point.
 692 Advances point just past JSON object."
 693   (json-skip-whitespace)
 694   (let ((char (json-peek)))
 695     (if (zerop char)
 696         (signal 'json-end-of-file nil)
 697       (json-readtable-dispatch char))))
 698
 699 ;; Syntactic sugar for the reader
 700
 701 (defun json-read-from-string (string)
 702   "Read the JSON object contained in STRING and return it."
 703   (with-temp-buffer
 704     (insert string)
 705     (goto-char (point-min))
 706     (json-read)))
 707
 708 (defun json-read-file (file)
 709   "Read the first JSON object contained in FILE and return it."
 710   (with-temp-buffer
 711     (insert-file-contents file)
 712     (goto-char (point-min))
 713     (json-read)))
 714
 715 \f
 716
 717 ;;; JSON encoder
 718
 719 (defun json-encode (object)
 720   "Return a JSON representation of OBJECT as a string."
 721   (cond ((memq object (list t json-null json-false))
 722          (json-encode-keyword object))
 723         ((stringp object)      (json-encode-string object))
 724         ((keywordp object)     (json-encode-string
 725                                 (substring (symbol-name object) 1)))
 726         ((symbolp object)      (json-encode-string
 727                                 (symbol-name object)))
 728         ((numberp object)      (json-encode-number object))
 729         ((arrayp object)       (json-encode-array object))
 730         ((hash-table-p object) (json-encode-hash-table object))
 731         ((listp object)        (json-encode-list object))
 732         (t                     (signal 'json-error (list object)))))
 733
 734 ;; Pretty printing
 735
 736 (defun json-pretty-print-buffer ()
 737   "Pretty-print current buffer."
 738   (interactive)
 739   (json-pretty-print (point-min) (point-max)))
 740
 741 (defun json-pretty-print (begin end)
 742   "Pretty-print selected region."
 743   (interactive "r")
 744   (atomic-change-group
 745     (let ((json-encoding-pretty-print t)
 746           ;; Ensure that ordering is maintained
 747           (json-object-type 'alist)
 748           (txt (delete-and-extract-region begin end)))
 749       (insert (json-encode (json-read-from-string txt))))))
 750
 751 (defun json-pretty-print-buffer-ordered ()
 752   "Pretty-print current buffer with object keys ordered."
 753   (interactive)
 754   (let ((json-encoding-object-sort-predicate 'string<))
 755     (json-pretty-print-buffer)))
 756
 757 (defun json-pretty-print-ordered (begin end)
 758   "Pretty-print the region with object keys ordered."
 759   (interactive "r")
 760   (let ((json-encoding-object-sort-predicate 'string<))
 761     (json-pretty-print begin end)))
 762
 763 (provide 'json)
 764
 765 ;;; json.el ends here