;; Copyright 2014-2018 Cognitect. All Rights Reserved.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS-IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
(ns cognitect.transit
(:refer-clojure :exclude [integer? uuid uuid? uri?])
(:require [com.cognitect.transit :as t]
[com.cognitect.transit.types :as ty]
[com.cognitect.transit.eq :as eq])
(:import [goog.math Long]))
;; patch cljs.core/UUID IEquiv
(extend-type UUID
IEquiv
(-equiv [this other]
(cond
(instance? UUID other)
(identical? (.-uuid this) (.-uuid other))
(instance? ty/UUID other)
(identical? (.-uuid this) (.toString other))
:else false)))
(extend-protocol IComparable
UUID
(-compare [this other]
(if (or (instance? UUID other)
(instance? ty/UUID other))
(compare (.toString this) (.toString other))
(throw (js/Error. (str "Cannot compare " this " to " other)))))
ty/UUID
(-compare [this other]
(if (or (instance? UUID other)
(instance? ty/UUID other))
(compare (.toString this) (.toString other))
(throw (js/Error. (str "Cannot compare " this " to " other))))))
(extend-protocol IEquiv
Long
(-equiv [this other]
(.equiv this other))
ty/UUID
(-equiv [this other]
(if (instance? UUID other)
(-equiv other this)
(.equiv this other)))
ty/TaggedValue
(-equiv [this other]
(.equiv this other)))
(extend-protocol IHash
Long
(-hash [this]
(eq/hashCode this))
ty/UUID
(-hash [this]
(hash (.toString this)))
ty/TaggedValue
(-hash [this]
(eq/hashCode this)))
(extend-type ty/UUID
IPrintWithWriter
(-pr-writer [uuid writer _]
(-write writer (str "#uuid \"" (.toString uuid) "\""))))
(defn ^:no-doc opts-merge [a b]
(doseq [k (js-keys b)]
(let [v (aget b k)]
(aset a k v)))
a)
(deftype ^:no-doc MapBuilder []
Object
(init [_ node] (transient {}))
(add [_ m k v node] (assoc! m k v))
(finalize [_ m node] (persistent! m))
(fromArray [_ arr node] (cljs.core/PersistentArrayMap.fromArray arr true true)))
(deftype ^:no-doc VectorBuilder []
Object
(init [_ node] (transient []))
(add [_ v x node] (conj! v x))
(finalize [_ v node] (persistent! v))
(fromArray [_ arr node] (cljs.core/PersistentVector.fromArray arr true)))
(defn reader
"Return a transit reader. type may be either :json or :json-verbose.
opts may be a map optionally containing a :handlers entry. The value
of :handlers should be map from tag to a decoder function which returns
then in-memory representation of the semantic transit value."
([type] (reader type nil))
([type opts]
(t/reader (name type)
(opts-merge
#js {:handlers
(clj->js
(merge
{"$" (fn [v] (symbol v))
":" (fn [v] (keyword v))
"set" (fn [v] (into #{} v))
"list" (fn [v] (into () (.reverse v)))
"cmap" (fn [v]
(loop [i 0 ret (transient {})]
(if (< i (alength v))
(recur (+ i 2)
(assoc! ret (aget v i) (aget v (inc i))))
(persistent! ret))))
"with-meta"
(fn [v] (with-meta (aget v 0) (aget v 1)))}
(:handlers opts)))
:mapBuilder (MapBuilder.)
:arrayBuilder (VectorBuilder.)
:prefersStrings false}
(clj->js (dissoc opts :handlers))))))
(defn read
"Read a transit encoded string into ClojureScript values given a
transit reader."
[r str]
(.read r str))
(deftype ^:no-doc KeywordHandler []
Object
(tag [_ v] ":")
(rep [_ v] (.-fqn v))
(stringRep [_ v] (.-fqn v)))
(deftype ^:no-doc SymbolHandler []
Object
(tag [_ v] "$")
(rep [_ v] (.-str v))
(stringRep [_ v] (.-str v)))
(deftype ^:no-doc ListHandler []
Object
(tag [_ v] "list")
(rep [_ v]
(let [ret #js []]
(doseq [x v] (.push ret x))
(t/tagged "array" ret)))
(stringRep [_ v] nil))
(deftype ^:no-doc MapHandler []
Object
(tag [_ v] "map")
(rep [_ v] v)
(stringRep [_ v] nil))
(deftype ^:no-doc SetHandler []
Object
(tag [_ v] "set")
(rep [_ v]
(let [ret #js []]
(doseq [x v] (.push ret x))
(t/tagged "array" ret)))
(stringRep [v] nil))
(deftype ^:no-doc VectorHandler []
Object
(tag [_ v] "array")
(rep [_ v]
(let [ret #js []]
(doseq [x v] (.push ret x))
ret))
(stringRep [_ v] nil))
(deftype ^:no-doc UUIDHandler []
Object
(tag [_ v] "u")
(rep [_ v] (.-uuid v))
(stringRep [this v] (.rep this v)))
(deftype ^:no-doc WithMeta [value meta])
(deftype ^:no-doc WithMetaHandler []
Object
(tag [_ v] "with-meta")
(rep [_ v]
(t/tagged "array" #js [(.-value v) (.-meta v)]))
(stringRep [_ v] nil))
(defn writer
"Return a transit writer. type maybe either :json or :json-verbose.
opts is a map with the following optional keys:
:handlers - a map of type constructors to handler instances.
:transform - a function of one argument returning a transformed value. Will
be invoked on a value before it is written."
([type] (writer type nil))
([type opts]
(let [keyword-handler (KeywordHandler.)
symbol-handler (SymbolHandler.)
list-handler (ListHandler.)
map-handler (MapHandler.)
set-handler (SetHandler.)
vector-handler (VectorHandler.)
uuid-handler (UUIDHandler.)
meta-handler (WithMetaHandler.)
handlers
(merge
{cljs.core/Keyword keyword-handler
cljs.core/Symbol symbol-handler
cljs.core/Range list-handler
cljs.core/List list-handler
cljs.core/Cons list-handler
cljs.core/EmptyList list-handler
cljs.core/LazySeq list-handler
cljs.core/RSeq list-handler
cljs.core/IndexedSeq list-handler
cljs.core/ChunkedCons list-handler
cljs.core/ChunkedSeq list-handler
cljs.core/PersistentQueueSeq list-handler
cljs.core/PersistentQueue list-handler
cljs.core/PersistentArrayMapSeq list-handler
cljs.core/PersistentTreeMapSeq list-handler
cljs.core/NodeSeq list-handler
cljs.core/ArrayNodeSeq list-handler
cljs.core/KeySeq list-handler
cljs.core/ValSeq list-handler
cljs.core/PersistentArrayMap map-handler
cljs.core/PersistentHashMap map-handler
cljs.core/PersistentTreeMap map-handler
cljs.core/PersistentHashSet set-handler
cljs.core/PersistentTreeSet set-handler
cljs.core/PersistentVector vector-handler
cljs.core/Subvec vector-handler
cljs.core/UUID uuid-handler
WithMeta meta-handler}
(when (exists? cljs.core/Eduction)
{^:cljs.analyzer/no-resolve cljs.core/Eduction list-handler})
(when (exists? cljs.core/Repeat)
{^:cljs.analyzer/no-resolve cljs.core/Repeat list-handler})
(when (exists? cljs.core/MapEntry)
{^:cljs.analyzer/no-resolve cljs.core/MapEntry vector-handler})
(:handlers opts))]
(t/writer (name type)
(opts-merge
#js {:objectBuilder
(fn [m kfn vfn]
(reduce-kv
(fn [obj k v]
(doto obj (.push (kfn k) (vfn v))))
#js ["^ "] m))
:handlers
(specify handlers
Object
(forEach
([coll f]
(doseq [[k v] coll]
(f v k)))))
:unpack
(fn [x]
(if (instance? cljs.core/PersistentArrayMap x)
(.-arr x)
false))}
(clj->js (dissoc opts :handlers)))))))
(defn write
"Encode an object into a transit string given a transit writer."
[w o]
(.write w o))
(defn read-handler
"Construct a read handler. Implemented as identity, exists primarily
for API compatiblity with transit-clj"
[from-rep]
from-rep)
(defn write-handler
"Creates a transit write handler whose tag, rep,
stringRep, and verboseWriteHandler methods
invoke the provided fns."
([tag-fn rep-fn]
(write-handler tag-fn rep-fn nil nil))
([tag-fn rep-fn str-rep-fn]
(write-handler tag-fn rep-fn str-rep-fn nil))
([tag-fn rep-fn str-rep-fn verbose-handler-fn]
(reify
Object
(tag [_ o] (tag-fn o))
(rep [_ o] (rep-fn o))
(stringRep [_ o] (when str-rep-fn (str-rep-fn o)))
(getVerboseHandler [_] (when verbose-handler-fn (verbose-handler-fn))))))
;; =============================================================================
;; Constructors & Predicates
(defn tagged-value
"Construct a tagged value. tag must be a string and rep can
be any transit encodeable value."
[tag rep]
(ty/taggedValue tag rep))
(defn tagged-value?
"Returns true if x is a transit tagged value, false otherwise."
[x]
(ty/isTaggedValue x))
(defn integer
"Construct a transit integer value. Returns JavaScript number if
in the 53bit integer range, a goog.math.Long instance if above. s
may be a string or a JavaScript number."
[s]
(ty/intValue s))
(defn integer?
"Returns true if x is an integer value between the 53bit and 64bit
range, false otherwise."
[x]
(ty/isInteger x))
(defn bigint
"Construct a big integer from a string."
[s]
(ty/bigInteger s))
(defn bigint?
"Returns true if x is a transit big integer value, false otherwise."
[x]
(ty/isBigInteger x))
(defn bigdec
"Construct a big decimal from a string."
[s]
(ty/bigDecimalValue s))
(defn bigdec?
"Returns true if x is a transit big decimal value, false otherwise."
[x]
(ty/isBigDecimal x))
(defn uri
"Construct a URI from a string."
[s]
(ty/uri s))
(defn uri?
"Returns true if x is a transit URI value, false otherwise."
[x]
(ty/isURI x))
(defn uuid
"Construct a UUID from a string."
[s]
(ty/uuid s))
(defn uuid?
"Returns true if x is a transit UUID value, false otherwise."
[x]
(or (ty/isUUID x) (instance? UUID x)))
(defn binary
"Construct a transit binary value. s should be base64 encoded
string."
[s]
(ty/binary s))
(defn binary?
"Returns true if x is a transit binary value, false otherwise."
[x]
(ty/isBinary x))
(defn quoted
"Construct a quoted transit value. x should be a transit
encodeable value."
[x]
(ty/quoted x))
(defn quoted?
"Returns true if x is a transit quoted value, false otherwise."
[x]
(ty/isQuoted x))
(defn link
"Construct a transit link value. x should be an IMap instance
containing at a minimum the following keys: :href, :rel. It
may optionall include :name, :render, and :prompt. :href must
be a transit URI, all other values are strings, and :render must
be either :image or :link."
[x]
(ty/link x))
(defn link?
"Returns true if x a transit link value, false if otherwise."
[x]
(ty/isLink x))
(defn write-meta
"For :transform. Will write any metadata present on the value."
[x]
(if (implements? IMeta x)
(let [m (-meta ^not-native x)]
(if-not (nil? m)
(WithMeta. (-with-meta ^not-native x nil) m)
x))
x))