Added compiled JavaScript to repository for GitHub pages
This feels like a mistake...
This commit is contained in:
parent
3d5a2fb322
commit
dc226b1f25
468 changed files with 212152 additions and 2 deletions
641
resources/public/js/compiled/out/cljs/reader.cljs
Normal file
641
resources/public/js/compiled/out/cljs/reader.cljs
Normal file
|
|
@ -0,0 +1,641 @@
|
|||
; Copyright (c) Rich Hickey. All rights reserved.
|
||||
; The use and distribution terms for this software are covered by the
|
||||
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
||||
; which can be found in the file epl-v10.html at the root of this distribution.
|
||||
; By using this software in any fashion, you are agreeing to be bound by
|
||||
; the terms of this license.
|
||||
; You must not remove this notice, or any other, from this software.
|
||||
|
||||
(ns cljs.reader
|
||||
(:require [goog.string :as gstring])
|
||||
(:import goog.string.StringBuffer))
|
||||
|
||||
(defprotocol PushbackReader
|
||||
(read-char [reader] "Returns the next char from the Reader,
|
||||
nil if the end of stream has been reached")
|
||||
(unread [reader ch] "Push back a single character on to the stream"))
|
||||
|
||||
(deftype StringPushbackReader [s buffer ^:mutable idx]
|
||||
PushbackReader
|
||||
(read-char [reader]
|
||||
(if (zero? (alength buffer))
|
||||
(do
|
||||
(set! idx (inc idx))
|
||||
(aget s idx))
|
||||
(.pop buffer)))
|
||||
(unread [reader ch]
|
||||
(.push buffer ch)))
|
||||
|
||||
(defn push-back-reader [s]
|
||||
"Creates a StringPushbackReader from a given string"
|
||||
(StringPushbackReader. s (array) -1))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; predicates
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn- ^boolean whitespace?
|
||||
"Checks whether a given character is whitespace"
|
||||
[ch]
|
||||
(or (gstring/isBreakingWhitespace ch) (identical? \, ch)))
|
||||
|
||||
(defn- ^boolean numeric?
|
||||
"Checks whether a given character is numeric"
|
||||
[ch]
|
||||
(gstring/isNumeric ch))
|
||||
|
||||
(defn- ^boolean comment-prefix?
|
||||
"Checks whether the character begins a comment."
|
||||
[ch]
|
||||
(identical? \; ch))
|
||||
|
||||
(defn- ^boolean number-literal?
|
||||
"Checks whether the reader is at the start of a number literal"
|
||||
[reader initch]
|
||||
(or (numeric? initch)
|
||||
(and (or (identical? \+ initch) (identical? \- initch))
|
||||
(numeric? (let [next-ch (read-char reader)]
|
||||
(unread reader next-ch)
|
||||
next-ch)))))
|
||||
|
||||
(declare read macros dispatch-macros)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; read helpers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
; later will do e.g. line numbers...
|
||||
(defn reader-error
|
||||
[rdr & msg]
|
||||
(throw (js/Error. (apply str msg))))
|
||||
|
||||
(defn ^boolean macro-terminating? [ch]
|
||||
(and (not (identical? ch "#"))
|
||||
(not (identical? ch \'))
|
||||
(not (identical? ch ":"))
|
||||
(macros ch)))
|
||||
|
||||
(defn read-token
|
||||
[rdr initch]
|
||||
(loop [sb (StringBuffer. initch)
|
||||
ch (read-char rdr)]
|
||||
(if (or (nil? ch)
|
||||
(whitespace? ch)
|
||||
(macro-terminating? ch))
|
||||
(do (unread rdr ch) (.toString sb))
|
||||
(recur (do (.append sb ch) sb) (read-char rdr)))))
|
||||
|
||||
(defn skip-line
|
||||
"Advances the reader to the end of a line. Returns the reader"
|
||||
[reader _]
|
||||
(loop []
|
||||
(let [ch (read-char reader)]
|
||||
(if (or (identical? ch \newline) (identical? ch \return) (nil? ch))
|
||||
reader
|
||||
(recur)))))
|
||||
|
||||
(def int-pattern (re-pattern "^([-+]?)(?:(0)|([1-9][0-9]*)|0[xX]([0-9A-Fa-f]+)|0([0-7]+)|([1-9][0-9]?)[rR]([0-9A-Za-z]+))(N)?$"))
|
||||
(def ratio-pattern (re-pattern "^([-+]?[0-9]+)/([0-9]+)$"))
|
||||
(def float-pattern (re-pattern "^([-+]?[0-9]+(\\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?$"))
|
||||
(def symbol-pattern (re-pattern "^[:]?([^0-9/].*/)?([^0-9/][^/]*)$"))
|
||||
|
||||
(defn- re-matches*
|
||||
[re s]
|
||||
(let [matches (.exec re s)]
|
||||
(when (and (not (nil? matches))
|
||||
(identical? (aget matches 0) s))
|
||||
(if (== (alength matches) 1)
|
||||
(aget matches 0)
|
||||
matches))))
|
||||
|
||||
(defn- match-int
|
||||
[s]
|
||||
(let [groups (re-matches* int-pattern s)
|
||||
ie8-fix (aget groups 2)
|
||||
zero (if (= ie8-fix "") nil ie8-fix)]
|
||||
(if-not (nil? zero)
|
||||
0
|
||||
(let [a (cond
|
||||
(aget groups 3) (array (aget groups 3) 10)
|
||||
(aget groups 4) (array (aget groups 4) 16)
|
||||
(aget groups 5) (array (aget groups 5) 8)
|
||||
(aget groups 6) (array (aget groups 7)
|
||||
(js/parseInt (aget groups 6) 10))
|
||||
:else (array nil nil))
|
||||
n (aget a 0)
|
||||
radix (aget a 1)]
|
||||
(when-not (nil? n)
|
||||
(let [parsed (js/parseInt n radix)]
|
||||
(if (identical? "-" (aget groups 1))
|
||||
(- parsed)
|
||||
parsed)))))))
|
||||
|
||||
(defn- match-ratio
|
||||
[s]
|
||||
(let [groups (re-matches* ratio-pattern s)
|
||||
numinator (aget groups 1)
|
||||
denominator (aget groups 2)]
|
||||
(/ (js/parseInt numinator 10) (js/parseInt denominator 10))))
|
||||
|
||||
(defn- match-float
|
||||
[s]
|
||||
(js/parseFloat s))
|
||||
|
||||
(defn- match-number
|
||||
[s]
|
||||
(cond
|
||||
(re-matches* int-pattern s) (match-int s)
|
||||
(re-matches* ratio-pattern s) (match-ratio s)
|
||||
(re-matches* float-pattern s) (match-float s)))
|
||||
|
||||
(defn escape-char-map [c]
|
||||
(cond
|
||||
(identical? c \t) "\t"
|
||||
(identical? c \r) "\r"
|
||||
(identical? c \n) "\n"
|
||||
(identical? c \\) \\
|
||||
(identical? c \") \"
|
||||
(identical? c \b) "\b"
|
||||
(identical? c \f) "\f"
|
||||
:else nil))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; unicode
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn read-2-chars [reader]
|
||||
(.toString
|
||||
(StringBuffer.
|
||||
(read-char reader)
|
||||
(read-char reader))))
|
||||
|
||||
(defn read-4-chars [reader]
|
||||
(.toString
|
||||
(StringBuffer.
|
||||
(read-char reader)
|
||||
(read-char reader)
|
||||
(read-char reader)
|
||||
(read-char reader))))
|
||||
|
||||
(def unicode-2-pattern (re-pattern "^[0-9A-Fa-f]{2}$"))
|
||||
(def unicode-4-pattern (re-pattern "^[0-9A-Fa-f]{4}$"))
|
||||
|
||||
(defn validate-unicode-escape [unicode-pattern reader escape-char unicode-str]
|
||||
(if (re-matches unicode-pattern unicode-str)
|
||||
unicode-str
|
||||
(reader-error reader "Unexpected unicode escape \\" escape-char unicode-str)))
|
||||
|
||||
(defn make-unicode-char [code-str]
|
||||
(let [code (js/parseInt code-str 16)]
|
||||
(.fromCharCode js/String code)))
|
||||
|
||||
(defn escape-char
|
||||
[buffer reader]
|
||||
(let [ch (read-char reader)
|
||||
mapresult (escape-char-map ch)]
|
||||
(if mapresult
|
||||
mapresult
|
||||
(cond
|
||||
(identical? ch \x)
|
||||
(->> (read-2-chars reader)
|
||||
(validate-unicode-escape unicode-2-pattern reader ch)
|
||||
(make-unicode-char))
|
||||
|
||||
(identical? ch \u)
|
||||
(->> (read-4-chars reader)
|
||||
(validate-unicode-escape unicode-4-pattern reader ch)
|
||||
(make-unicode-char))
|
||||
|
||||
(numeric? ch)
|
||||
(.fromCharCode js/String ch)
|
||||
|
||||
:else
|
||||
(reader-error reader "Unexpected unicode escape \\" ch )))))
|
||||
|
||||
(defn read-past
|
||||
"Read until first character that doesn't match pred, returning
|
||||
char."
|
||||
[pred rdr]
|
||||
(loop [ch (read-char rdr)]
|
||||
(if (pred ch)
|
||||
(recur (read-char rdr))
|
||||
ch)))
|
||||
|
||||
(defn read-delimited-list
|
||||
[delim rdr recursive?]
|
||||
(loop [a (array)]
|
||||
(let [ch (read-past whitespace? rdr)]
|
||||
(when-not ch (reader-error rdr "EOF while reading"))
|
||||
(if (identical? delim ch)
|
||||
a
|
||||
(if-let [macrofn (macros ch)]
|
||||
(let [mret (macrofn rdr ch)]
|
||||
(recur (if (identical? mret rdr) a (do
|
||||
(.push a mret)
|
||||
a))))
|
||||
(do
|
||||
(unread rdr ch)
|
||||
(let [o (read rdr true nil recursive?)]
|
||||
(recur (if (identical? o rdr) a (do
|
||||
(.push a o)
|
||||
a))))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; data structure readers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn not-implemented
|
||||
[rdr ch]
|
||||
(reader-error rdr "Reader for " ch " not implemented yet"))
|
||||
|
||||
(declare maybe-read-tagged-type)
|
||||
|
||||
(defn read-dispatch
|
||||
[rdr _]
|
||||
(let [ch (read-char rdr)
|
||||
dm (dispatch-macros ch)]
|
||||
(if dm
|
||||
(dm rdr _)
|
||||
(if-let [obj (maybe-read-tagged-type rdr ch)]
|
||||
obj
|
||||
(reader-error rdr "No dispatch macro for " ch)))))
|
||||
|
||||
(defn read-unmatched-delimiter
|
||||
[rdr ch]
|
||||
(reader-error rdr "Unmatched delimiter " ch))
|
||||
|
||||
(defn read-list
|
||||
[rdr _]
|
||||
(let [arr (read-delimited-list ")" rdr true)]
|
||||
(loop [i (alength arr) ^not-native r ()]
|
||||
(if (> i 0)
|
||||
(recur (dec i) (-conj r (aget arr (dec i))))
|
||||
r))))
|
||||
|
||||
(def read-comment skip-line)
|
||||
|
||||
(defn read-vector
|
||||
[rdr _]
|
||||
(vec (read-delimited-list "]" rdr true)))
|
||||
|
||||
(defn read-map
|
||||
[rdr _]
|
||||
(let [l (read-delimited-list "}" rdr true)
|
||||
c (alength l)]
|
||||
(when (odd? c)
|
||||
(reader-error rdr "Map literal must contain an even number of forms"))
|
||||
(if (<= c (* 2 (.-HASHMAP-THRESHOLD PersistentArrayMap)))
|
||||
(.fromArray PersistentArrayMap l true true)
|
||||
(.fromArray PersistentHashMap l true))))
|
||||
|
||||
(defn read-number
|
||||
[reader initch]
|
||||
(loop [buffer (gstring/StringBuffer. initch)
|
||||
ch (read-char reader)]
|
||||
(if (or (nil? ch) (whitespace? ch) (macros ch))
|
||||
(do
|
||||
(unread reader ch)
|
||||
(let [s (.toString buffer)]
|
||||
(or (match-number s)
|
||||
(reader-error reader "Invalid number format [" s "]"))))
|
||||
(recur (do (.append buffer ch) buffer) (read-char reader)))))
|
||||
|
||||
(defn read-string*
|
||||
[reader _]
|
||||
(loop [buffer (gstring/StringBuffer.)
|
||||
ch (read-char reader)]
|
||||
(cond
|
||||
(nil? ch) (reader-error reader "EOF while reading")
|
||||
(identical? "\\" ch) (recur (do (.append buffer (escape-char buffer reader)) buffer)
|
||||
(read-char reader))
|
||||
(identical? \" ch) (. buffer (toString))
|
||||
:default (recur (do (.append buffer ch) buffer) (read-char reader)))))
|
||||
|
||||
(defn read-raw-string*
|
||||
[reader _]
|
||||
(loop [buffer (gstring/StringBuffer.)
|
||||
ch (read-char reader)]
|
||||
(cond
|
||||
(nil? ch) (reader-error reader "EOF while reading")
|
||||
(identical? "\\" ch) (do (.append buffer ch)
|
||||
(let [nch (read-char reader)]
|
||||
(if (nil? nch)
|
||||
(reader-error reader "EOF while reading")
|
||||
(recur (doto buffer (.append nch))
|
||||
(read-char reader)))))
|
||||
(identical? "\"" ch) (.toString buffer)
|
||||
:else (recur (doto buffer (.append ch)) (read-char reader)))))
|
||||
|
||||
(defn special-symbols [t not-found]
|
||||
(cond
|
||||
(identical? t "nil") nil
|
||||
(identical? t "true") true
|
||||
(identical? t "false") false
|
||||
(identical? t "/") '/
|
||||
:else not-found))
|
||||
|
||||
(defn read-symbol
|
||||
[reader initch]
|
||||
(let [token (read-token reader initch)]
|
||||
(if (and (gstring/contains token "/")
|
||||
(not (== (.-length token) 1)))
|
||||
(symbol (subs token 0 (.indexOf token "/"))
|
||||
(subs token (inc (.indexOf token "/"))
|
||||
(.-length token)))
|
||||
(special-symbols token (symbol token)))))
|
||||
|
||||
(defn read-literal
|
||||
[rdr ch]
|
||||
(let [token (read-token rdr ch)
|
||||
chars (subs token 1)]
|
||||
(cond (identical? (.-length chars) 1) chars
|
||||
(identical? chars "tab") "\t"
|
||||
(identical? chars "return") "\r"
|
||||
(identical? chars "newline") "\n"
|
||||
(identical? chars "space") " "
|
||||
(identical? chars "backspace") "\b"
|
||||
(identical? chars "formfeed") "\f"
|
||||
(identical? (.charAt chars 0) "u") (make-unicode-char (subs chars 1))
|
||||
(identical? (.charAt chars 0) "o") (not-implemented rdr token)
|
||||
:else (reader-error rdr "Unknown character literal: " token))))
|
||||
|
||||
(defn read-keyword
|
||||
[reader initch]
|
||||
(let [token (read-token reader (read-char reader))
|
||||
a (re-matches* symbol-pattern token)
|
||||
token (aget a 0)
|
||||
ns (aget a 1)
|
||||
name (aget a 2)]
|
||||
(if (or (and (not (undefined? ns))
|
||||
(identical? (. ns (substring (- (.-length ns) 2) (.-length ns))) ":/"))
|
||||
(identical? (aget name (dec (.-length name))) ":")
|
||||
(not (== (.indexOf token "::" 1) -1)))
|
||||
(reader-error reader "Invalid token: " token)
|
||||
(if (and (not (nil? ns)) (> (.-length ns) 0))
|
||||
(keyword (.substring ns 0 (.indexOf ns "/")) name)
|
||||
(keyword token)))))
|
||||
|
||||
(defn desugar-meta
|
||||
[f]
|
||||
(cond
|
||||
(symbol? f) {:tag f}
|
||||
(string? f) {:tag f}
|
||||
(keyword? f) {f true}
|
||||
:else f))
|
||||
|
||||
(defn wrapping-reader
|
||||
[sym]
|
||||
(fn [rdr _]
|
||||
(list sym (read rdr true nil true))))
|
||||
|
||||
(defn throwing-reader
|
||||
[msg]
|
||||
(fn [rdr _]
|
||||
(reader-error rdr msg)))
|
||||
|
||||
(defn read-meta
|
||||
[rdr _]
|
||||
(let [m (desugar-meta (read rdr true nil true))]
|
||||
(when-not (map? m)
|
||||
(reader-error rdr "Metadata must be Symbol,Keyword,String or Map"))
|
||||
(let [o (read rdr true nil true)]
|
||||
(if (satisfies? IWithMeta o)
|
||||
(with-meta o (merge (meta o) m))
|
||||
(reader-error rdr "Metadata can only be applied to IWithMetas")))))
|
||||
|
||||
(defn read-set
|
||||
[rdr _]
|
||||
(.fromArray PersistentHashSet (read-delimited-list "}" rdr true) true))
|
||||
|
||||
(defn read-regex
|
||||
[rdr ch]
|
||||
(-> (read-raw-string* rdr ch) re-pattern))
|
||||
|
||||
(defn read-discard
|
||||
[rdr _]
|
||||
(read rdr true nil true)
|
||||
rdr)
|
||||
|
||||
(defn macros [c]
|
||||
(cond
|
||||
(identical? c \") read-string*
|
||||
(identical? c \:) read-keyword
|
||||
(identical? c \;) read-comment
|
||||
(identical? c \') (wrapping-reader 'quote)
|
||||
(identical? c \@) (wrapping-reader 'deref)
|
||||
(identical? c \^) read-meta
|
||||
(identical? c \`) not-implemented
|
||||
(identical? c \~) not-implemented
|
||||
(identical? c \() read-list
|
||||
(identical? c \)) read-unmatched-delimiter
|
||||
(identical? c \[) read-vector
|
||||
(identical? c \]) read-unmatched-delimiter
|
||||
(identical? c \{) read-map
|
||||
(identical? c \}) read-unmatched-delimiter
|
||||
(identical? c \\) read-literal
|
||||
(identical? c \#) read-dispatch
|
||||
:else nil))
|
||||
|
||||
;; omitted by design: var reader, eval reader
|
||||
(defn dispatch-macros [s]
|
||||
(cond
|
||||
(identical? s "{") read-set
|
||||
(identical? s "<") (throwing-reader "Unreadable form")
|
||||
(identical? s "\"") read-regex
|
||||
(identical? s"!") read-comment
|
||||
(identical? s "_") read-discard
|
||||
:else nil))
|
||||
|
||||
(defn read
|
||||
"Reads the first object from a PushbackReader. Returns the object read.
|
||||
If EOF, throws if eof-is-error is true. Otherwise returns sentinel.
|
||||
|
||||
Only supports edn (similar to clojure.edn/read)"
|
||||
[reader eof-is-error sentinel is-recursive]
|
||||
(let [ch (read-char reader)]
|
||||
(cond
|
||||
(nil? ch) (if eof-is-error (reader-error reader "EOF while reading") sentinel)
|
||||
(whitespace? ch) (recur reader eof-is-error sentinel is-recursive)
|
||||
(comment-prefix? ch) (recur (read-comment reader ch) eof-is-error sentinel is-recursive)
|
||||
:else (let [f (macros ch)
|
||||
res
|
||||
(cond
|
||||
f (f reader ch)
|
||||
(number-literal? reader ch) (read-number reader ch)
|
||||
:else (read-symbol reader ch))]
|
||||
(if (identical? res reader)
|
||||
(recur reader eof-is-error sentinel is-recursive)
|
||||
res)))))
|
||||
|
||||
(defn read-string
|
||||
"Reads one object from the string s"
|
||||
[s]
|
||||
(when-not (string? s)
|
||||
(throw (js/Error. "Cannot read from non-string object.")))
|
||||
(let [r (push-back-reader s)]
|
||||
(read r false nil false)))
|
||||
|
||||
;; read instances
|
||||
|
||||
(defn ^:private zero-fill-right-and-truncate [s width]
|
||||
(cond (= width (count s)) s
|
||||
(< width (count s)) (subs s 0 width)
|
||||
:else (loop [b (StringBuffer. s)]
|
||||
(if (< (.getLength b) width)
|
||||
(recur (.append b "0"))
|
||||
(.toString b)))))
|
||||
|
||||
(defn ^:private divisible?
|
||||
[num div]
|
||||
(zero? (mod num div)))
|
||||
|
||||
(defn ^:private indivisible?
|
||||
[num div]
|
||||
(not (divisible? num div)))
|
||||
|
||||
(defn ^:private leap-year?
|
||||
[year]
|
||||
(and (divisible? year 4)
|
||||
(or (indivisible? year 100)
|
||||
(divisible? year 400))))
|
||||
|
||||
(def ^:private days-in-month
|
||||
(let [dim-norm [nil 31 28 31 30 31 30 31 31 30 31 30 31]
|
||||
dim-leap [nil 31 29 31 30 31 30 31 31 30 31 30 31]]
|
||||
(fn [month leap-year?]
|
||||
(get (if leap-year? dim-leap dim-norm) month))))
|
||||
|
||||
(def ^:private timestamp-regex #"(\d\d\d\d)(?:-(\d\d)(?:-(\d\d)(?:[T](\d\d)(?::(\d\d)(?::(\d\d)(?:[.](\d+))?)?)?)?)?)?(?:[Z]|([-+])(\d\d):(\d\d))?")
|
||||
|
||||
(defn ^:private parse-int [s]
|
||||
(let [n (js/parseInt s 10)]
|
||||
(if-not (js/isNaN n)
|
||||
n)))
|
||||
|
||||
(defn ^:private check [low n high msg]
|
||||
(when-not (<= low n high)
|
||||
(reader-error nil (str msg " Failed: " low "<=" n "<=" high)))
|
||||
n)
|
||||
|
||||
(defn parse-and-validate-timestamp [s]
|
||||
(let [[_ years months days hours minutes seconds fraction offset-sign offset-hours offset-minutes :as v]
|
||||
(re-matches timestamp-regex s)]
|
||||
(if-not v
|
||||
(reader-error nil (str "Unrecognized date/time syntax: " s))
|
||||
(let [years (parse-int years)
|
||||
months (or (parse-int months) 1)
|
||||
days (or (parse-int days) 1)
|
||||
hours (or (parse-int hours) 0)
|
||||
minutes (or (parse-int minutes) 0)
|
||||
seconds (or (parse-int seconds) 0)
|
||||
fraction (or (parse-int (zero-fill-right-and-truncate fraction 3)) 0)
|
||||
offset-sign (if (= offset-sign "-") -1 1)
|
||||
offset-hours (or (parse-int offset-hours) 0)
|
||||
offset-minutes (or (parse-int offset-minutes) 0)
|
||||
offset (* offset-sign (+ (* offset-hours 60) offset-minutes))]
|
||||
[years
|
||||
(check 1 months 12 "timestamp month field must be in range 1..12")
|
||||
(check 1 days (days-in-month months (leap-year? years)) "timestamp day field must be in range 1..last day in month")
|
||||
(check 0 hours 23 "timestamp hour field must be in range 0..23")
|
||||
(check 0 minutes 59 "timestamp minute field must be in range 0..59")
|
||||
(check 0 seconds (if (= minutes 59) 60 59) "timestamp second field must be in range 0..60")
|
||||
(check 0 fraction 999 "timestamp millisecond field must be in range 0..999")
|
||||
offset]))))
|
||||
|
||||
(defn parse-timestamp
|
||||
[ts]
|
||||
(if-let [[years months days hours minutes seconds ms offset]
|
||||
(parse-and-validate-timestamp ts)]
|
||||
(js/Date.
|
||||
(- (.UTC js/Date years (dec months) days hours minutes seconds ms)
|
||||
(* offset 60 1000)))
|
||||
(reader-error nil (str "Unrecognized date/time syntax: " ts))))
|
||||
|
||||
(defn ^:private read-date
|
||||
[s]
|
||||
(if (string? s)
|
||||
(parse-timestamp s)
|
||||
(reader-error nil "Instance literal expects a string for its timestamp.")))
|
||||
|
||||
|
||||
(defn ^:private read-queue
|
||||
[elems]
|
||||
(if (vector? elems)
|
||||
(into cljs.core.PersistentQueue.EMPTY elems)
|
||||
(reader-error nil "Queue literal expects a vector for its elements.")))
|
||||
|
||||
|
||||
(defn ^:private read-js
|
||||
[form]
|
||||
(cond
|
||||
(vector? form)
|
||||
(let [arr (array)]
|
||||
(doseq [x form]
|
||||
(.push arr x))
|
||||
arr)
|
||||
|
||||
(map? form)
|
||||
(let [obj (js-obj)]
|
||||
(doseq [[k v] form]
|
||||
(aset obj (name k) v))
|
||||
obj)
|
||||
|
||||
:else
|
||||
(reader-error nil
|
||||
(str "JS literal expects a vector or map containing "
|
||||
"only string or unqualified keyword keys"))))
|
||||
|
||||
|
||||
(defn ^:private read-uuid
|
||||
[uuid]
|
||||
(if (string? uuid)
|
||||
(cljs.core/uuid uuid)
|
||||
(reader-error nil "UUID literal expects a string as its representation.")))
|
||||
|
||||
(def ^:dynamic *tag-table*
|
||||
(atom {"inst" read-date
|
||||
"uuid" read-uuid
|
||||
"queue" read-queue
|
||||
"js" read-js}))
|
||||
|
||||
(def ^:dynamic *default-data-reader-fn*
|
||||
(atom nil))
|
||||
|
||||
(defn maybe-read-tagged-type
|
||||
[rdr initch]
|
||||
(let [tag (read-symbol rdr initch)
|
||||
pfn (get @*tag-table* (str tag))
|
||||
dfn @*default-data-reader-fn*]
|
||||
(cond
|
||||
pfn (pfn (read rdr true nil false))
|
||||
dfn (dfn tag (read rdr true nil false))
|
||||
:else (reader-error rdr
|
||||
"Could not find tag parser for " (str tag)
|
||||
" in " (pr-str (keys @*tag-table*))))))
|
||||
|
||||
(defn register-tag-parser!
|
||||
[tag f]
|
||||
(let [tag (str tag)
|
||||
old-parser (get @*tag-table* tag)]
|
||||
(swap! *tag-table* assoc tag f)
|
||||
old-parser))
|
||||
|
||||
(defn deregister-tag-parser!
|
||||
[tag]
|
||||
(let [tag (str tag)
|
||||
old-parser (get @*tag-table* tag)]
|
||||
(swap! *tag-table* dissoc tag)
|
||||
old-parser))
|
||||
|
||||
(defn register-default-tag-parser!
|
||||
[f]
|
||||
(let [old-parser @*default-data-reader-fn*]
|
||||
(swap! *default-data-reader-fn* (fn [_] f))
|
||||
old-parser))
|
||||
|
||||
(defn deregister-default-tag-parser!
|
||||
[]
|
||||
(let [old-parser @*default-data-reader-fn*]
|
||||
(swap! *default-data-reader-fn* (fn [_] nil))
|
||||
old-parser))
|
||||
Loading…
Add table
Add a link
Reference in a new issue