215 lines
7 KiB
Clojure
215 lines
7 KiB
Clojure
; 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-macros [cljs.reader :refer [add-data-readers]])
|
|
(:require [goog.object :as gobject]
|
|
[cljs.tools.reader :as treader]
|
|
[cljs.tools.reader.edn :as edn])
|
|
(:import [goog.string StringBuffer]))
|
|
|
|
(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)
|
|
(throw (js/Error. (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
|
|
(throw (js/Error. (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)))
|
|
(throw (js/Error. (str "Unrecognized date/time syntax: " ts)))))
|
|
|
|
(defn ^:private read-date
|
|
[s]
|
|
(if (string? s)
|
|
(parse-timestamp s)
|
|
(throw (js/Error. "Instance literal expects a string for its timestamp."))))
|
|
|
|
(defn ^:private read-queue
|
|
[elems]
|
|
(if (vector? elems)
|
|
(into cljs.core/PersistentQueue.EMPTY elems)
|
|
(throw (js/Error. "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]
|
|
(gobject/set obj (name k) v))
|
|
obj)
|
|
|
|
:else
|
|
(throw
|
|
(js/Error.
|
|
(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)
|
|
(throw (js/Error. "UUID literal expects a string as its representation."))))
|
|
|
|
(def ^:dynamic *default-data-reader-fn*
|
|
(atom nil))
|
|
|
|
(def ^:dynamic *tag-table*
|
|
(atom
|
|
(add-data-readers
|
|
{'inst read-date
|
|
'uuid read-uuid
|
|
'queue read-queue
|
|
'js read-js})))
|
|
|
|
(defn read
|
|
"Reads the first object from an cljs.tools.reader.reader-types/IPushbackReader.
|
|
Returns the object read. If EOF, throws if eof-error? is true otherwise returns eof.
|
|
If no reader is provided, *in* will be used.
|
|
|
|
Reads data in the edn format (subset of Clojure data):
|
|
http://edn-format.org
|
|
|
|
cljs.tools.reader.edn/read doesn't depend on dynamic Vars, all configuration
|
|
is done by passing an opt map.
|
|
|
|
opts is a map that can include the following keys:
|
|
:eof - value to return on end-of-file. When not supplied, eof throws an exception.
|
|
:readers - a map of tag symbols to data-reader functions to be considered before default-data-readers.
|
|
When not supplied, only the default-data-readers will be used.
|
|
:default - A function of two args, that will, if present and no reader is found for a tag,
|
|
be called with the tag and the value."
|
|
([reader]
|
|
(edn/read
|
|
{:readers @*tag-table*
|
|
:default @*default-data-reader-fn*
|
|
:eof nil}
|
|
reader))
|
|
([{:keys [eof] :as opts} reader]
|
|
(edn/read
|
|
(update (merge opts {:default @*default-data-reader-fn*})
|
|
:readers (fn [m] (merge @*tag-table* m))) reader))
|
|
([reader eof-error? eof opts]
|
|
(edn/read reader eof-error? eof
|
|
(update (merge opts {:default @*default-data-reader-fn*})
|
|
:readers (fn [m] (merge @*tag-table* m))))))
|
|
|
|
(defn read-string
|
|
"Reads one object from the string s.
|
|
Returns nil when s is nil or empty.
|
|
|
|
Reads data in the edn format (subset of Clojure data):
|
|
http://edn-format.org
|
|
|
|
opts is a map as per cljs.tools.reader.edn/read"
|
|
([s]
|
|
(edn/read-string
|
|
{:readers @*tag-table*
|
|
:default @*default-data-reader-fn*
|
|
:eof nil} s))
|
|
([opts s]
|
|
(edn/read-string
|
|
(update (merge {:default @*default-data-reader-fn*} opts)
|
|
:readers (fn [m] (merge @*tag-table* m))) s)))
|
|
|
|
(defn register-tag-parser!
|
|
[tag f]
|
|
(let [old-parser (get @*tag-table* tag)]
|
|
(swap! *tag-table* assoc tag f)
|
|
old-parser))
|
|
|
|
(defn deregister-tag-parser!
|
|
[tag]
|
|
(let [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))
|