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