413 lines
12 KiB
Clojure
413 lines
12 KiB
Clojure
;; 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)) |