Mercurial > lasercutter

     1 ;;; json.clj: JavaScript Object Notation (JSON) parser/writer

     2 

     3 ;; by Stuart Sierra, http://stuartsierra.com/

     4 ;; January 30, 2010

     5 

     6 ;; Copyright (c) Stuart Sierra, 2010. All rights reserved.  The use

     7 ;; and distribution terms for this software are covered by the Eclipse

     8 ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)

     9 ;; which can be found in the file epl-v10.html at the root of this

    10 ;; distribution.  By using this software in any fashion, you are

    11 ;; agreeing to be bound by the terms of this license.  You must not

    12 ;; remove this notice, or any other, from this software.

    13 

    14 (ns ^{:author "Stuart Sierra"

    15        :doc "JavaScript Object Notation (JSON) parser/writer.

    16   See http://www.json.org/

    17   To write JSON, use json-str, write-json, or write-json.

    18   To read JSON, use read-json."}

    19     clojure.contrib.json

    20   (:use [clojure.contrib.pprint :only (write formatter-out)]

    21         [clojure.contrib.string :only (as-str)])

    22   (:import (java.io PrintWriter PushbackReader StringWriter

    23                     StringReader Reader EOFException)))

    24 

    25 ;;; JSON READER

    26 

    27 (declare read-json-reader)

    28 

    29 (defn- read-json-array [^PushbackReader stream keywordize?]

    30   ;; Expects to be called with the head of the stream AFTER the

    31   ;; opening bracket.

    32   (loop [i (.read stream), result (transient [])]

    33     (let [c (char i)]

    34       (cond

    35        (= i -1) (throw (EOFException. "JSON error (end-of-file inside array)"))

    36        (Character/isWhitespace c) (recur (.read stream) result)

    37        (= c \,) (recur (.read stream) result)

    38        (= c \]) (persistent! result)

    39        :else (do (.unread stream (int c))

    40                  (let [element (read-json-reader stream keywordize? true nil)]

    41                    (recur (.read stream) (conj! result element))))))))

    42 

    43 (defn- read-json-object [^PushbackReader stream keywordize?]

    44   ;; Expects to be called with the head of the stream AFTER the

    45   ;; opening bracket.

    46   (loop [i (.read stream), key nil, result (transient {})]

    47     (let [c (char i)]

    48       (cond

    49        (= i -1) (throw (EOFException. "JSON error (end-of-file inside object)"))

    50 

    51        (Character/isWhitespace c) (recur (.read stream) key result)

    52 

    53        (= c \,) (recur (.read stream) nil result)

    54 

    55        (= c \:) (recur (.read stream) key result)

    56 

    57        (= c \}) (if (nil? key)

    58                   (persistent! result)

    59                   (throw (Exception. "JSON error (key missing value in object)")))

    60 

    61        :else (do (.unread stream i)

    62                  (let [element (read-json-reader stream keywordize? true nil)]

    63                    (if (nil? key)

    64                      (if (string? element)

    65                        (recur (.read stream) element result)

    66                        (throw (Exception. "JSON error (non-string key in object)")))

    67                      (recur (.read stream) nil

    68                             (assoc! result (if keywordize? (keyword key) key)

    69                                     element)))))))))

    70 

    71 (defn- read-json-hex-character [^PushbackReader stream]

    72   ;; Expects to be called with the head of the stream AFTER the

    73   ;; initial "\u".  Reads the next four characters from the stream.

    74   (let [digits [(.read stream)

    75                 (.read stream)

    76                 (.read stream)

    77                 (.read stream)]]

    78     (when (some neg? digits)

    79       (throw (EOFException. "JSON error (end-of-file inside Unicode character escape)")))

    80     (let [chars (map char digits)]

    81       (when-not (every? #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9 \a \b \c \d \e \f \A \B \C \D \E \F}

    82                         chars)

    83         (throw (Exception. "JSON error (invalid hex character in Unicode character escape)")))

    84       (char (Integer/parseInt (apply str chars) 16)))))

    85 

    86 (defn- read-json-escaped-character [^PushbackReader stream]

    87   ;; Expects to be called with the head of the stream AFTER the

    88   ;; initial backslash.

    89   (let [c (char (.read stream))]

    90     (cond

    91      (#{\" \\ \/} c) c

    92      (= c \b) \backspace

    93      (= c \f) \formfeed

    94      (= c \n) \newline

    95      (= c \r) \return

    96      (= c \t) \tab

    97      (= c \u) (read-json-hex-character stream))))

    98 

    99 (defn- read-json-quoted-string [^PushbackReader stream]

   100   ;; Expects to be called with the head of the stream AFTER the

   101   ;; opening quotation mark.

   102   (let [buffer (StringBuilder.)]

   103     (loop [i (.read stream)]

   104       (let [c (char i)]

   105         (cond

   106          (= i -1) (throw (EOFException. "JSON error (end-of-file inside string)"))

   107          (= c \") (str buffer)

   108          (= c \\) (do (.append buffer (read-json-escaped-character stream))

   109                       (recur (.read stream)))

   110          :else (do (.append buffer c)

   111                    (recur (.read stream))))))))

   112 

   113 (defn- read-json-reader

   114   ([^PushbackReader stream keywordize? eof-error? eof-value]

   115      (loop [i (.read stream)]

   116        (let [c (char i)]

   117          (cond

   118           ;; Handle end-of-stream

   119           (= i -1) (if eof-error?

   120                      (throw (EOFException. "JSON error (end-of-file)"))

   121                      eof-value)

   122 

   123           ;; Ignore whitespace

   124           (Character/isWhitespace c) (recur (.read stream))

   125 

   126           ;; Read numbers, true, and false with Clojure reader

   127           (#{\- \0 \1 \2 \3 \4 \5 \6 \7 \8 \9} c)

   128           (do (.unread stream i)

   129               (read stream true nil))

   130 

   131           ;; Read strings

   132           (= c \") (read-json-quoted-string stream)

   133 

   134           ;; Read null as nil

   135           (= c \n) (let [ull [(char (.read stream))

   136                               (char (.read stream))

   137                               (char (.read stream))]]

   138                      (if (= ull [\u \l \l])

   139                        nil

   140                        (throw (Exception. (str "JSON error (expected null): " c ull)))))

   141 

   142           ;; Read true

   143           (= c \t) (let [rue [(char (.read stream))

   144                               (char (.read stream))

   145                               (char (.read stream))]]

   146                      (if (= rue [\r \u \e])

   147                        true

   148                        (throw (Exception. (str "JSON error (expected true): " c rue)))))

   149 

   150           ;; Read false

   151           (= c \f) (let [alse [(char (.read stream))

   152                                (char (.read stream))

   153                                (char (.read stream))

   154                                (char (.read stream))]]

   155                      (if (= alse [\a \l \s \e])

   156                        false

   157                        (throw (Exception. (str "JSON error (expected false): " c alse)))))

   158 

   159           ;; Read JSON objects

   160           (= c \{) (read-json-object stream keywordize?)

   161 

   162           ;; Read JSON arrays

   163           (= c \[) (read-json-array stream keywordize?)

   164 

   165           :else (throw (Exception. (str "JSON error (unexpected character): " c))))))))

   166 

   167 (defprotocol Read-JSON-From

   168   (read-json-from [input keywordize? eof-error? eof-value]

   169                   "Reads one JSON value from input String or Reader.

   170   If keywordize? is true, object keys will be converted to keywords.

   171   If eof-error? is true, empty input will throw an EOFException; if

   172   false EOF will return eof-value. "))

   173 

   174 (extend-protocol

   175  Read-JSON-From

   176  String

   177  (read-json-from [input keywordize? eof-error? eof-value]

   178                  (read-json-reader (PushbackReader. (StringReader. input))

   179                                    keywordize? eof-error? eof-value))

   180  PushbackReader

   181  (read-json-from [input keywordize? eof-error? eof-value]

   182                  (read-json-reader input

   183                                    keywordize? eof-error? eof-value))

   184  Reader

   185  (read-json-from [input keywordize? eof-error? eof-value]

   186                  (read-json-reader (PushbackReader. input)

   187                                    keywordize? eof-error? eof-value)))

   188 

   189 (defn read-json

   190   "Reads one JSON value from input String or Reader.

   191   If keywordize? is true (default), object keys will be converted to

   192   keywords.  If eof-error? is true (default), empty input will throw

   193   an EOFException; if false EOF will return eof-value. "

   194   ([input]

   195      (read-json-from input true true nil))

   196   ([input keywordize?]

   197      (read-json-from input keywordize? true nil))

   198   ([input keywordize? eof-error? eof-value]

   199      (read-json-from input keywordize? eof-error? eof-value)))

   200 

   201 

   202 ;;; JSON PRINTER

   203 

   204 (defprotocol Write-JSON

   205   (write-json [object out]

   206               "Print object to PrintWriter out as JSON"))

   207 

   208 (defn- write-json-string [^CharSequence s ^PrintWriter out]

   209   (let [sb (StringBuilder. ^Integer (count s))]

   210     (.append sb \")

   211     (dotimes [i (count s)]

   212       (let [cp (Character/codePointAt s i)]

   213         (cond

   214          ;; Handle printable JSON escapes before ASCII

   215          (= cp 34) (.append sb "\\\"")

   216          (= cp 92) (.append sb "\\\\")

   217          (= cp 47) (.append sb "\\/")

   218          ;; Print simple ASCII characters

   219          (< 31 cp 127) (.append sb (.charAt s i))

   220          ;; Handle non-printable JSON escapes

   221          (= cp 8) (.append sb "\\b")

   222          (= cp 12) (.append sb "\\f")

   223          (= cp 10) (.append sb "\\n")

   224          (= cp 13) (.append sb "\\r")

   225          (= cp 9) (.append sb "\\t")

   226          ;; Any other character is Hexadecimal-escaped

   227          :else (.append sb (format "\\u%04x" cp)))))

   228     (.append sb \")

   229     (.print out (str sb))))

   230 

   231 (defn- write-json-object [m ^PrintWriter out] 

   232   (.print out \{)

   233   (loop [x m]

   234     (when (seq m)

   235       (let [[k v] (first x)]

   236         (when (nil? k)

   237           (throw (Exception. "JSON object keys cannot be nil/null")))

   238         (.print out \")

   239         (.print out (as-str k))

   240         (.print out \")

   241         (.print out \:)

   242         (write-json v out))

   243       (let [nxt (next x)]

   244         (when (seq nxt)

   245           (.print out \,)

   246           (recur nxt)))))

   247   (.print out \}))

   248 

   249 (defn- write-json-array [s ^PrintWriter out]

   250   (.print out \[)

   251   (loop [x s]

   252     (when (seq x)

   253       (let [fst (first x)

   254             nxt (next x)]

   255         (write-json fst out)

   256         (when (seq nxt)

   257           (.print out \,)

   258           (recur nxt)))))

   259   (.print out \]))

   260 

   261 (defn- write-json-bignum [x ^PrintWriter out]

   262   (.print out (str x)))

   263 

   264 (defn- write-json-plain [x ^PrintWriter out]

   265   (.print out x))

   266 

   267 (defn- write-json-null [x ^PrintWriter out]

   268   (.print out "null"))

   269 

   270 (defn- write-json-named [x ^PrintWriter out]

   271   (write-json-string (name x) out))

   272 

   273 (defn- write-json-generic [x out]

   274   (if (.isArray (class x))

   275     (write-json (seq x) out)

   276     (throw (Exception. (str "Don't know how to write JSON of " (class x))))))

   277   

   278 (extend nil Write-JSON

   279         {:write-json write-json-null})

   280 (extend clojure.lang.Named Write-JSON

   281         {:write-json write-json-named})

   282 (extend java.lang.Boolean Write-JSON

   283         {:write-json write-json-plain})

   284 (extend java.lang.Number Write-JSON

   285         {:write-json write-json-plain})

   286 (extend java.math.BigInteger Write-JSON

   287         {:write-json write-json-bignum})

   288 (extend java.math.BigDecimal Write-JSON

   289         {:write-json write-json-bignum})

   290 (extend java.lang.CharSequence Write-JSON

   291         {:write-json write-json-string})

   292 (extend java.util.Map Write-JSON

   293         {:write-json write-json-object})

   294 (extend java.util.Collection Write-JSON

   295         {:write-json write-json-array})

   296 (extend clojure.lang.ISeq Write-JSON

   297         {:write-json write-json-array})

   298 (extend java.lang.Object Write-JSON

   299         {:write-json write-json-generic})

   300 

   301 (defn json-str

   302   "Converts x to a JSON-formatted string."

   303   [x]

   304   (let [sw (StringWriter.)

   305         out (PrintWriter. sw)]

   306     (write-json x out)

   307     (.toString sw)))

   308 

   309 (defn print-json

   310   "Write JSON-formatted output to *out*"

   311   [x]

   312   (write-json x *out*))

   313 

   314 

   315 ;;; JSON PRETTY-PRINTER

   316 

   317 ;; Based on code by Tom Faulhaber

   318 

   319 (defn- pprint-json-array [s] 

   320   ((formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>") s))

   321 

   322 (defn- pprint-json-object [m]

   323   ((formatter-out "~<{~;~@{~<~w:~_~w~:>~^, ~_~}~;}~:>") 

   324    (for [[k v] m] [(as-str k) v])))

   325 

   326 (defn- pprint-json-generic [x]

   327   (if (.isArray (class x))

   328     (pprint-json-array (seq x))

   329     (print (json-str x))))

   330   

   331 (defn- pprint-json-dispatch [x]

   332   (cond (nil? x) (print "null")

   333         (instance? java.util.Map x) (pprint-json-object x)

   334         (instance? java.util.Collection x) (pprint-json-array x)

   335         (instance? clojure.lang.ISeq x) (pprint-json-array x)

   336         :else (pprint-json-generic x)))

   337 

   338 (defn pprint-json

   339   "Pretty-prints JSON representation of x to *out*"

   340   [x]

   341   (write x :dispatch pprint-json-dispatch))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children