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