diff --git a/bench/datascript/bench/bench.cljc b/bench/datascript/bench/bench.cljc index 290cf236..8ed7e246 100644 --- a/bench/datascript/bench/bench.cljc +++ b/bench/datascript/bench/bench.cljc @@ -1,6 +1,6 @@ (ns datascript.bench.bench (:require - #?(:clj [clj-async-profiler.core :as clj-async-profiler])) + #?(:cljd nil :clj [clj-async-profiler.core :as clj-async-profiler])) #?(:cljs (:require-macros datascript.bench.bench))) ; Measure time @@ -12,7 +12,8 @@ (def ^:dynamic *profile* false) #?(:cljs (defn ^number now [] (js/performance.now)) - :clj (defn now ^double [] (/ (System/nanoTime) 1000000.0))) + :cljd (defn now [] (/ (.-microsecondsSinceEpoch (DateTime/now)) 1000.0)) + :clj (defn now ^double [] (/ (System/nanoTime) 1000000.0))) #?(:clj (defmacro dotime @@ -27,15 +28,13 @@ (recur (+ *batch* iterations#)) (double (/ (- now# start-t#) iterations#)))))))) -(defn- if-cljs [env then else] - (if (:ns env) then else)) - (defn median [xs] (nth (sort xs) (quot (count xs) 2))) (defn to-fixed [n places] #?(:cljs (.toFixed n places) - :clj (String/format java.util.Locale/ROOT (str "%." places "f") (to-array [(double n)])))) + :cljd (.toStringAsFixed (double n) places) + :clj (String/format java.util.Locale/ROOT (str "%." places "f") (to-array [(double n)])))) (defn round [n] (cond @@ -60,13 +59,22 @@ (let [[title body] (if (string? title) [title body] ["unknown-bench" (cons title body)])] - (if-cljs &env + (cond + #?(:cljd/clj-host true :default false) + `(let [_# (dart/await (dotime *warmup-ms* ~@body)) + times# (loop [i# (int 0) acc# []] + (if (< i# *samples*) + (recur (inc i#) (conj acc# (dart/await (dotime *bench-ms* ~@body)))) + acc#))] + {:mean-ms (median times#)}) + (:ns &env) `(let [_# (dotime *warmup-ms* ~@body) times# (mapv (fn [_#] (dotime *bench-ms* ~@body)) (range *samples*))] {:mean-ms (median times#)}) + :else `(let [_# (dotime *warmup-ms* ~@body) _# (when *profile* (clj-async-profiler/start {})) times# (mapv @@ -115,7 +123,7 @@ └ 15" [id depth width] (if (pos? depth) - (let [children (map #(+ (* id width) %) (range width))] + (let [children (mapv #(+ (* id width) %) (range width))] (cons (assoc (random-man) :db/id (str id) diff --git a/bench/datascript/bench/datascript.cljc b/bench/datascript/bench/datascript.cljc index e1e54307..8cc73579 100644 --- a/bench/datascript/bench/datascript.cljc +++ b/bench/datascript/bench/datascript.cljc @@ -2,7 +2,10 @@ (:require [datascript.core :as d] [datascript.bench.bench :as bench] - #?(:clj [jsonista.core :as jsonista]))) + #?@(:cljd [["dart:convert" :as dart:convert] + [datascript.db :as ddb] + [me.tonsky.persistent-sorted-set.async :as async-set]] + :clj [[jsonista.core :as jsonista]]))) #?(:cljs (enable-console-print!)) @@ -54,7 +57,7 @@ (defn bench-init [] (let [datoms (into [] (for [p @bench/*people20k - :let [id (#?(:clj Integer/parseInt :cljs js/parseInt) (:db/id p))] + :let [id (#?(:clj Integer/parseInt :cljs js/parseInt :cljd int/parse) (:db/id p))] [k v] p :when (not= k :db/id)] (d/datom id k v)))] @@ -219,59 +222,133 @@ (com.fasterxml.jackson.databind.ObjectMapper.))) (defn bench-freeze [] - (bench/bench - (-> @*serialize-db (d/serializable) #?(:clj (jsonista/write-value-as-string mapper) :cljs js/JSON.stringify)))) + #?(:cljd + (bench/bench + (-> @*serialize-db d/serializable dart:convert/json.encode)) + :default + (bench/bench + (-> @*serialize-db (d/serializable) #?(:clj (jsonista/write-value-as-string mapper) :cljs js/JSON.stringify))))) (defn bench-thaw [] - (let [json (-> @*serialize-db (d/serializable) #?(:clj (jsonista/write-value-as-string mapper) :cljs js/JSON.stringify))] - (bench/bench - (-> json #?(:clj (jsonista/read-value mapper) :cljs js/JSON.parse) d/from-serializable)))) + #?(:cljd + (let [json (-> @*serialize-db d/serializable dart:convert/json.encode)] + (bench/bench + (-> json dart:convert/json.decode d/from-serializable))) + :default + (let [json (-> @*serialize-db (d/serializable) #?(:clj (jsonista/write-value-as-string mapper) :cljs js/JSON.stringify))] + (bench/bench + (-> json #?(:clj (jsonista/read-value mapper) :cljs js/JSON.parse) d/from-serializable))))) + +#?(:cljd + (do + (def *async-datoms + (delay + (into [] + (for [p @bench/*people20k + :let [id (int/parse (:db/id p))] + [k v] p + :when (not= k :db/id)] + (d/datom id k v))))) + + (defn bench-async-init [] + (bench/bench + (dart/await (async-set/async-from-sequential ddb/cmp-datoms-eavt-cmp @*async-datoms)))) + + (defn bench-async-add-1 [] + (bench/bench + (loop [s (async-set/async-sorted-set ddb/cmp-datoms-eavt-cmp) + ps (seq @bench/*people20k)] + (if ps + (let [p (first ps) + id (int/parse (:db/id p)) + s1 (dart/await (async-set/async-conj s (d/datom id :name (:name p)) ddb/cmp-datoms-eavt-cmp)) + s2 (dart/await (async-set/async-conj s1 (d/datom id :last-name (:last-name p)) ddb/cmp-datoms-eavt-cmp)) + s3 (dart/await (async-set/async-conj s2 (d/datom id :sex (:sex p)) ddb/cmp-datoms-eavt-cmp)) + s4 (dart/await (async-set/async-conj s3 (d/datom id :age (:age p)) ddb/cmp-datoms-eavt-cmp)) + s5 (dart/await (async-set/async-conj s4 (d/datom id :salary (:salary p)) ddb/cmp-datoms-eavt-cmp))] + (recur s5 (next ps))) + s)))) + + (defn bench-async-add-all [] + (bench/bench + (loop [s (async-set/async-sorted-set ddb/cmp-datoms-eavt-cmp) + ds (seq @*async-datoms)] + (if ds + (recur (dart/await (async-set/async-conj s (first ds) ddb/cmp-datoms-eavt-cmp)) (next ds)) + s)))) + + (defn bench-async-retract [] + (let [s (dart/await (async-set/async-from-sequential ddb/cmp-datoms-eavt-cmp @*async-datoms))] + (bench/bench + (loop [set s + ds (seq @*async-datoms)] + (if ds + (recur (dart/await (async-set/async-disj set (first ds) ddb/cmp-datoms-eavt-cmp)) (next ds)) + set))))) + + (defn bench-async-slice [] + (let [s (dart/await (async-set/async-from-sequential ddb/cmp-datoms-eavt-cmp @*async-datoms))] + (bench/bench + (dart/await (async-set/async-slice s + (ddb/min-datom (d/datom 9000 nil nil ddb/tx0)) + (ddb/max-datom (d/datom 11000 nil nil ddb/txmax)) + ddb/cmp-datoms-eavt-cmp))))) + + )) (def benches - {"add-1" bench-add-1 - "add-5" bench-add-5 - "add-all" bench-add-all - "init" bench-init - "find-datoms" bench-find-datoms - "find-datom" bench-find-datom - "retract-5" bench-retract-5 - "q1" bench-q1 - "q2" bench-q2 - "q3" bench-q3 - "q4" bench-q4 - "q5-shortcircuit" bench-q5-shortcircuit - "qpred1" bench-qpred1 - "qpred2" bench-qpred2 - "pull-one-entities" bench-pull-one-entities - "pull-one" bench-pull-one - "pull-many-entities" bench-pull-many-entities - "pull-many" bench-pull-many - "pull-wildcard" bench-pull-wildcard - "rules-wide-3x3" bench-rules-wide-3x3 - "rules-wide-5x3" bench-rules-wide-5x3 - "rules-wide-7x3" bench-rules-wide-7x3 - "rules-wide-4x6" bench-rules-wide-4x6 - "rules-long-10x3" bench-rules-long-10x3 - "rules-long-30x3" bench-rules-long-30x3 - "rules-long-30x5" bench-rules-long-30x5 - "freeze" bench-freeze - "thaw" bench-thaw}) + (merge + {"add-1" bench-add-1 + "add-5" bench-add-5 + "add-all" bench-add-all + "init" bench-init + "find-datoms" bench-find-datoms + "find-datom" bench-find-datom + "retract-5" bench-retract-5 + "q1" bench-q1 + "q2" bench-q2 + "q3" bench-q3 + "q4" bench-q4 + "q5-shortcircuit" bench-q5-shortcircuit + "qpred1" bench-qpred1 + "qpred2" bench-qpred2 + "pull-one-entities" bench-pull-one-entities + "pull-one" bench-pull-one + "pull-many-entities" bench-pull-many-entities + "pull-many" bench-pull-many + "pull-wildcard" bench-pull-wildcard + "rules-wide-3x3" bench-rules-wide-3x3 + "rules-wide-5x3" bench-rules-wide-5x3 + "rules-wide-7x3" bench-rules-wide-7x3 + "rules-wide-4x6" bench-rules-wide-4x6 + "rules-long-10x3" bench-rules-long-10x3 + "rules-long-30x3" bench-rules-long-30x3 + "rules-long-30x5" bench-rules-long-30x5 + "freeze" bench-freeze + "thaw" bench-thaw} + #?(:cljd + {"async-init" bench-async-init + "async-add-1" bench-async-add-1 + "async-add-all" bench-async-add-all + "async-retract" bench-async-retract + "async-slice" bench-async-slice} + :default {}))) (defn ^:export -main "clj -A:bench -M -m datascript.bench.datascript [--profile] (add-1 | add-5 | ...)*" [& args] (let [args (or args ()) - profile? (.contains ^java.util.List args "--profile") + profile? (boolean (some #{"--profile"} args)) args (remove #{"--profile"} args) names (or (not-empty args) (sort (keys benches))) - _ (apply println #?(:clj "CLJ:" :cljs "CLJS:") names) + _ (apply println #?(:clj "CLJ:" :cljs "CLJS:" :cljd "CLJD:") names) longest (last (sort-by count names))] (binding [bench/*profile* profile?] (doseq [name names :let [fn (benches name)]] (if (nil? fn) (println "Unknown benchmark:" name) - (let [{:keys [mean-ms file]} (fn)] + (let [{:keys [mean-ms file]} #?(:cljd (dart/await (fn)) :default (fn))] (println (bench/right-pad name (count longest)) " " @@ -279,6 +356,10 @@ " " (or file "")))))) #?(:clj (shutdown-agents)))) +#?(:cljd + (defn ^:export main [args] + (apply -main args))) + (comment (require 'datascript.bench.datascript :reload-all) diff --git a/deps.edn b/deps.edn index e514c0d1..b3950ced 100644 --- a/deps.edn +++ b/deps.edn @@ -1,17 +1,20 @@ {:deps - {persistent-sorted-set/persistent-sorted-set {:mvn/version "0.3.0"} + {persistent-sorted-set/persistent-sorted-set + {:git/url "https://github.com/ianffcs/persistent-sorted-set.git" + :git/branch "cljd-support" + :git/sha "43e57ffac13851de46533957a4a96a234ff8a223"} io.github.tonsky/extend-clj {:mvn/version "0.1.0"}} - + :aliases {:cljs {:extra-paths ["test"] :extra-deps {org.clojure/clojurescript {:mvn/version "1.11.132"}}} - + :1.9 {:override-deps {org.clojure/clojure {:mvn/version "1.9.0"}}} - + :1.10 {:override-deps {org.clojure/clojure {:mvn/version "1.10.2"}}} diff --git a/script/bench_all.sh b/script/bench_all.sh index a29736c4..85f9c7ac 100755 --- a/script/bench_all.sh +++ b/script/bench_all.sh @@ -3,4 +3,5 @@ cd "`dirname $0`/.." ./script/bench_clj.sh $@ ./script/bench_cljs.sh $@ -./script/bench_datomic.sh $@ \ No newline at end of file +./script/bench_datomic.sh $@ +./script/bench_cljd.sh $@ diff --git a/script/bench_cljd.sh b/script/bench_cljd.sh new file mode 100755 index 00000000..63733d84 --- /dev/null +++ b/script/bench_cljd.sh @@ -0,0 +1,25 @@ + +#!/bin/bash +set -o errexit -o nounset -o pipefail +cd "`dirname $0`/.." +PATH="$PWD/.fvm/flutter_sdk/bin:$PATH" + +rm -rf tmp/cljdbench +mkdir -p tmp/cljdbench/src/cljd +cat > tmp/cljdbench/deps.edn <&2 + if ./script/bench_${platform}.sh "$@" >"$out" 2>&1; then + cat "$out" >&2 + else + echo "(failed)" >&2 + : >"$out" + fi + echo "" >&2 +} + +run_bench clj "$@" +run_bench cljs "$@" +run_bench cljd "$@" + +python3 - "$TMP/clj.txt" "$TMP/cljs.txt" "$TMP/cljd.txt" <<'PYTHON' +import sys, re + +def parse(path): + results = {} + try: + with open(path) as f: + for line in f: + m = re.match(r'^(\S+)\s+([\d.]+)\s+ms/op', line.strip()) + if m: + results[m.group(1)] = float(m.group(2)) + except OSError: + pass + return results + +clj = parse(sys.argv[1]) +cljs = parse(sys.argv[2]) +cljd = parse(sys.argv[3]) + +all_keys = sorted(set(clj) | set(cljs) | set(cljd)) +if not all_keys: + print("No benchmark results found.") + sys.exit(0) + +NW = max(max(len(k) for k in all_keys), 9) + +def fmt_ms(v): + if v is None: + return "N/A" + if v > 1: + return f"{v:.1f}ms" + if v > 0.01: + return f"{v:.3f}ms" + return f"{v:.7f}ms" + +def fmt_ratio(a, b): + if a is None or b is None: + return "N/A" + r = a / b + return f"{r:.2f}x" + +cols = [("CLJ", clj), ("CLJS", cljs), ("CLJD", cljd)] +present = [(name, data) for name, data in cols if data] + +header_parts = [f"{'Benchmark':<{NW}}"] +for name, _ in present: + header_parts.append(f"{name:>10}") +if len(present) > 1: + for i in range(1, len(present)): + label = f"{present[i][0]}/{present[0][0]}" + header_parts.append(f"{label:>10}") + +header = " ".join(header_parts) +print(header) +print("-" * len(header)) + +for k in all_keys: + row = [f"{k:<{NW}}"] + vals = [data.get(k) for _, data in present] + for v in vals: + row.append(f"{fmt_ms(v):>10}") + if len(present) > 1: + base = vals[0] + for v in vals[1:]: + row.append(f"{fmt_ratio(v, base):>10}") + print(" ".join(row)) +PYTHON diff --git a/script/test_all.sh b/script/test_all.sh index 9c438de5..1396008e 100755 --- a/script/test_all.sh +++ b/script/test_all.sh @@ -5,6 +5,7 @@ cd "`dirname $0`/.." EXIT=0 ./script/test_clj.sh || EXIT=$((EXIT + $?)) ./script/test_cljs.sh || EXIT=$((EXIT + $?)) +./script/test_cljd.sh || EXIT=$((EXIT + $?)) ./script/test_js.sh || EXIT=$((EXIT + $?)) ./script/test_datomic.sh || EXIT=$((EXIT + $?)) -exit $EXIT \ No newline at end of file +exit $EXIT diff --git a/script/test_cljd.sh b/script/test_cljd.sh new file mode 100755 index 00000000..1a80a0d9 --- /dev/null +++ b/script/test_cljd.sh @@ -0,0 +1,25 @@ +#!/bin/bash +set -o errexit -o nounset -o pipefail +cd "`dirname $0`/.." +PATH="$PWD/.fvm/flutter_sdk/bin:$PATH" + +rm -rf tmp/cljdtests +mkdir -p tmp/cljdtests/src/cljd +cat > tmp/cljdtests/deps.edn < greater, '<= less-equal, '>= greater-equal, - '+ +, '- -, '* *, '/ /, - 'quot quot, 'rem rem, 'mod mod, 'inc inc, 'dec dec, 'max max, 'min min, - 'zero? zero?, 'pos? pos?, 'neg? neg?, 'even? even?, 'odd? odd?, 'compare compare, - 'rand rand, 'rand-int rand-int, - 'true? true?, 'false? false?, 'nil? nil?, 'some? some?, 'not not, 'and and-fn, 'or or-fn, - 'complement complement, 'identical? identical?, - 'identity identity, 'keyword keyword, 'meta meta, 'name name, 'namespace namespace, 'type type, - 'vector vector, 'list list, 'set set, 'hash-map hash-map, 'array-map array-map, - 'count count, 'range range, 'not-empty not-empty, 'empty? empty?, 'contains? contains?, - 'str str, 'subs, subs, 'get get, - 'pr-str pr-str, 'print-str print-str, 'println-str println-str, 'prn-str prn-str, - 're-find re-find, 're-matches re-matches, 're-seq re-seq, 're-pattern re-pattern, - '-differ? -differ?, 'get-else -get-else, 'get-some -get-some, 'missing? -missing?, 'ground identity, - 'clojure.string/blank? str/blank?, 'clojure.string/includes? str/includes?, - 'clojure.string/starts-with? str/starts-with?, 'clojure.string/ends-with? str/ends-with? - 'tuple vector, 'untuple identity}) +(def query-fns { + '= =, '== ==, 'not= not=, '!= not=, + '< less, '> greater, '<= less-equal, '>= greater-equal, + '+ +, '- -, '* *, '/ /, + 'quot quot, 'rem rem, 'mod mod, 'inc inc, 'dec dec, 'max max, 'min min, + 'zero? zero?, 'pos? pos?, 'neg? neg?, 'even? even?, 'odd? odd?, 'compare compare, + 'rand rand, 'rand-int rand-int, + 'true? true?, 'false? false?, 'nil? nil?, 'some? some?, 'not not, 'and and-fn, 'or or-fn, + 'complement complement, 'identical? identical?, + 'identity identity, 'keyword keyword, 'meta meta, 'name name, 'namespace namespace, #?@(:cljd [] :default ['type type]), + 'vector vector, 'list list, 'set set, 'hash-map hash-map, #?@(:cljd [] :default ['array-map array-map]), + 'count count, 'range range, 'not-empty not-empty, 'empty? empty?, 'contains? contains?, + 'str str, 'subs, subs, 'get get, + 'pr-str pr-str, 'print-str print-str, 'println-str println-str, 'prn-str prn-str, + 're-find re-find, 're-matches re-matches, 're-seq re-seq, 're-pattern re-pattern, + '-differ? -differ?, 'get-else -get-else, 'get-some -get-some, 'missing? -missing?, 'ground identity, + 'clojure.string/blank? str/blank?, 'clojure.string/includes? str/includes?, + 'clojure.string/starts-with? str/starts-with?, 'clojure.string/ends-with? str/ends-with? + 'tuple vector, 'untuple identity +}) ;; Aggregates @@ -113,7 +114,7 @@ (cond-> (nth terms med) (even? size) (-> (+ (nth terms (dec med))) - (/ 2))))) + (/ 2))))) (defn- aggregate-variance [coll] (let [mean (aggregate-avg coll) @@ -124,7 +125,7 @@ (/ sum (count coll)))) (defn- aggregate-stddev [coll] - (#?(:cljs js/Math.sqrt :clj Math/sqrt) (aggregate-variance coll))) + (#?(:cljs js/Math.sqrt :default Math/sqrt) (aggregate-variance coll))) (defn- aggregate-min ([coll] @@ -138,11 +139,11 @@ (reduce (fn [acc x] (cond (< (count acc) n) - (sort compare (conj acc x)) + (sort compare (conj acc x)) (neg? (compare x (last acc))) - (sort compare (conj (butlast acc) x)) + (sort compare (conj (butlast acc) x)) :else acc)) - [] coll)))) + [] coll)))) (defn- aggregate-max ([coll] @@ -152,15 +153,15 @@ x acc)) (first coll) (next coll))) ([n coll] - (vec - (reduce (fn [acc x] - (cond - (< (count acc) n) - (sort compare (conj acc x)) - (pos? (compare x (first acc))) - (sort compare (conj (next acc) x)) - :else acc)) - [] coll)))) + (vec + (reduce (fn [acc x] + (cond + (< (count acc) n) + (sort compare (conj acc x)) + (pos? (compare x (first acc))) + (sort compare (conj (next acc) x)) + :else acc)) + [] coll)))) (defn- aggregate-rand ([coll] (rand-nth coll)) diff --git a/src/datascript/conn.cljc b/src/datascript/conn.cljc index 258817f5..5111286d 100644 --- a/src/datascript/conn.cljc +++ b/src/datascript/conn.cljc @@ -2,20 +2,44 @@ (:require [datascript.db :as db #?@(:cljs [:refer [DB FilteredDB]])] [datascript.storage :as storage] - [extend-clj.core :as extend] - [me.tonsky.persistent-sorted-set :as set]) + #?@(:cljd () + :default [[extend-clj.core :as extend] + [me.tonsky.persistent-sorted-set :as set]])) #?(:clj (:import [datascript.db DB FilteredDB]))) -(extend/deftype-atom Conn [atom] - (deref-impl [this] - (:db @atom)) - (compare-and-set-impl [this oldv newv] - (compare-and-set! - atom - (assoc @atom :db oldv) - (assoc @atom :db newv)))) +#?(:cljd + (deftype Conn [atom] + cljd.core/IDeref + (-deref [this] + (:db @atom)) + cljd.core/IReset + (-reset! [this newv] + (:db (swap! atom assoc :db newv))) + cljd.core/ISwap + (-swap! [this f] + (:db (swap! atom update :db f))) + (-swap! [this f a] + (:db (swap! atom update :db f a))) + (-swap! [this f a b] + (:db (swap! atom update :db f a b))) + (-swap! [this f a b xs] + (:db (apply swap! atom update :db f a b xs))) + cljd.core/ILookup + (-lookup [this key] + (case key :atom atom nil)) + (-lookup [this key not-found] + (case key :atom atom not-found))) + :default + (extend/deftype-atom Conn [atom] + (deref-impl [this] + (:db @atom)) + (compare-and-set-impl [this oldv newv] + (compare-and-set! + atom + (assoc @atom :db oldv) + (assoc @atom :db newv))))) (defn- make-conn [opts] (->Conn (atom opts))) @@ -36,7 +60,8 @@ (defn conn? [conn] (and - #?(:clj (instance? clojure.lang.IDeref conn) + #?(:cljd (instance? Conn conn) + :clj (instance? clojure.lang.IDeref conn) :cljs (satisfies? cljs.core/IDeref conn)) (if-some [db @conn] (db/db? db) @@ -112,7 +137,7 @@ (transact! conn tx-data nil)) ([conn tx-data tx-meta] {:pre [(conn? conn)]} - (locking conn + (#?(:cljd do :default locking) #?(:cljd nil :default conn) (let [report (-transact! conn tx-data tx-meta)] (doseq [[_ callback] (:listeners @(:atom conn))] (callback report)) diff --git a/src/datascript/core.cljc b/src/datascript/core.cljc index 3bb171d0..c981f7ca 100644 --- a/src/datascript/core.cljc +++ b/src/datascript/core.cljc @@ -1,38 +1,38 @@ (ns datascript.core (:refer-clojure :exclude [filter]) (:require - [#?(:cljs cljs.reader :clj clojure.edn) :as edn] + [#?(:cljs cljs.reader :cljd cljd.reader :clj clojure.edn) :as edn] [datascript.conn :as conn] - [datascript.db :as db #?@(:cljs [:refer [Datom DB FilteredDB]])] - #?(:clj [datascript.pprint]) + [datascript.db :as db #?@(:cljd [:refer [Datom DB FilteredDB ->FilteredDB]] + :cljs [:refer [Datom DB FilteredDB]])] + #?(:cljd nil :clj [datascript.pprint]) [datascript.pull-api :as dp] [datascript.serialize :as ds] [datascript.storage :as storage] [datascript.query :as dq] - [datascript.impl.entity :as de] + [datascript.impl.entity :as de #?@(:cljd [:refer [Entity]])] [datascript.util :as util] - [me.tonsky.persistent-sorted-set :as set]) - #?(:clj + #?(:cljd nil :default [me.tonsky.persistent-sorted-set :as set])) + #?(:cljd nil + :clj (:import [datascript.db Datom DB FilteredDB] [datascript.impl.entity Entity] [java.util UUID]))) -(def ^:const ^:no-doc tx0 - db/tx0) - +(def #?(:cljd tx0 :default ^:const ^:no-doc tx0) db/tx0) ; Entities -(def ^{:tag Entity +(def ^{:tag #?(:cljd Entity? :default Entity) :arglists '([db eid]) :doc "Retrieves an entity by its id from database. Entities are lazy map-like structures to navigate DataScript database content. For `eid` pass entity id or lookup attr: - + (entity db 1) (entity db [:unique-attr :value]) - + If entity does not exist, `nil` is returned: (entity db 100500) ; => nil @@ -42,7 +42,7 @@ (entity db 1) ; => {:db/id 1} Entity attributes can be lazily accessed through key lookups: - + (:attr (entity db 1)) ; => :value (get (entity db 1) :attr) ; => :value @@ -59,13 +59,13 @@ (:_ref (entity db 2)) ; => [{:db/id 1}] (:ns/_ref (entity db 2)) ; => [{:db/id 1}] - + Reverse reference lookup returns sequence of entities unless attribute is marked as `:db/isComponent`: (:_component-ref (entity db 2)) ; => {:db/id 1} Entity gotchas: - + - Entities print as map, but are not exactly maps (they have compatible get interface though). - Entities are effectively immutable “views” into a particular version of a database. - Entities retain reference to the whole database. @@ -74,7 +74,8 @@ - Comparing entities just compares their ids. Be careful when comparing entities taken from different dbs or from different versions of the same db. - Accessed entity attributes are cached on entity itself (except backward references). - When printing, only cached attributes (the ones you have accessed before) are printed. See [[touch]]."} - entity de/entity) + entity + #(de/entity %1 %2)) ; CLJD bug (def ^{:arglists '([db eid]) :doc "Given lookup ref `[unique-attr value]`, returns numberic entity id. @@ -88,7 +89,7 @@ {:pre [(de/entity? entity)]} (.-db entity)) -(def ^{:tag Entity +(def ^{:tag #?(:cljd Entity? :default Entity) :arglists '([e]) :doc "Forces all entity attributes to be eagerly fetched and cached. Only usable for debug output. @@ -98,7 +99,7 @@ (entity db 1) ; => {:db/id 1} (touch (entity db 1)) ; => {:db/id 1, :dislikes [:pie], :likes [:pizza]} ```"} - touch de/touch) + touch #(de/touch %)) ; cljd bug ; Pull @@ -136,7 +137,7 @@ :doc "Executes a datalog query. See [docs.datomic.com/on-prem/query.html](https://docs.datomic.com/on-prem/query.html). Usage: - + ``` (q '[:find ?value :where [_ :likes ?value]] @@ -148,11 +149,19 @@ ; Creating DB +(defn- maybe-adapt-storage [opts] + #?(:cljd opts + :clj + (if-some [storage (:storage opts)] + (update opts :storage storage/make-storage-adapter opts) + opts) + :cljs opts)) + (defn ^DB empty-db "Creates an empty database with an optional schema. Usage: - + ``` (empty-db) ; => #datascript/DB {:schema {}, :datoms []} @@ -160,9 +169,9 @@ ; => #datascript/DB {:schema {:likes {:db/cardinality :db.cardinality/many}} ; :datoms []} ``` - + Options are: - + :branching-factor , default 512. B-tree max node length :ref-type :strong | :soft | :weak, default :soft. How will nodes that are already stored on disk be referenced. Soft or weak means they might be unloaded @@ -173,7 +182,11 @@ ([schema] (db/empty-db schema {})) ([schema opts] - (db/empty-db schema (storage/maybe-adapt-storage opts)))) + #?(:cljd + (cond-> (db/empty-db schema opts) + (:storage opts) (storage/attach-storage (:storage opts))) + :default + (db/empty-db schema (maybe-adapt-storage opts))))) (def ^{:arglists '([x]) :doc "Returns `true` if the given value is an immutable database, `false` otherwise."} @@ -202,7 +215,11 @@ ([datoms schema] (db/init-db datoms schema {})) ([datoms schema opts] - (db/init-db datoms schema (storage/maybe-adapt-storage opts)))) + #?(:cljd + (cond-> (db/init-db datoms schema opts) + (:storage opts) (storage/attach-storage (:storage opts))) + :default + (db/init-db datoms schema (maybe-adapt-storage opts))))) (def ^{:arglists '([db] [db opts]) :doc "Converts db into a data structure (not string!) that can be fed to serializer @@ -246,7 +263,7 @@ (defn filter "Returns a view over database that has same interface but only includes datoms for which the `(pred db datom)` is true. Can be applied multiple times. - + Filtered DB gotchas: - All operations on filtered database are proxied to original DB, then filter pred is applied. @@ -259,19 +276,26 @@ (let [^FilteredDB fdb db orig-pred (.-pred fdb) orig-db (.-unfiltered-db fdb)] - (FilteredDB. orig-db #(and (orig-pred %) (pred orig-db %)) (atom 0))) - (FilteredDB. db #(pred db %) (atom 0)))) + (#?(:cljd ->FilteredDB :default FilteredDB.) orig-db #(and (orig-pred %) (pred orig-db %)) (atom 0))) + (#?(:cljd ->FilteredDB :default FilteredDB.) db #(pred db %) (atom 0)))) ; Changing DB -(def ^{:arglists '([db tx-data] [db tx-data tx-meta])} with +(defn with "Same as [[transact!]], but applies to an immutable database value. Returns transaction report (see [[transact!]])." - conn/with) - -(def ^{:arglists '([db tx-data]) :tag DB} db-with + ([db tx-data] (with db tx-data nil)) + ([db tx-data tx-meta] + {:pre [(db/db? db)]} + (if (is-filtered db) + (throw (ex-info "Filtered DB cannot be modified" {:error :transaction/filtered})) + (db/transact-tx-data (db/->TxReport db db [] {} tx-meta) tx-data)))) + +(defn ^DB db-with "Applies transaction to an immutable db value, returning new immutable db value. Same as `(:db-after (with db tx-data))`." - conn/db-with) + [db tx-data] + {:pre [(db/db? db)]} + (:db-after (with db tx-data))) (defn ^DB with-schema "Warning! No validation or conversion. Only change schema in a compatible way" @@ -294,17 +318,17 @@ ; #datascript/Datom [1 :likes \"fries\"] ; #datascript/Datom [1 :likes \"pizza\"] ; #datascript/Datom [1 :name \"Ivan\"]) - + ; find all datoms for entity id == 1 and attribute == :likes (any values) ; sorted by value (datoms db :eavt 1 :likes) ; => (#datascript/Datom [1 :likes \"fries\"] ; #datascript/Datom [1 :likes \"pizza\"]) - + ; find all datoms for entity id == 1, attribute == :likes and value == \"pizza\" (datoms db :eavt 1 :likes \"pizza\") ; => (#datascript/Datom [1 :likes \"pizza\"]) - + ; find all datoms for attribute == :likes (any entity ids and values) ; sorted by entity id, then value (datoms db :aevt :likes) @@ -313,13 +337,13 @@ ; #datascript/Datom [2 :likes \"candy\"] ; #datascript/Datom [2 :likes \"pie\"] ; #datascript/Datom [2 :likes \"pizza\"]) - + ; find all datoms that have attribute == `:likes` and value == `\"pizza\"` (any entity id) ; `:likes` must be a unique attr, reference or marked as `:db/index true` (datoms db :avet :likes \"pizza\") ; => (#datascript/Datom [1 :likes \"pizza\"] ; #datascript/Datom [2 :likes \"pizza\"]) - + ; find all datoms sorted by entity id, then attribute, then value (datoms db :eavt) ; => (...) @@ -327,24 +351,24 @@ ; get all values of :db.cardinality/many attribute (->> (datoms db :eavt eid attr) (map :v)) - + ; lookup entity ids by attribute value (->> (datoms db :avet attr value) (map :e)) - + ; find all entities with a specific attribute (->> (datoms db :aevt attr) (map :e)) - + ; find “singleton” entity by its attr (->> (datoms db :aevt attr) first :e) - + ; find N entities with lowest attr value (e.g. 10 earliest posts) (->> (datoms db :avet attr) (take N)) - + ; find N entities with highest attr value (e.g. 10 latest posts) (->> (datoms db :avet attr) (reverse) (take N)) Gotchas: - + - Index lookup is usually more efficient than doing a query with a single clause. - Resulting iterator is calculated in constant time and small constant memory overhead. - Iterator supports efficient `first`, `next`, `reverse`, `seq` and is itself a sequence. @@ -386,12 +410,12 @@ ; #datascript/Datom [2 :likes \"candy\"] ; #datascript/Datom [2 :likes \"pie\"] ; #datascript/Datom [2 :likes \"pizza\"]) - - (seek-datoms db :eavt 2) + + (seek-datoms db :eavt 2) ; => (#datascript/Datom [2 :likes \"candy\"] ; #datascript/Datom [2 :likes \"pie\"] ; #datascript/Datom [2 :likes \"pizza\"]) - + ; no datom [2 :likes \"fish\"], so starts with one immediately following such in index (seek-datoms db :eavt 2 :likes \"fish\") ; => (#datascript/Datom [2 :likes \"pie\"] @@ -412,11 +436,11 @@ (defn index-range "Returns part of `:avet` index between `[_ attr start]` and `[_ attr end]` in AVET sort order. - + Same properties as [[datoms]]. - + `attr` must be a reference, unique attribute or marked as `:db/index true`. - + Usage: (index-range db :likes \"a\" \"zzzzzzzzz\") @@ -425,112 +449,177 @@ ; #datascript/Datom [2 :likes \"pie\"] ; #datascript/Datom [1 :likes \"pizza\"] ; #datascript/Datom [2 :likes \"pizza\"]) - + (index-range db :likes \"egg\" \"pineapple\") ; => (#datascript/Datom [1 :likes \"fries\"] ; #datascript/Datom [2 :likes \"pie\"]) - + Useful patterns: - + ; find all entities with age in a specific range (inclusive) (->> (index-range db :age 18 60) (map :e))" [db attr start end] {:pre [(db/db? db)]} (db/-index-range db attr start end)) + ;; Conn -(def ^{:arglists '([conn])} conn? +(defn conn? "Returns `true` if this is a connection to a DataScript db, `false` otherwise." - conn/conn?) + [conn] + (and #?(:cljd (satisfies? cljd.core/IDeref conn) + :clj (instance? clojure.lang.IDeref conn) + :cljs (satisfies? cljs.core/IDeref conn)) + (db/db? @conn))) -(def ^{:arglists '([db])} conn-from-db +(defn conn-from-db "Creates a mutable reference to a given immutable database. See [[create-conn]]." - conn/conn-from-db) - -(def ^{:arglists '([datoms] [datoms schema] [datoms schema opts])} conn-from-datoms + [db] + {:pre [(db/db? db)]} + (if-some [s (storage/storage db)] + (do + (storage/store db) + (atom db + :meta {:listeners (atom {}) + :storage-state (atom {:tx-tail [] :db-last-stored db})})) + (atom db + :meta {:listeners (atom {})}))) + +(defn conn-from-datoms "Creates an empty DB and a mutable reference to it. See [[create-conn]]." - conn/conn-from-datoms) + ([datoms] + (conn-from-db (init-db datoms))) + ([datoms schema] + (conn-from-db (init-db datoms schema))) + ([datoms schema opts] + (conn-from-db (init-db datoms schema opts)))) -(def ^{:arglists '([] [schema] [schema opts])} create-conn +(defn create-conn "Creates a mutable reference (a “connection”) to an empty immutable database. Connections are lightweight in-memory structures (~atoms) with direct support of transaction listeners ([[listen!]], [[unlisten!]]) and other handy DataScript APIs ([[transact!]], [[reset-conn!]], [[db]]). To access underlying immutable DB value, deref: `@conn`. - - For list of options, see [[empty-db]]. - - If you specify `:storage` option, conn will be stored automatically after each transaction" - conn/create-conn) -#?(:clj - (def ^{:arglists '([storage] [storage opts])} restore-conn - "Lazy-load database from storage and make conn out of it. - Returns nil if there’s no database yet in storage" - conn/restore-conn)) + For list of options, see [[empty-db]]. -(def ^{:arglists '([conn tx-data] [conn tx-data tx-meta])} transact! + If you specify `:storage` option, conn will be stored automatically after each transaction" + ([] + (conn-from-db (empty-db))) + ([schema] + (conn-from-db (empty-db schema))) + ([schema opts] + (conn-from-db (empty-db schema opts)))) + +(defn restore-conn + "Lazy-load database from storage and make conn out of it. + Returns nil if there’s no database yet in storage" + ([s] + (restore-conn s {})) + ([s opts] + (when-some [[db tail] (storage/restore-impl s opts)] + (let [db-restored (storage/db-with-tail db tail)] + (atom db-restored + :meta {:listeners (atom {}) + :storage-state (atom {:tx-tail tail :db-last-stored db})}))))) + +(defn ^:no-doc -transact! [conn tx-data tx-meta] + {:pre [(conn? conn)]} + (let [*report (atom nil)] + (swap! conn + (fn [db] + (let [r (with db tx-data tx-meta)] + (reset! *report r) + (:db-after r)))) + #?(:cljd + (when-some [s (storage/storage @conn)] + (let [{db :db-after + datoms :tx-data} @*report + *ss (:storage-state (meta conn)) + ss-next (swap! *ss update :tx-tail conj datoms) + tx-tail-next (:tx-tail ss-next)] + (if (> (transduce (map count) + 0 tx-tail-next) 32) + (do + (storage/store-impl! db s) + (swap! *ss assoc :tx-tail [] :db-last-stored db)) + (storage/store-tail db tx-tail-next)))) + :default + (when (storage/storage @conn) + (let [{db :db-after + datoms :tx-data} @*report] + (when-not (empty? datoms) + (let [settings (set/settings (:eavt db)) + *ss (:storage-state (meta conn)) + tx-tail-next (:tx-tail (swap! *ss update :tx-tail conj datoms))] + (if (> (transduce (map count) + 0 tx-tail-next) (:branching-factor settings)) + (do + (storage/store-impl! db (storage/storage-adapter db) false) + (swap! *ss assoc :tx-tail [] :db-last-stored db)) + (storage/store-tail db tx-tail-next))))))) + @*report)) + +(defn transact! "Applies transaction the underlying database value and atomically updates connection reference to point to the result of that transaction, new db value. - + Returns transaction report, a map: - {:db-before ... ; db value before transaction - :db-after ... ; db value after transaction - :tx-data [...] ; plain datoms that were added/retracted from db-before - :tempids {...} ; map of tempid from tx-data => assigned entid in db-after - :tx-meta tx-meta} ; the exact value you passed as `tx-meta` + { :db-before ... ; db value before transaction + :db-after ... ; db value after transaction + :tx-data [...] ; plain datoms that were added/retracted from db-before + :tempids {...} ; map of tempid from tx-data => assigned entid in db-after + :tx-meta tx-meta } ; the exact value you passed as `tx-meta` Note! `conn` will be updated in-place and is not returned from [[transact!]]. - + Usage: ; add a single datom to an existing entity (1) (transact! conn [[:db/add 1 :name \"Ivan\"]]) - + ; retract a single datom (transact! conn [[:db/retract 1 :name \"Ivan\"]]) - + ; retract single entity attribute (transact! conn [[:db.fn/retractAttribute 1 :name]]) - + ; ... or equivalently (since Datomic changed its API to support this): (transact! conn [[:db/retract 1 :name]]) - + ; retract all entity attributes (effectively deletes entity) (transact! conn [[:db.fn/retractEntity 1]]) - + ; create a new entity (`-1`, as any other negative value, is a tempid ; that will be replaced with DataScript to a next unused eid) (transact! conn [[:db/add -1 :name \"Ivan\"]]) - + ; check assigned id (here `*1` is a result returned from previous `transact!` call) (def report *1) (:tempids report) ; => {-1 296} - + ; check actual datoms inserted (:tx-data report) ; => [#datascript/Datom [296 :name \"Ivan\"]] - + ; tempid can also be a string (transact! conn [[:db/add \"ivan\" :name \"Ivan\"]]) (:tempids *1) ; => {\"ivan\" 297} - + ; reference another entity (must exist) (transact! conn [[:db/add -1 :friend 296]]) - + ; create an entity and set multiple attributes (in a single transaction ; equal tempids will be replaced with the same yet unused entid) (transact! conn [[:db/add -1 :name \"Ivan\"] [:db/add -1 :likes \"fries\"] [:db/add -1 :likes \"pizza\"] [:db/add -1 :friend 296]]) - + ; create an entity and set multiple attributes (alternative map form) (transact! conn [{:db/id -1 :name \"Ivan\" :likes [\"fries\" \"pizza\"] :friend 296}]) - + ; update an entity (alternative map form). Can’t retract attributes in ; map form. For cardinality many attrs, value (fish in this example) ; will be added to the list of existing values @@ -543,7 +632,7 @@ :name \"Oleg\" :friend {:db/id -2 :name \"Sergey\"}}]) - + ; reverse attribute name can be used if you want created entity to become ; a value in another entity reference (transact! conn [{:db/id -1 @@ -555,27 +644,72 @@ ; equivalent to (transact! conn [[:db/add -1 :name \"Oleg\"] [:db/add 296 :friend -1]])" - conn/transact!) + ([conn tx-data] (transact! conn tx-data nil)) + ([conn tx-data tx-meta] + {:pre [(conn? conn)]} + (let [report (-transact! conn tx-data tx-meta)] + (doseq [[_ callback] (some-> (:listeners (meta conn)) (deref))] + (callback report)) + report))) -(def ^{:arglists '([conn db] [conn db tx-meta])} reset-conn! +(defn reset-conn! "Forces underlying `conn` value to become `db`. Will generate a tx-report that will remove everything from old value and insert everything from the new one." - conn/reset-conn!) - -(def ^{:arglists '([conn schema])} reset-schema! - conn/reset-schema!) - -(def ^{:arglists '([conn callback] [conn key callback])} listen! + ([conn db] + (reset-conn! conn db nil)) + ([conn db tx-meta] + {:pre [(conn? conn) + (db/db? db)]} + (let [db-before @conn + report (db/map->TxReport + {:db-before db-before + :db-after db + :tx-data (concat + (map #(assoc % :added false) (datoms db-before :eavt)) + (datoms db :eavt)) + :tx-meta tx-meta})] + (when-some [s (storage/storage db-before)] + (storage/store db) + (swap! (:storage-state (meta conn)) assoc :tx-tail [] :db-last-stored db)) + (reset! conn db) + (doseq [[_ callback] (some-> (:listeners (meta conn)) (deref))] + (callback report)) + db))) + +(defn reset-schema! [conn schema] + "Warning! Does not perform any validation or data conversion. Only change schema in a compatible way" + {:pre [(conn? conn)]} + (let [db (swap! conn db/with-schema schema)] + (when-some [s (storage/storage @conn)] + (storage/store-impl! db s true) + (swap! (:storage-state (meta conn)) assoc :tx-tail [] :db-last-stored db)) + db)) + +(defn- atom? [a] + #?(:cljd (instance? cljd.core/Atom a) + :cljs (instance? Atom a) + :clj (instance? clojure.lang.IAtom a))) + +(defn listen! "Listen for changes on the given connection. Whenever a transaction is applied to the database via [[transact!]], the callback is called with the transaction report. `key` is any opaque unique value. - + Idempotent. Calling [[listen!]] with the same key twice will override old callback with the new value. - - Returns the key under which this listener is registered. See also [[unlisten!]]." - conn/listen!) -(def ^{:arglists '([conn key])} unlisten! + Returns the key under which this listener is registered. See also [[unlisten!]]." + ([conn callback] + (listen! conn (rand) callback)) + ([conn key callback] + {:pre [(conn? conn) + (atom? (:listeners (meta conn)))]} + (swap! (:listeners (meta conn)) assoc key callback) + key)) + +(defn unlisten! "Removes registered listener from connection. See also [[listen!]]." - conn/unlisten!) + [conn key] + {:pre [(conn? conn) + (atom? (:listeners (meta conn)))]} + (swap! (:listeners (meta conn)) dissoc key)) ; Data Readers @@ -598,7 +732,7 @@ (defn tempid "Allocates and returns an unique temporary id (a negative integer). Ignores `part`. Returns `x` if it is specified. - + Exists for Datomic API compatibility. Prefer using negative integers directly if possible." ([part] (if (= part :db.part/tx) @@ -611,14 +745,14 @@ (defn resolve-tempid "Does a lookup in tempids map, returning an entity id that tempid was resolved to. - + Exists for Datomic API compatibility. Prefer using map lookup directly if possible." [_db tempids tempid] (get tempids tempid)) (defn ^DB db "Returns the underlying immutable database value from a connection. - + Exists for Datomic API compatibility. Prefer using `@conn` directly if possible." [conn] {:pre [(conn? conn)]} @@ -626,13 +760,19 @@ (defn transact "Same as [[transact!]], but returns an immediately realized future. - + Exists for Datomic API compatibility. Prefer using [[transact!]] if possible." ([conn tx-data] (transact conn tx-data nil)) ([conn tx-data tx-meta] {:pre [(conn? conn)]} (let [res (transact! conn tx-data tx-meta)] - #?(:cljs + #?(:cljd + (reify + cljd.core/IDeref + (-deref [_] res) + cljd.core/IPending + (-realized? [_] true)) + :cljs (reify IDeref (-deref [_] res) @@ -666,19 +806,22 @@ (defn transact-async "In CLJ, calls [[transact!]] on a future thread pool, returning immediately. - + In CLJS, just calls [[transact!]] and returns a realized future." ([conn tx-data] (transact-async conn tx-data nil)) ([conn tx-data tx-meta] {:pre [(conn? conn)]} - (future-call #(transact! conn tx-data tx-meta)))) + #?(:cljd + (future (transact! conn tx-data tx-meta)) + :default + (future-call #(transact! conn tx-data tx-meta))))) ;; squuid (def ^{:arglists '([] [msec])} squuid "Generates a UUID that grow with time. Such UUIDs will always go to the end of the index and that will minimize insertions in the middle. - + Consist of 64 bits of current UNIX timestamp (in seconds) and 64 random bits (2^64 different unique values per second)." util/squuid) @@ -688,54 +831,62 @@ ;; Storage -#?(:clj +#?(:cljd nil + :clj (def ^{:arglists '([db])} storage "Returns IStorage used by DB instance" storage/storage)) -#?(:clj +#?(:cljd nil + :clj (def ^{:arglists '([db] [db storage])} store "Stores databases to provided storage. If database was created with :storage option or restored from storage, use single-argument version. - + Subsequent stores are incremental, i.e. only newly added nodes will be actually stored. - + Storing already stored dbs into another storage is not supported (may change)." storage/store)) -#?(:clj +#?(:cljd nil + :clj (def ^{:arglists '([storage] [storage opts])} restore "Lazy-loads database from storage. Ultra-fast, fetches the rest as it’s needed" storage/restore)) -#?(:clj +#?(:cljd nil + :clj (defn addresses "Returns all addresses in use by current db (as java.util.HashSet). Anything that is not in the return set is safe to be deleted" [& dbs] (storage/addresses dbs))) -#?(:clj +#?(:cljd nil + :clj (def ^{:arglists '([storage])} collect-garbage "Deletes all keys from storage that are not referenced by any of the currently alive db refs. Has a side-effect of fully loading databases fully into memory, so, can be slow" storage/collect-garbage)) -#?(:clj +#?(:cljd nil + :clj (def ^{:arglists '([dir] [dir opts])} file-storage "Default implementation that stores data in files in a dir. - + Options are: - + :freeze-fn :: (data) -> String. A serialization function :thaw-fn :: (String) -> data. A deserialization function :write-fn :: (OutputStream data) -> void. Implement your own writer to FileOutputStream :read-fn :: (InputStream) -> Object. Implement your own reader from FileInputStream :addr->filename-fn :: (UUID) -> String. Construct file name from address :filename->addr-fn :: (String) -> UUID. Reconstruct address from file name - + All options are optional." storage/file-storage)) (defn settings [db] - (set/settings (:eavt db))) + #?(:cljd nil + :default + (set/settings (:eavt db)))) diff --git a/src/datascript/db.cljc b/src/datascript/db.cljc index b20d75a2..f0312b5d 100644 --- a/src/datascript/db.cljc +++ b/src/datascript/db.cljc @@ -2,17 +2,19 @@ (:require #?(:cljs [goog.array :as garray]) [clojure.walk] + [clojure.string] + #?(:cljd [cljd.core :refer [HashRankedWideTreapSet]]) [clojure.data] - #?(:clj [datascript.inline :refer [update]]) + #?(:cljd nil :clj [datascript.inline :refer [update]]) [datascript.lru :as lru] [datascript.util :as util] [me.tonsky.persistent-sorted-set :as set] [me.tonsky.persistent-sorted-set.arrays :as arrays]) - #?(:clj (:import clojure.lang.IFn$OOL)) - #?(:cljs (:require-macros [datascript.db :refer [case-tree combine-cmp defn+ defcomp defrecord-updatable int-compare validate-attr validate-val]])) - (:refer-clojure :exclude [seqable? #?(:clj update)])) + #?(:cljd nil :clj (:import clojure.lang.IFn$OOL)) + #?(:cljs (:require-macros [datascript.db :refer [case-tree combine-cmp declare+ defn+ defcomp defrecord-updatable int-compare raise validate-attr validate-val]])) + (:refer-clojure :exclude [seqable? #?(:cljd nil :clj update)])) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljd nil :clj (set! *warn-on-reflection* true)) ;; ---------------------------------------------------------------------------- @@ -22,28 +24,25 @@ (def IllegalArgumentException js/Error) (def UnsupportedOperationException js/Error))) -(def ^:const e0 - 0) - -(def ^:const tx0 - 0x20000000) - -(def ^:const emax - 0x7FFFFFFF) - -(def ^:const txmax - 0x7FFFFFFF) - -(def ^:const implicit-schema - {:db/ident {:db/unique :db.unique/identity}}) +(def #?(:cljd e0 :default ^:const e0) 0) +(def #?(:cljd tx0 :default ^:const tx0) 0x20000000) +(def #?(:cljd emax :default ^:const emax) 0x7FFFFFFF) +(def #?(:cljd txmax :default ^:const txmax) 0x7FFFFFFF) +(def #?(:cljd implicit-schema :default ^:const implicit-schema) {:db/ident {:db/unique :db.unique/identity}}) ;; ---------------------------------------------------------------------------- -(defn #?@(:clj [^Boolean seqable?] - :cljs [^boolean seqable?]) +#?(:clj + (defmacro raise [& fragments] + (let [msgs (butlast fragments) + data (last fragments)] + `(throw (ex-info (str ~@(map (fn [m#] (if (string? m#) m# (list 'pr-str m#))) msgs)) ~data))))) + +(defn ^#?(:cljd bool :clj Boolean :cljs boolean) seqable? [x] (and (not (string? x)) - #?(:cljs (or (cljs.core/seqable? x) + #?(:cljd (cljd.core/seqable? x) + :cljs (or (cljs.core/seqable? x) (arrays/array? x)) :clj (or (seq? x) (instance? clojure.lang.Seqable x) @@ -52,6 +51,30 @@ (arrays/array? x) (instance? java.util.Map x))))) + +#?(:clj +(defmacro some-of + ([] nil) + ([x] x) + ([x & more] + `(let [x# ~x] (if (nil? x#) (some-of ~@more) x#))))) + +(def conjv (fnil conj [])) +(def conjs (fnil conj #{})) + +(defn reduce-indexed + "Same as reduce, but `f` takes [acc el idx]" + [f init xs] + (first + (reduce + (fn [[acc idx] x] + (let [res (f acc x idx)] + (if (reduced? res) + (reduced [res idx]) + [res (inc idx)]))) + [init 0] + xs))) + ;; ---------------------------------------------------------------------------- ;; macros and funcs to support writing defrecords and updating ;; (replacing) builtins, i.e., Object/hashCode, IHashEq hasheq, etc. @@ -59,7 +82,7 @@ ;; https://github.com/Prismatic/schema/commit/e31c419c56555c83ef9ee834801e13ef3c112597 ;; -(defn- cljs-env? +(defn- ^:macro-support cljs-env? "Take the &env from a macro, and tell whether we are expanding into cljs." [env] (boolean (:ns env))) @@ -69,9 +92,19 @@ "Return then if we are generating cljs code and else for Clojure code. https://groups.google.com/d/msg/clojurescript/iBY5HaQda4A/w1lAQi9_AwsJ" [then else] - (if (cljs-env? &env) then else))) + #?(:cljd/clj-host true + :default + (if (cljs-env? &env) then else)))) -#?(:clj +#?(:cljd + (defn ^:macro-support patch-tag [meta cljs-env?] + (if cljs-env? + meta + (condp = (:tag meta) + 'boolean (assoc meta :tag 'bool) + 'number (assoc meta :tag 'int) + meta))) + :clj (defn patch-tag [meta cljs-env?] (if cljs-env? meta @@ -80,14 +113,24 @@ 'number (assoc meta :tag clojure.core$long) meta)))) +#?(:clj + (defmacro declare+ + "Same idea as `declare`, but allows to declare type hints and arglists. + This allows CLJS to generate more efficient code when calling this fn + before it’s declared" + [name & arglists] + (let [name' (vary-meta name patch-tag (cljs-env? &env)) + bodies (map #(list % `(throw (ex-info (str "Not implemented: (" ~name (clojure.string/join " " ~%)) {}))) arglists)] + `(defn ~name' ~@bodies)))) + #?(:clj (defmacro defn+ - "CLJS really don’t like :declared metadata on vars (generates less - efficient code), but it needs it to skip warnings. So we redefine - first with ^:declared and empty implementation, and then immediately - redefine again without ^:declared. This way both `declare` and `defn+` - versions have no ^:declared meta, thus allowing CLJS to generate direct - invocations and see type hints." + "Version of `defn` that works with `declare+`. CLJS really don’t like + :declared metadata on vars (generates less efficient code), but it + needs it to skip warnings. So we redefine first with ^:declared + and empty implementation, and then immediately redefine again without ^:declared. + This way both `declare+`-d and `defn+`-d versions have no ^:declared meta, + thus allowing CLJS to generate direct invocations and see type hints." [name & rest] (let [name' (vary-meta name patch-tag (cljs-env? &env)) arglists (if (vector? (first rest)) @@ -100,21 +143,24 @@ `(defn ~name' ~@rest))))) (defn combine-hashes [x y] - #?(:clj (clojure.lang.Util/hashCombine x y) + #?(:cljd (hash-combine x y) + :clj (clojure.lang.Util/hashCombine x y) :cljs (hash-combine x y))) -#?(:clj +#?(:cljd nil + :clj (defn- get-sig [method] ;; expects something like '(method-symbol [arg arg arg] ...) ;; if the thing matches, returns [fully-qualified-symbol arity], otherwise nil (and (sequential? method) - (symbol? (first method)) - (vector? (second method)) - (let [sym (first method) - ns (or (some->> sym resolve meta :ns str) "clojure.core")] - [(symbol ns (name sym)) (-> method second count)])))) - -#?(:clj + (symbol? (first method)) + (vector? (second method)) + (let [sym (first method) + ns (or (some->> sym resolve meta :ns str) "clojure.core")] + [(symbol ns (name sym)) (-> method second count)])))) + +#?(:cljd nil + :clj (defn- dedupe-interfaces [deftype-form] ;; get the interfaces list, remove any duplicates, similar to remove-nil-implements in potemkin ;; verified w/ deftype impl in compiler: @@ -124,20 +170,21 @@ (throw (IllegalArgumentException. "deftype-form mismatch"))) (list* deftype* tagname classname fields implements (vec (distinct interfaces)) rest)))) -#?(:clj +#?(:cljd nil + :clj (defn- make-record-updatable-clj [name fields & impls] (let [impl-map (->> impls (map (juxt get-sig identity)) (filter first) (into {})) body (macroexpand-1 (list* 'defrecord name fields impls))] (clojure.walk/postwalk - (fn [form] - (if (and (sequential? form) (= 'deftype* (first form))) - (->> form - dedupe-interfaces - (remove (fn [method] - (when-some [impl (-> method get-sig impl-map)] - (not= method impl))))) - form)) - body)))) + (fn [form] + (if (and (sequential? form) (= 'deftype* (first form))) + (->> form + dedupe-interfaces + (remove (fn [method] + (when-some [impl (-> method get-sig impl-map)] + (not= method impl))))) + form)) + body)))) #?(:clj (defn- make-record-updatable-cljs [name fields & impls] @@ -147,29 +194,29 @@ #?(:clj (defmacro defrecord-updatable [name fields & impls] - `(if-cljs - ~(apply make-record-updatable-cljs name fields impls) - ~(apply make-record-updatable-clj name fields impls)))) + #?(:cljd + `(defrecord ~name ~fields ~@(for [impl impls] + (if (seq? impl) + (cons (vary-meta (first impl) assoc :override true) (next impl)) + impl))) + :default + `(if-cljs + ~(apply make-record-updatable-cljs name fields impls) + ~(apply make-record-updatable-clj name fields impls))))) ;; ---------------------------------------------------------------------------- -#?(:clj (declare hash-datom) - :cljs (defn ^number hash-datom [d])) +(declare+ ^#?(:cljd int :default number) hash-datom [d]) -#?(:clj (declare equiv-datom) - :cljs (defn ^boolean equiv-datom [d o])) +(declare+ ^#?(:cljd bool :default boolean) equiv-datom [d o]) -#?(:clj (declare seq-datom) - :cljs (defn seq-datom [d])) +(declare+ seq-datom [d]) -#?(:clj (declare nth-datom) - :cljs (defn nth-datom ([d i]) ([d i not-found]))) +(declare+ nth-datom [d i] [d i not-found]) -#?(:clj (declare assoc-datom) - :cljs (defn assoc-datom [d k v])) +(declare+ assoc-datom [d k v]) -#?(:clj (declare val-at-datom) - :cljs (defn val-at-datom [d k not-found])) +(declare+ val-at-datom [d k not-found]) (defprotocol IDatom (datom-tx [this]) @@ -177,7 +224,8 @@ (datom-get-idx [this]) (datom-set-idx [this value])) -(deftype Datom #?(:clj [^int e a v ^int tx ^:unsynchronized-mutable ^int idx ^:unsynchronized-mutable ^int _hash] +(deftype Datom #?(:cljd [^int e a v ^int tx ^:mutable ^int idx ^:mutable ^int _hash] + :clj [^int e a v ^int tx ^:unsynchronized-mutable ^int idx ^:unsynchronized-mutable ^int _hash] :cljs [^number e a v ^number tx ^:mutable ^number idx ^:mutable ^number _hash]) IDatom (datom-tx [d] (if (pos? tx) tx (- tx))) @@ -186,66 +234,93 @@ (datom-set-idx [_ value] (set! idx (int value))) #?@(:cljs - [IHash - (-hash [d] (if (zero? _hash) - (set! _hash (hash-datom d)) - _hash)) - IEquiv - (-equiv [d o] (and (instance? Datom o) (equiv-datom d o))) - - ISeqable - (-seq [d] (seq-datom d)) - - ILookup - (-lookup [d k] (val-at-datom d k nil)) - (-lookup [d k nf] (val-at-datom d k nf)) - - IIndexed - (-nth [this i] (nth-datom this i)) - (-nth [this i not-found] (nth-datom this i not-found)) - - IAssociative - (-assoc [d k v] (assoc-datom d k v)) - - IPrintWithWriter - (-pr-writer [d writer opts] - (pr-sequential-writer writer pr-writer - "#datascript/Datom [" " " "]" - opts [(.-e d) (.-a d) (.-v d) (datom-tx d) (datom-added d)]))] + [IHash + (-hash [d] (if (zero? _hash) + (set! _hash (hash-datom d)) + _hash)) + IEquiv + (-equiv [d o] (and (instance? Datom o) (equiv-datom d o))) + + ISeqable + (-seq [d] (seq-datom d)) + + ILookup + (-lookup [d k] (val-at-datom d k nil)) + (-lookup [d k nf] (val-at-datom d k nf)) + + IIndexed + (-nth [this i] (nth-datom this i)) + (-nth [this i not-found] (nth-datom this i not-found)) + + IAssociative + (-assoc [d k v] (assoc-datom d k v)) + + IPrintWithWriter + (-pr-writer [d writer opts] + (pr-sequential-writer writer pr-writer + "#datascript/Datom [" " " "]" + opts [(.-e d) (.-a d) (.-v d) (datom-tx d) (datom-added d)]))] + :cljd + [cljd.core/IHash + (-hash [d] (if (zero? _hash) + (set! _hash (hash-datom d)) + _hash)) + cljd.core/IEquiv + (-equiv [d o] (and (dart/is? o Datom) (equiv-datom d o))) + + cljd.core/ISeqable + (-seq [d] (seq-datom d)) + + cljd.core/ILookup + (-lookup [d k] (val-at-datom d k nil)) + (-lookup [d k nf] (val-at-datom d k nf)) + + cljd.core/IIndexed + (-nth [this i] (nth-datom this i)) + (-nth [this i not-found] (nth-datom this i not-found)) + + cljd.core/IAssociative + (-assoc [d k v] (assoc-datom d k v)) + + cljd.core/IPrint + (-print [d sink] + (.write ^StringSink sink "#datascript/Datom ") + (-print [(.-e d) (.-a d) (.-v d) (datom-tx d) (datom-added d)] sink))] :clj - [Object - (hashCode [d] - (if (zero? _hash) - (let [h (int (hash-datom d))] - (set! _hash h) - h) - _hash)) - (toString [d] (pr-str d)) - - clojure.lang.IHashEq - (hasheq [d] (.hashCode d)) - - clojure.lang.Seqable - (seq [d] (seq-datom d)) - - clojure.lang.IPersistentCollection - (equiv [d o] (and (instance? Datom o) (equiv-datom d o))) - (empty [d] (throw (UnsupportedOperationException. "empty is not supported on Datom"))) - (count [d] 5) - (cons [d [k v]] (assoc-datom d k v)) - - clojure.lang.Indexed - (nth [this i] (nth-datom this i)) - (nth [this i not-found] (nth-datom this i not-found)) - - clojure.lang.ILookup - (valAt [d k] (val-at-datom d k nil)) - (valAt [d k nf] (val-at-datom d k nf)) - - clojure.lang.Associative - (entryAt [d k] (some->> (val-at-datom d k nil) (clojure.lang.MapEntry k))) - (containsKey [e k] (#{:e :a :v :tx :added} k)) - (assoc [d k v] (assoc-datom d k v))])) + [Object + (hashCode [d] + (if (zero? _hash) + (let [h (int (hash-datom d))] + (set! _hash h) + h) + _hash)) + (toString [d] (pr-str d)) + + clojure.lang.IHashEq + (hasheq [d] (.hashCode d)) + + clojure.lang.Seqable + (seq [d] (seq-datom d)) + + clojure.lang.IPersistentCollection + (equiv [d o] (and (instance? Datom o) (equiv-datom d o))) + (empty [d] (throw (UnsupportedOperationException. "empty is not supported on Datom"))) + (count [d] 5) + (cons [d [k v]] (assoc-datom d k v)) + + clojure.lang.Indexed + (nth [this i] (nth-datom this i)) + (nth [this i not-found] (nth-datom this i not-found)) + + clojure.lang.ILookup + (valAt [d k] (val-at-datom d k nil)) + (valAt [d k nf] (val-at-datom d k nf)) + + clojure.lang.Associative + (entryAt [d k] (some->> (val-at-datom d k nil) (clojure.lang.MapEntry k))) + (containsKey [e k] (#{:e :a :v :tx :added} k)) + (assoc [d k v] (assoc-datom d k v))] +)) #?(:cljs (goog/exportSymbol "datascript.db.Datom" Datom)) @@ -254,17 +329,17 @@ ([e a v tx] (Datom. e a v tx 0 0)) ([e a v tx added] (Datom. e a v (if added tx (- tx)) 0 0))) -(defn datom? [x] (instance? Datom x)) +(defn datom? [x] #?(:cljd (dart/is? x Datom) :default (instance? Datom x))) (defn+ ^:private hash-datom [^Datom d] (-> (hash (.-e d)) - (combine-hashes (hash (.-a d))) - (combine-hashes (hash (.-v d))))) + (combine-hashes (hash (.-a d))) + (combine-hashes (hash (.-v d))))) (defn+ ^:private equiv-datom [^Datom d ^Datom o] (and (== (.-e d) (.-e o)) - (= (.-a d) (.-a o)) - (= (.-v d) (.-v o)))) + (= (.-a d) (.-a o)) + (= (.-v d) (.-v o)))) (defn+ ^:private seq-datom [^Datom d] (list (.-e d) (.-a d) (.-v d) (datom-tx d) (datom-added d))) @@ -281,7 +356,7 @@ :tx (datom-tx d) :added (datom-added d) not-found) - + (string? k) (case k "e" (.-e d) @@ -290,21 +365,22 @@ "tx" (datom-tx d) "added" (datom-added d) not-found) - + :else not-found)) (defn+ ^:private nth-datom - ([^Datom d ^long i] + ([^Datom d ^#?(:cljd int :default long) i] (case i 0 (.-e d) 1 (.-a d) 2 (.-v d) 3 (datom-tx d) 4 (datom-added d) - #?(:clj (throw (IndexOutOfBoundsException.)) + #?(:cljd (throw (IndexError.withLength i 5)) + :clj (throw (IndexOutOfBoundsException.)) :cljs (throw (js/Error. (str "Datom/-nth: Index out of bounds: " i)))))) - ([^Datom d ^long i not-found] + ([^Datom d ^#?(:cljd int :default long) i not-found] (case i 0 (.-e d) 1 (.-a d) @@ -320,7 +396,9 @@ :v (datom (.-e d) (.-a d) v (datom-tx d) (datom-added d)) :tx (datom (.-e d) (.-a d) (.-v d) v (datom-added d)) :added (datom (.-e d) (.-a d) (.-v d) (datom-tx d) v) - (throw (IllegalArgumentException. (str "invalid key for #datascript/Datom: " k))))) + (let [msg (str "invalid key for #datascript/Datom: " k)] + (throw #?(:cljd (ArgumentError msg) + :default (IllegalArgumentException. msg)))))) ;; printing and reading ;; #datomic/DB {:schema , :datoms } @@ -328,7 +406,8 @@ (defn ^Datom datom-from-reader [vec] (apply datom vec)) -#?(:clj +#?(:cljd nil + :clj (defmethod print-method Datom [^Datom d, ^java.io.Writer w] (.write w (str "#datascript/Datom ")) (binding [*out* w] @@ -339,26 +418,26 @@ ;; #?(:clj - (defmacro combine-cmp [& comps] - (loop [comps (reverse comps) - res (num 0)] - (if (not-empty comps) - (recur - (next comps) - `(let [c# ~(first comps)] - (if (== 0 c#) - ~res - c#))) - res)))) + (defmacro combine-cmp [& comps] + (loop [comps (reverse comps) + res 0] + (if (not-empty comps) + (recur + (next comps) + `(let [c# ~(first comps)] + (if (== 0 c#) + ~res + c#))) + res)))) #?(:clj - (defn- -case-tree [queries variants] + (defn- ^:macro-support -case-tree [queries variants] (if queries (let [v1 (take (/ (count variants) 2) variants) v2 (drop (/ (count variants) 2) variants)] (list 'if (first queries) - (-case-tree (next queries) v1) - (-case-tree (next queries) v2))) + (-case-tree (next queries) v1) + (-case-tree (next queries) v2))) (first variants)))) #?(:clj @@ -366,21 +445,34 @@ (-case-tree qs vs))) (defn cmp - #?(:clj + #?(:cljd {} + :clj {:inline (fn [x y] `(let [x# ~x y# ~y] (if (nil? x#) 0 (if (nil? y#) 0 (long (compare x# y#))))))}) - ^long [x y] - (if (nil? x) 0 (if (nil? y) 0 (long (compare x y))))) - -(defn class-identical? - #?(:clj {:inline (fn [x y] `(identical? (class ~x) (class ~y)))}) - [x y] - #?(:clj (identical? (class x) (class y)) - :cljs (identical? (type x) (type y)))) - -#?(:clj + ^#?(:cljd int :default long) [x y] + #?(:cljd + (cond + (identical? x y) 0 + (identical? x MIN) -1 + (identical? y MIN) 1 + (identical? y MAX) -1 + (identical? x MAX) 1 + :else (int (compare x y))) + :default + (if (nil? x) 0 (if (nil? y) 0 (long (compare x y)))))) + +#?(:cljd nil + :default + (defn class-identical? + #?(:clj {:inline (fn [x y] `(identical? (class ~x) (class ~y)))}) + [x y] + #?(:clj (identical? (class x) (class y)) + :cljs (identical? (type x) (type y))))) + +#?(:cljd nil + :clj (defn class-name {:inline (fn [x] @@ -388,92 +480,92 @@ (if (nil? x#) x# (.getName (. x# (getClass))))))} ^String [^Object x] (if (nil? x) x (.getName (. x (getClass)))))) -(defn class-compare - ^long [x y] - #?(:clj (long (compare (class-name x) (class-name y))) - :cljs (garray/defaultCompare (type->str (type x)) (type->str (type y))))) +#?(:cljd nil + :default + (defn class-compare + ^long [x y] + #?(:clj (long (compare (class-name x) (class-name y))) + :cljs (garray/defaultCompare (type->str (type x)) (type->str (type y)))))) -#?(:clj +#?(:cljd (defmacro int-compare [x y] - `(if-cljs - (- ~x ~y) - (long (Integer/compare ~x ~y))))) + `(- ~x ~y)) + :clj + (defmacro int-compare [x y] + `(if-cljs + (- ~x ~y) + (long (Integer/compare ~x ~y))))) (defn ihash {:inline (fn [x] `(. clojure.lang.Util (hasheq ~x)))} - ^long [x] - #?(:clj (. clojure.lang.Util (hasheq x)) + ^#?(:cljd int :default long) [x] + #?(:cljd (hash x) + :clj (. clojure.lang.Util (hasheq x)) :cljs (hash x))) -#?(:clj (declare value-compare) - :cljs (defn ^number value-compare [x y])) +#?(:cljd + (defn value-compare ^int [x y] + #_(compare x y) + (try + (if (= x y) + 0 + (compare x y)) + (catch Object e + (- (hash x) (hash y))))) + :default + (defn value-compare + ^long [x y] + (try + (cond + (= x y) 0 + #?@(:clj [(instance? Number x) (clojure.lang.Numbers/compare x y)]) + #?@(:clj [(instance? Comparable x) (.compareTo ^Comparable x y)] + :cljs [(satisfies? IComparable x) (-compare x y)]) + (not (class-identical? x y)) (class-compare x y) + #?@(:cljs [(or (number? x) (string? x) (array? x) (true? x) (false? x)) (garray/defaultCompare x y)]) + :else (int-compare (ihash x) (ihash y))) + (catch #?(:clj ClassCastException :cljs js/Error) e + (if (not (class-identical? x y)) + (class-compare x y) + (throw e)))))) + +#?(:cljd + (do + (def MIN ^:unique (Object)) + (def MAX nil #_ ^:unique (Object)))) -(defn- seq-compare [xs ys] - (let [cx (count xs) - cy (count ys)] - (cond - (< cx cy) - -1 - - (> cx cy) - 1 - - :else - (loop [xs xs - ys ys] - (if (empty? xs) - 0 - (let [x (first xs) - y (first ys)] - (cond - (and (nil? x) (nil? y)) - (recur (next xs) (next ys)) - - (nil? x) - -1 - - (nil? y) - 1 - - :else - (let [v (value-compare x y)] - (if (= v 0) - (recur (next xs) (next ys)) - v))))))))) - -(defn+ ^number value-compare [x y] - (try - (cond - (= x y) 0 - (and (sequential? x) (sequential? y)) (seq-compare x y) - #?@(:clj [(instance? Number x) (clojure.lang.Numbers/compare x y)]) - #?@(:clj [(instance? Comparable x) (.compareTo ^Comparable x y)] - :cljs [(satisfies? IComparable x) (-compare x y)]) - (not (class-identical? x y)) (class-compare x y) - #?@(:cljs [(or (number? x) (string? x) (array? x) (true? x) (false? x)) (garray/defaultCompare x y)]) - :else (int-compare (ihash x) (ihash y))) - (catch #?(:clj ClassCastException :cljs js/Error) e - (if (not (class-identical? x y)) - (class-compare x y) - (throw e))))) - -(defn value-cmp - #?(:clj - {:inline - (fn [x y] - `(let [x# ~x y# ~y] - (if (nil? x#) 0 (if (nil? y#) 0 (value-compare x# y#)))))}) - ^long [x y] - (if (nil? x) - 0 - (if (nil? y) - 0 - (value-compare x y)))) +#?(:cljd + (defn value-cmp + ^int [x y] + (cond + (identical? x y) 0 + (identical? x MIN) -1 + (identical? y MIN) 1 + (identical? y MAX) -1 + (identical? x MAX) 1 + :else (value-compare x y))) + :default + (defn value-cmp + #?(:clj + {:inline + (fn [x y] + `(let [x# ~x y# ~y] + (if (nil? x#) 0 (if (nil? y#) 0 (value-compare x# y#)))))}) + ^long [x y] + (if (nil? x) + 0 + (if (nil? y) + 0 + (value-compare x y))))) ;; Slower cmp-* fns allows for datom fields to be nil. ;; Such datoms come from slice method where they are used as boundary markers. -#?(:clj +#?(:cljd + (defmacro defcomp [sym [arg1 arg2] & body] + `(defn ~sym ^int [~arg1 ~arg2] + ~@body)) + :clj (defmacro defcomp [sym [arg1 arg2] & body] (let [a1 (with-meta arg1 {}) a2 (with-meta arg2 {})] @@ -517,16 +609,19 @@ ;; fast versions without nil checks (defn- cmp-attr-quick - #?(:clj + #?(:cljd + {} + :clj {:inline (fn [a1 a2] `(long (.compareTo ~(with-meta a1 {:tag "Comparable"}) ~a2)))}) - ^long [a1 a2] + ^#?(:cljd int :default long) [a1 a2] ;; either both are keywords or both are strings #?(:cljs (if (keyword? a1) (-compare a1 a2) (garray/defaultCompare a1 a2)) + :cljd (compare a1 a2) ; TODO take shortcuts :clj (.compareTo ^Comparable a1 a2))) @@ -557,6 +652,15 @@ (int-compare (.-e d1) (.-e d2)) (int-compare (datom-tx d1) (datom-tx d2)))) +#?(:cljd + (do + (def cmp-datoms-eavt-cmp (set/as-cmp cmp-datoms-eavt)) + (def cmp-datoms-aevt-cmp (set/as-cmp cmp-datoms-aevt)) + (def cmp-datoms-avet-cmp (set/as-cmp cmp-datoms-avet)) + (def cmp-datoms-eavt-quick-cmp (set/as-cmp cmp-datoms-eavt-quick)) + (def cmp-datoms-aevt-quick-cmp (set/as-cmp cmp-datoms-aevt-quick)) + (def cmp-datoms-avet-quick-cmp (set/as-cmp cmp-datoms-avet-quick)))) + (defn- diff-sorted [a b cmp] (loop [only-a [] only-b [] @@ -571,7 +675,7 @@ first-b (first b) diff (try (cmp first-a first-b) - (catch #?(:clj ClassCastException :cljs js/Error) _ + (catch #?(:cljd Exception :clj ClassCastException :cljs js/Error) _ :incomparable))] (cond (= diff :incomparable) (recur (conj only-a first-a) (conj only-b first-b) both (next a) (next b)) @@ -581,28 +685,22 @@ ;; ---------------------------------------------------------------------------- -#?(:clj (declare hash-db) - :cljs (defn ^number hash-db [db])) +(declare+ ^#?(:cljd int :default number) hash-db [db]) -#?(:clj (declare hash-fdb) - :cljs (defn ^number hash-fdb [db])) +(declare+ ^#?(:cljd int :default number) hash-fdb [db]) -#?(:clj (declare equiv-db) - :cljs (defn ^boolean equiv-db [db other])) +(declare+ ^#?(:cljd bool :default boolean) equiv-db [db other]) -#?(:clj (declare restore-db) - :cljs (defn restore-db [keys])) +(declare+ restore-db [keys]) -#?(:clj (declare indexing?) - :cljs (defn ^boolean indexing? [db attr])) +(declare+ ^#?(:cljd bool :default boolean) indexing? [db attr]) -#?(:cljs (defn pr-db [db w opts])) +#?(:cljs + (declare+ pr-db [db w opts])) -#?(:clj (declare resolve-datom) - :cljs (defn resolve-datom [db e a v t default-e default-tx])) +(declare+ resolve-datom [db e a v t default-e default-tx]) -#?(:clj (declare components->pattern) - :cljs (defn components->pattern [db index c0 c1 c2 c3 default-e default-tx])) +(declare+ components->pattern [db index c0 c1 c2 c3 default-e default-tx]) ;;;;;;;;;; Fast validation @@ -613,14 +711,14 @@ (keyword? attr#) (string? attr#)) (let [at# ~at] - (util/raise "Bad entity attribute " attr# " at " at# ", expected keyword or string" + (raise "Bad entity attribute " attr# " at " at# ", expected keyword or string" {:error :transact/syntax, :attribute attr#, :context at#})))))) #?(:clj (defmacro validate-val [v at] `(when (nil? ~v) (let [at# ~at] - (util/raise "Cannot store nil as a value at " at# + (raise "Cannot store nil as a value at " at# {:error :transact/syntax, :value nil, :context at#}))))) ;;;;;;;;;; Searching @@ -628,7 +726,7 @@ (defprotocol ISearch (-search [data pattern])) -(defn- ^Datom fsearch [data pattern] +(defn- ^#?(:cljd Datom? :default Datom) fsearch [data pattern] (first (-search data pattern))) (defprotocol IIndexAccess @@ -641,7 +739,7 @@ (when (= index :avet) (when-some [attr c0] (when-not (indexing? db attr) - (util/raise "Attribute " attr " should be marked as :db/index true" + (raise "Attribute " attr " should be marked as :db/index true" {:error :index-access :index :avet :components [c0 c1 c2 c3]}))))) (defprotocol IDB @@ -662,17 +760,48 @@ (update :aevt persistent!) (update :avet persistent!))) -#?(:clj - (defn vpred [v] - (cond - (string? v) (fn [x] (if (string? x) (.equals ^String v x) false)) - (int? v) (fn [x] (if (int? x) (= (long v) (long x)) false)) - (keyword? v) (fn [x] (.equals ^Object v x)) - (nil? v) (fn [x] (nil? x)) - :else (fn [x] (= v x))))) +#?(:cljd nil + :clj + (defn vpred [v] + (cond + (string? v) (fn [x] (if (string? x) (.equals ^String v x) false)) + (int? v) (fn [x] (if (int? x) (= (long v) (long x)) false)) + (keyword? v) (fn [x] (.equals ^Object v x)) + (nil? v) (fn [x] (nil? x)) + :else (fn [x] (= v x))))) + +#?(:cljd + (do + (defn ^Datom min-datom [^Datom {:flds [e a v tx]}] + (datom (if (nil? e) MIN e) (if (nil? a) MIN a) (if (nil? v) MIN v) tx)) + (defn ^Datom max-datom [^Datom {:flds [e a v tx]}] + (datom (if (nil? e) MAX e) (if (nil? a) MAX a) (if (nil? v) MAX v) tx)) + (defn set-slice [s ^Datom from ^Datom to] + (set/slice s (min-datom from) (max-datom to))) + (defn set-rslice [s ^Datom from ^Datom to] + (set/rslice s (max-datom from) (min-datom to))) + (defn ->Eduction [xform coll] (into [] xform coll)))) (defrecord-updatable DB [schema eavt aevt avet max-eid max-tx rschema pull-patterns pull-attrs hash] - #?@(:cljs + #?@(:cljd + [cljd.core/IHash (-hash [db] (hash-db db)) + cljd.core/IEquiv (-equiv [db other] (equiv-db db other)) + cljd.core/IReversible (-rseq [db] (-rseq (.-eavt db))) + cljd.core/ICounted (-count [db] (count (.-eavt db))) + cljd.core/IEmptyableCollection (-empty [db] + (-> (restore-db + {:schema (.-schema db) + :rschema (.-rschema db) + :eavt (empty (.-eavt db)) + :aevt (empty (.-aevt db)) + :avet (empty (.-avet db))}) + (with-meta (meta db)))) + cljd.core/IPrint (-print [db sink] (pr-db db sink)) + cljd.core/IEditableCollection (-as-transient [db] (db-transient db)) + cljd.core/ITransientCollection (-conj! [db key] (throw (ex-info "datascript.DB/conj! is not supported" {}))) + (-persistent! [db] (db-persistent! db))] + + :cljs [IHash (-hash [db] (hash-db db)) IEquiv (-equiv [db other] (equiv-db db other)) IReversible (-rseq [db] (-rseq (.-eavt db))) @@ -687,26 +816,26 @@ IPrintWithWriter (-pr-writer [db w opts] (pr-db db w opts)) IEditableCollection (-as-transient [db] (db-transient db)) ITransientCollection (-conj! [db key] (throw (ex-info "datascript.DB/conj! is not supported" {}))) - (-persistent! [db] (db-persistent! db))] + (-persistent! [db] (db-persistent! db))] :clj [Object (hashCode [db] (hash-db db)) clojure.lang.IHashEq (hasheq [db] (hash-db db)) clojure.lang.IPersistentCollection - (count [db] (count eavt)) - (equiv [db other] (equiv-db db other)) - clojure.lang.IEditableCollection - (empty [db] (-> (restore-db - {:schema (.-schema db) - :rschema (.-rschema db) - :eavt (empty (.-eavt db)) - :aevt (empty (.-aevt db)) - :avet (empty (.-avet db))}) - (with-meta (meta db)))) - (asTransient [db] (db-transient db)) + (count [db] (count eavt)) + (equiv [db other] (equiv-db db other)) + clojure.lang.IEditableCollection + (empty [db] (-> (restore-db + {:schema (.-schema db) + :rschema (.-rschema db) + :eavt (empty (.-eavt db)) + :aevt (empty (.-aevt db)) + :avet (empty (.-avet db))}) + (with-meta (meta db)))) + (asTransient [db] (db-transient db)) clojure.lang.ITransientCollection - (conj [db key] (throw (ex-info "datascript.DB/conj! is not supported" {}))) - (persistent [db] (db-persistent! db))]) + (conj [db key] (throw (ex-info "datascript.DB/conj! is not supported" {}))) + (persistent [db] (db-persistent! db))]) IDB (-schema [db] (.-schema db)) @@ -718,68 +847,90 @@ eavt (.-eavt db) aevt (.-aevt db) avet (.-avet db) - pred #?(:clj (vpred v) + pred #?(:cljd #(= v %) + :clj (vpred v) :cljs #(= v %)) - multival? (contains? (-attrs-by db :db.cardinality/many) a)] + multival? (contains? (-attrs-by db :db.cardinality/many) a) + slice #?(:cljd set-slice :default set/slice)] (case-tree [e a (some? v) tx] - [(set/slice eavt (datom e a v tx) (datom e a v tx)) ;; e a v tx - (set/slice eavt (datom e a v tx0) (datom e a v txmax)) ;; e a v _ - (->> (set/slice eavt (datom e a nil tx0) (datom e a nil txmax)) ;; e a _ tx + [(slice eavt (datom e a v tx) (datom e a v tx)) ;; e a v tx + (slice eavt (datom e a v tx0) (datom e a v txmax)) ;; e a v _ + (->> (slice eavt (datom e a nil tx0) (datom e a nil txmax)) ;; e a _ tx (->Eduction (filter (fn [^Datom d] (= tx (datom-tx d)))))) - (set/slice eavt (datom e a nil tx0) (datom e a nil txmax)) ;; e a _ _ - (->> (set/slice eavt (datom e nil nil tx0) (datom e nil nil txmax)) ;; e _ v tx + (slice eavt (datom e a nil tx0) (datom e a nil txmax)) ;; e a _ _ + (->> (slice eavt (datom e nil nil tx0) (datom e nil nil txmax)) ;; e _ v tx (->Eduction (filter (fn [^Datom d] (and (pred (.-v d)) - (= tx (datom-tx d))))))) - (->> (set/slice eavt (datom e nil nil tx0) (datom e nil nil txmax)) ;; e _ v _ + (= tx (datom-tx d))))))) + (->> (slice eavt (datom e nil nil tx0) (datom e nil nil txmax)) ;; e _ v _ (->Eduction (filter (fn [^Datom d] (pred (.-v d)))))) - (->> (set/slice eavt (datom e nil nil tx0) (datom e nil nil txmax)) ;; e _ _ tx + (->> (slice eavt (datom e nil nil tx0) (datom e nil nil txmax)) ;; e _ _ tx (->Eduction (filter (fn [^Datom d] (= tx (datom-tx d)))))) - (set/slice eavt (datom e nil nil tx0) (datom e nil nil txmax)) ;; e _ _ _ + (slice eavt (datom e nil nil tx0) (datom e nil nil txmax)) ;; e _ _ _ (if (indexing? db a) ;; _ a v tx - (->> (set/slice avet (datom e0 a v tx0) (datom emax a v txmax)) + (->> (slice avet (datom e0 a v tx0) (datom emax a v txmax)) (->Eduction (filter (fn [^Datom d] (= tx (datom-tx d)))))) - (->> (set/slice aevt (datom e0 a nil tx0) (datom emax a nil txmax)) + (->> (slice aevt (datom e0 a nil tx0) (datom emax a nil txmax)) (->Eduction (filter (fn [^Datom d] (and (pred (.-v d)) - (= tx (datom-tx d)))))))) + (= tx (datom-tx d)))))))) (if (indexing? db a) ;; _ a v _ - (set/slice avet (datom e0 a v tx0) (datom emax a v txmax)) - (->> (set/slice aevt (datom e0 a nil tx0) (datom emax a nil txmax)) + (slice avet (datom e0 a v tx0) (datom emax a v txmax)) + (->> (slice aevt (datom e0 a nil tx0) (datom emax a nil txmax)) (->Eduction (filter (fn [^Datom d] (pred (.-v d))))))) - (->> (set/slice aevt (datom e0 a nil tx0) (datom emax a nil txmax)) ;; _ a _ tx + (->> (slice aevt (datom e0 a nil tx0) (datom emax a nil txmax)) ;; _ a _ tx (->Eduction (filter (fn [^Datom d] (= tx (datom-tx d)))))) - (set/slice aevt (datom e0 a nil tx0) (datom emax a nil txmax)) ;; _ a _ _ - (filter (fn [^Datom d] (and (pred (.-v d)) - (= tx (datom-tx d)))) eavt) ;; _ _ v tx - (filter (fn [^Datom d] (pred (.-v d))) eavt) ;; _ _ v - (filter (fn [^Datom d] (= tx (datom-tx d))) eavt) ;; _ _ _ tx + (slice aevt (datom e0 a nil tx0) (datom emax a nil txmax)) ;; _ a _ _ + (->Eduction (filter (fn [^Datom d] (and (pred (.-v d)) + (= tx (datom-tx d))))) eavt) ;; _ _ v tx + (->Eduction (filter (fn [^Datom d] (pred (.-v d)))) eavt) ;; _ _ v + (->Eduction (filter (fn [^Datom d] (= tx (datom-tx d)))) eavt) ;; _ _ _ tx eavt]))) ;; _ _ _ _ IIndexAccess (-datoms [db index c0 c1 c2 c3] (validate-indexed db index c0 c1 c2 c3) - (set/slice (get db index) - (components->pattern db index c0 c1 c2 c3 e0 tx0) - (components->pattern db index c0 c1 c2 c3 emax txmax))) + #?(:cljd + (set-slice (case index :eavt (.-eavt db) :aevt (.-aevt db) :avet (.-avet db)) + (components->pattern db index c0 c1 c2 c3 e0 tx0) + (components->pattern db index c0 c1 c2 c3 emax txmax)) + :default + (set/slice (get db index) + (components->pattern db index c0 c1 c2 c3 e0 tx0) + (components->pattern db index c0 c1 c2 c3 emax txmax)))) (-seek-datoms [db index c0 c1 c2 c3] (validate-indexed db index c0 c1 c2 c3) - (set/slice (get db index) - (components->pattern db index c0 c1 c2 c3 e0 tx0) - (datom emax nil nil txmax))) + #?(:cljd + (set-slice (case index :eavt (.-eavt db) :aevt (.-aevt db) :avet (.-avet db)) + (components->pattern db index c0 c1 c2 c3 e0 tx0) + (datom emax nil nil txmax)) + :default + (set/slice (get db index) + (components->pattern db index c0 c1 c2 c3 e0 tx0) + (datom emax nil nil txmax)))) (-rseek-datoms [db index c0 c1 c2 c3] (validate-indexed db index c0 c1 c2 c3) - (set/rslice (get db index) - (components->pattern db index c0 c1 c2 c3 emax txmax) - (datom e0 nil nil tx0))) + #?(:cljd + (set-rslice (case index :eavt (.-eavt db) :aevt (.-aevt db) :avet (.-avet db)) + (components->pattern db index c0 c1 c2 c3 emax txmax) + (datom e0 nil nil tx0)) + :default + (set/rslice (get db index) + (components->pattern db index c0 c1 c2 c3 emax txmax) + (datom e0 nil nil tx0)))) (-index-range [db attr start end] (validate-indexed db :avet attr nil nil nil) (validate-attr attr (list '-index-range 'db attr start end)) - (set/slice (.-avet db) - (resolve-datom db nil attr start nil e0 tx0) - (resolve-datom db nil attr end nil emax txmax))) - + #?(:cljd + (set-slice (.-avet db) + (resolve-datom db nil attr start nil e0 tx0) + (resolve-datom db nil attr end nil emax txmax)) + :default + (set/slice (.-avet db) + (resolve-datom db nil attr start nil e0 tx0) + (resolve-datom db nil attr end nil emax txmax)))) + clojure.data/EqualityPartition (equality-partition [x] :datascript/db) @@ -788,23 +939,41 @@ (diff-sorted (:eavt a) (:eavt b) cmp-datoms-eav-quick))) (defn db? [x] - #?(:clj + #?(:cljd + (and (satisfies? ISearch x) + (satisfies? IIndexAccess x) + (satisfies? IDB x)) + :clj (or - (and x - (instance? datascript.db.ISearch x) - (instance? datascript.db.IIndexAccess x) - (instance? datascript.db.IDB x)) - (and (satisfies? ISearch x) - (satisfies? IIndexAccess x) - (satisfies? IDB x))) + (and x + (instance? datascript.db.ISearch x) + (instance? datascript.db.IIndexAccess x) + (instance? datascript.db.IDB x)) + (and (satisfies? ISearch x) + (satisfies? IIndexAccess x) + (satisfies? IDB x))) :cljs (and (satisfies? ISearch x) - (satisfies? IIndexAccess x) - (satisfies? IDB x)))) + (satisfies? IIndexAccess x) + (satisfies? IDB x)))) ;; ---------------------------------------------------------------------------- (defrecord-updatable FilteredDB [unfiltered-db pred hash] - #?@(:cljs + #?@(:cljd + [cljd.core/IHash (-hash [db] (hash-fdb db)) + cljd.core/IEquiv (-equiv [db other] (equiv-db db other)) + cljd.core/ICounted (-count [db] (count (-datoms db :eavt nil nil nil nil))) + cljd.core/IPrint (-print [db sink] (pr-db db sink)) + + cljd.core/IEmptyableCollection (-empty [_] (throw (UnsupportedError "-empty is not supported on FilteredDB"))) + + cljd.core/ILookup (-lookup [_ _] (throw (UnsupportedError "-lookup is not supported on FilteredDB"))) + (-lookup [_ _ _] (throw (UnsupportedError "-lookup is not supported on FilteredDB"))) + (-contains-key? [_ _] (throw (UnsupportedError "-contains-key? is not supported on FilteredDB"))) + + + cljd.core/IAssociative (-assoc [_ _ _] (throw (UnsupportedError "-assoc is not supported on FilteredDB")))] + :cljs [IHash (-hash [db] (hash-fdb db)) IEquiv (-equiv [db other] (equiv-db db other)) ICounted (-count [db] (count (-datoms db :eavt nil nil nil nil))) @@ -813,11 +982,11 @@ IEmptyableCollection (-empty [_] (throw (js/Error. "-empty is not supported on FilteredDB"))) ILookup (-lookup ([_ _] (throw (js/Error. "-lookup is not supported on FilteredDB"))) - ([_ _ _] (throw (js/Error. "-lookup is not supported on FilteredDB")))) + ([_ _ _] (throw (js/Error. "-lookup is not supported on FilteredDB")))) IAssociative (-contains-key? [_ _] (throw (js/Error. "-contains-key? is not supported on FilteredDB"))) - (-assoc [_ _ _] (throw (js/Error. "-assoc is not supported on FilteredDB")))] + (-assoc [_ _ _] (throw (js/Error. "-assoc is not supported on FilteredDB")))] :clj [Object (hashCode [db] (hash-fdb db)) @@ -825,20 +994,20 @@ clojure.lang.IHashEq (hasheq [db] (hash-fdb db)) clojure.lang.IPersistentCollection - (count [db] (count (-datoms db :eavt nil nil nil nil))) - (equiv [db o] (equiv-db db o)) - (cons [db [k v]] (throw (UnsupportedOperationException. "cons is not supported on FilteredDB"))) - (empty [db] (throw (UnsupportedOperationException. "empty is not supported on FilteredDB"))) + (count [db] (count (-datoms db :eavt nil nil nil nil))) + (equiv [db o] (equiv-db db o)) + (cons [db [k v]] (throw (UnsupportedOperationException. "cons is not supported on FilteredDB"))) + (empty [db] (throw (UnsupportedOperationException. "empty is not supported on FilteredDB"))) clojure.lang.ILookup (valAt [db k] (throw (UnsupportedOperationException. "valAt/2 is not supported on FilteredDB"))) - (valAt [db k nf] (throw (UnsupportedOperationException. "valAt/3 is not supported on FilteredDB"))) + (valAt [db k nf] (throw (UnsupportedOperationException. "valAt/3 is not supported on FilteredDB"))) clojure.lang.IKeywordLookup (getLookupThunk [db k] - (throw (UnsupportedOperationException. "getLookupThunk is not supported on FilteredDB"))) + (throw (UnsupportedOperationException. "getLookupThunk is not supported on FilteredDB"))) clojure.lang.Associative - (containsKey [e k] (throw (UnsupportedOperationException. "containsKey is not supported on FilteredDB"))) - (entryAt [db k] (throw (UnsupportedOperationException. "entryAt is not supported on FilteredDB"))) - (assoc [db k v] (throw (UnsupportedOperationException. "assoc is not supported on FilteredDB")))]) + (containsKey [e k] (throw (UnsupportedOperationException. "containsKey is not supported on FilteredDB"))) + (entryAt [db k] (throw (UnsupportedOperationException. "entryAt is not supported on FilteredDB"))) + (assoc [db k v] (throw (UnsupportedOperationException. "assoc is not supported on FilteredDB")))]) IDB (-schema [db] @@ -865,7 +1034,8 @@ (filter (.-pred db) (-index-range (.-unfiltered-db db) attr start end)))) (defn unfiltered-db ^DB [db] - (if (instance? FilteredDB db) + (if #?(:cljd (dart/is? db FilteredDB) + :default (instance? FilteredDB db)) (.-unfiltered-db ^FilteredDB db) db)) @@ -888,7 +1058,7 @@ [schema rschema] (reduce (fn [m tuple-attr] ;; e.g. :reg/semester+course+student - (util/reduce-indexed + (reduce-indexed (fn [m src-attr idx] ;; e.g. :reg/semester (update m src-attr assoc tuple-attr idx)) m @@ -913,7 +1083,7 @@ (fn [rschema key value] (reduce (fn [rschema prop] - (update rschema prop util/conjs attr)) + (update rschema prop conjs attr)) rschema (attr->properties key value))) rschema attr-schema)) {} schema)] @@ -921,12 +1091,12 @@ (defn- validate-schema-key [a k v expected] (when-not (or (nil? v) - (contains? expected v)) + (contains? expected v)) (throw (ex-info (str "Bad attribute specification for " (pr-str {a {k v}}) ", expected one of " expected) - {:error :schema/validation - :attribute a - :key k - :value v})))) + {:error :schema/validation + :attribute a + :key k + :value v})))) (defn- validate-schema [schema] (doseq [[a kv] schema] @@ -935,7 +1105,7 @@ (let [comp? (:db/isComponent kv false)] (validate-schema-key a :db/isComponent (:db/isComponent kv) #{true false}) (when (and comp? (not= (:db/valueType kv) :db.type/ref)) - (util/raise "Bad attribute specification for " a ": {:db/isComponent true} should also have {:db/valueType :db.type/ref}" + (raise "Bad attribute specification for " a ": {:db/isComponent true} should also have {:db/valueType :db.type/ref}" {:error :schema/validation :attribute a :key :db/isComponent}))) @@ -946,11 +1116,11 @@ ;; tuple should have tupleAttrs (when (and (= :db.type/tuple (:db/valueType kv)) - (not (contains? kv :db/tupleAttrs))) - (util/raise "Bad attribute specification for " a ": {:db/valueType :db.type/tuple} should also have :db/tupleAttrs" - {:error :schema/validation - :attribute a - :key :db/valueType})) + (not (contains? kv :db/tupleAttrs))) + (raise "Bad attribute specification for " a ": {:db/valueType :db.type/tuple} should also have :db/tupleAttrs" + {:error :schema/validation + :attribute a + :key :db/valueType})) ;; :db/tupleAttrs is a non-empty sequential coll (when (contains? kv :db/tupleAttrs) @@ -958,77 +1128,73 @@ :attribute a :key :db/tupleAttrs}] (when (= :db.cardinality/many (:db/cardinality kv)) - (util/raise a " has :db/tupleAttrs, must be :db.cardinality/one" ex-data)) + (raise a " has :db/tupleAttrs, must be :db.cardinality/one" ex-data)) (let [attrs (:db/tupleAttrs kv)] (when-not (sequential? attrs) - (util/raise a " :db/tupleAttrs must be a sequential collection, got: " attrs ex-data)) + (raise a " :db/tupleAttrs must be a sequential collection, got: " attrs ex-data)) (when (empty? attrs) - (util/raise a " :db/tupleAttrs can’t be empty" ex-data)) + (raise a " :db/tupleAttrs can’t be empty" ex-data)) (doseq [attr attrs :let [ex-data (assoc ex-data :value attr)]] (when (contains? (get schema attr) :db/tupleAttrs) - (util/raise a " :db/tupleAttrs can’t depend on another tuple attribute: " attr ex-data)) + (raise a " :db/tupleAttrs can’t depend on another tuple attribute: " attr ex-data)) (when (= :db.cardinality/many (:db/cardinality (get schema attr))) - (util/raise a " :db/tupleAttrs can’t depend on :db.cardinality/many attribute: " attr ex-data)))))))) - + (raise a " :db/tupleAttrs can’t depend on :db.cardinality/many attribute: " attr ex-data)))))))) + (defn ^DB empty-db [schema opts] {:pre [(or (nil? schema) (map? schema))]} (validate-schema schema) (map->DB - {:schema schema - :rschema (rschema (merge implicit-schema schema)) - :eavt (set/sorted-set* (assoc opts :cmp cmp-datoms-eavt)) - :aevt (set/sorted-set* (assoc opts :cmp cmp-datoms-aevt)) - :avet (set/sorted-set* (assoc opts :cmp cmp-datoms-avet)) - :max-eid e0 - :max-tx tx0 - :pull-patterns (lru/cache 100) - :pull-attrs (lru/cache 100) - :hash (atom 0)})) + {:schema schema + :rschema (rschema (merge implicit-schema schema)) + :eavt (set/sorted-set* (assoc opts :cmp #?(:cljd cmp-datoms-eavt-cmp :default cmp-datoms-eavt))) + :aevt (set/sorted-set* (assoc opts :cmp #?(:cljd cmp-datoms-aevt-cmp :default cmp-datoms-aevt))) + :avet (set/sorted-set* (assoc opts :cmp #?(:cljd cmp-datoms-avet-cmp :default cmp-datoms-avet))) + :max-eid e0 + :max-tx tx0 + :pull-patterns (lru/cache 100) + :pull-attrs (lru/cache 100) + :hash (atom 0)})) -(defn- init-max-eid [rschema eavt avet] - (let [max #(if (and %2 (> %2 %1)) %2 %1) - max-eid (some-> - (set/rslice eavt - (datom (dec tx0) nil nil txmax) - (datom e0 nil nil tx0)) - first :e) - res (max e0 max-eid) - max-ref (fn [attr] - (some-> - (set/rslice avet - (datom (dec tx0) attr (dec tx0) txmax) - (datom e0 attr e0 tx0)) - first :v)) - refs (:db.type/ref rschema) - res (reduce - (fn [res attr] - (max res (max-ref attr))) - res refs)] - res)) +(defn- init-max-eid [eavt] + (or (-> (set/rslice eavt (datom (dec tx0) nil nil txmax) (datom e0 nil nil tx0)) + (first) + (:e)) + e0)) (defn ^DB init-db [datoms schema opts] (when-some [not-datom (first (drop-while datom? datoms))] - (util/raise "init-db expects list of Datoms, got " (type not-datom) + (raise "init-db expects list of Datoms, got " #?(:cljd + (some-> not-datom .-runtimeType) + :default (type not-datom)) {:error :init-db})) (validate-schema schema) (let [rschema (rschema (merge implicit-schema schema)) indexed (:db/index rschema) - arr (cond-> datoms - (not (arrays/array? datoms)) (arrays/into-array)) - _ (arrays/asort arr cmp-datoms-eavt-quick) - eavt (set/from-sorted-array cmp-datoms-eavt arr (arrays/alength arr) opts) - _ (arrays/asort arr cmp-datoms-aevt-quick) - aevt (set/from-sorted-array cmp-datoms-aevt arr (arrays/alength arr) opts) - avet-datoms (filter (fn [^Datom d] (contains? indexed (.-a d))) datoms) - avet-arr (to-array avet-datoms) - _ (arrays/asort avet-arr cmp-datoms-avet-quick) - avet (set/from-sorted-array cmp-datoms-avet avet-arr (arrays/alength avet-arr) opts) - max-eid (init-max-eid rschema eavt avet) + #?@( + ;; :cljd + ;; [eavt (into (sorted-set-by cmp-datoms-eavt) datoms) + ;; aevt (into (sorted-set-by cmp-datoms-aevt) datoms) + ;; avet-datoms (filter (fn [^Datom d] (contains? indexed (.-a d))) datoms) + ;; avet (into (sorted-set-by cmp-datoms-avet) avet-datoms)] + :default + [arr #?(:cljd (arrays/into-array datoms) + :default (cond-> datoms + (not (arrays/array? datoms)) (arrays/into-array))) + _ (arrays/asort arr cmp-datoms-eavt-quick) + eavt (set/from-sorted-array #?(:cljd cmp-datoms-eavt-cmp :default cmp-datoms-eavt) arr (arrays/alength arr) opts) + _ (arrays/asort arr cmp-datoms-aevt-quick) + aevt (set/from-sorted-array #?(:cljd cmp-datoms-aevt-cmp :default cmp-datoms-aevt) arr (arrays/alength arr) opts) + avet-datoms (filter (fn [^Datom d] (contains? indexed (.-a d))) datoms) + avet-arr #?(:cljd (arrays/into-array avet-datoms) + :default (to-array avet-datoms)) + _ (arrays/asort avet-arr cmp-datoms-avet-quick) + avet (set/from-sorted-array #?(:cljd cmp-datoms-avet-cmp :default cmp-datoms-avet) avet-arr (arrays/alength avet-arr) opts)]) + max-eid (init-max-eid eavt) max-tx (transduce (map (fn [^Datom d] (datom-tx d))) max tx0 eavt)] (map->DB {:schema schema @@ -1073,40 +1239,52 @@ (= (first xs) (first ys)) (recur (next xs) (next ys)) :else false))) -(defn+ ^:private ^number hash-db [^DB db] +(defn+ ^:private ^#?(:cljd int :default number) hash-db [^DB db] (let [h @(.-hash db)] (if (zero? h) (reset! (.-hash db) (combine-hashes (hash (.-schema db)) - (hash (.-eavt db)))) + (hash (.-eavt db)))) h))) -(defn+ ^:private ^number hash-fdb [^FilteredDB db] +(defn+ ^:private ^#?(:cljd int :default number) hash-fdb [^FilteredDB db] (let [h @(.-hash db) datoms (or (-datoms db :eavt nil nil nil nil) #{})] (if (zero? h) (let [datoms (or (-datoms db :eavt nil nil nil nil) #{})] (reset! (.-hash db) (combine-hashes (hash (-schema db)) - (hash-unordered-coll datoms)))) + (hash-unordered-coll datoms)))) h))) -(defn+ ^:private ^boolean equiv-db [db other] - (and (or (instance? DB other) (instance? FilteredDB other)) - (= (-schema db) (-schema other)) - (equiv-db-index (-datoms db :eavt nil nil nil nil) (-datoms other :eavt nil nil nil nil)))) - -#?(:cljs +(defn+ ^:private ^#?(:cljd bool :default boolean) equiv-db [db other] + (and #?(:cljd (or (dart/is? other DB) (dart/is? other FilteredDB)) + :default (or (instance? DB other) (instance? FilteredDB other))) + (= (-schema db) (-schema other)) + (equiv-db-index (-datoms db :eavt nil nil nil nil) (-datoms other :eavt nil nil nil nil)))) + +#?(:cljd + (defn pr-db [db ^StringSink sink] + (.write sink "#datascript/DB {") + (.write sink ":schema ") + (-print (-schema db) sink) + (.write sink (str ", :datoms [")) + (loop [[^Datom d & more] (-datoms db :eavt nil nil nil nil)] + (-print [(.-e d) (.-a d) (.-v d) (datom-tx d)] sink) + (when more + (.write sink " ") + (recur more))) + (.write sink "]}")) + :cljs (defn+ pr-db [db w opts] (-write w "#datascript/DB {") (-write w ":schema ") (pr-writer (-schema db) w opts) (-write w ", :datoms ") (pr-sequential-writer w - (fn [d w opts] - (pr-sequential-writer w pr-writer "[" " " "]" opts [(.-e d) (.-a d) (.-v d) (datom-tx d)])) - "[" " " "]" opts (-datoms db :eavt nil nil nil nil)) - (-write w "}"))) - -#?(:clj + (fn [d w opts] + (pr-sequential-writer w pr-writer "[" " " "]" opts [(.-e d) (.-a d) (.-v d) (datom-tx d)])) + "[" " " "]" opts (-datoms db :eavt nil nil nil nil)) + (-write w "}")) + :clj (do (defn pr-db [db, ^java.io.Writer w] (.write w (str "#datascript/DB {")) @@ -1118,18 +1296,17 @@ (.write w "]}")) (defmethod print-method DB [db w] (pr-db db w)) - (defmethod print-method FilteredDB [db w] (pr-db db w)))) + (defmethod print-method FilteredDB [db w] (pr-db db w)) + )) (defn db-from-reader [{:keys [schema datoms]}] (init-db (map (fn [[e a v tx]] (datom e a v tx)) datoms) schema {})) ;; ---------------------------------------------------------------------------- -#?(:clj (declare entid-strict) - :cljs (defn ^number entid-strict [db eid])) +(declare+ ^#?(:cljd int :default number) entid-strict [db eid]) -#?(:clj (declare ref?) - :cljs (defn ^boolean ref? [db attr])) +(declare+ ^#?(:cljd bool :default boolean) ref? [db attr]) (defn+ resolve-datom [db e a v t default-e default-tx] (when (some? a) @@ -1150,275 +1327,166 @@ (defn find-datom [db index c0 c1 c2 c3] (validate-indexed db index c0 c1 c2 c3) - (let [set (get db index) - cmp #?(:clj (.comparator ^clojure.lang.Sorted set) :cljs (.-comparator set)) - from (components->pattern db index c0 c1 c2 c3 e0 tx0) - to (components->pattern db index c0 c1 c2 c3 emax txmax) - datom (some-> set seq (set/seek from) first)] - (when (and (some? datom) (<= 0 (cmp to datom))) - datom))) + #?(:cljd + (let [s (case index :eavt (.-eavt db) :aevt (.-aevt db) :avet (.-avet db)) + from (components->pattern db index c0 c1 c2 c3 e0 tx0) + to (components->pattern db index c0 c1 c2 c3 emax txmax)] + (first (set-slice s from to))) + :default + (let [set (get db index) + cmp #?(:clj (.comparator ^clojure.lang.Sorted set) :cljs (.-comparator set)) + from (components->pattern db index c0 c1 c2 c3 e0 tx0) + to (components->pattern db index c0 c1 c2 c3 emax txmax) + datom (first (set/seek (seq set) from))] + (when (and (some? datom) (<= 0 (cmp to datom))) + datom)))) ;; ---------------------------------------------------------------------------- (defrecord TxReport [db-before db-after tx-data tempids tx-meta]) -(defn+ ^boolean is-attr? [db attr property] +(defn+ ^#?(:cljd bool :default boolean) is-attr? [db attr property] (contains? (-attrs-by db property) attr)) -(defn+ ^boolean multival? [db attr] +(defn+ ^#?(:cljd bool :default boolean) multival? [db attr] (is-attr? db attr :db.cardinality/many)) -(defn+ ^boolean multi-value? [db attr value] - (and - (is-attr? db attr :db.cardinality/many) - (or - (arrays/array? value) - (and (coll? value) (not (map? value)))))) - -(defn+ ^boolean ref? [db attr] +(defn+ ^#?(:cljd bool :default boolean) ref? [db attr] (is-attr? db attr :db.type/ref)) -(defn+ ^boolean component? [db attr] +(defn+ ^#?(:cljd bool :default boolean) component? [db attr] (is-attr? db attr :db/isComponent)) -(defn+ ^boolean indexing? [db attr] +(defn+ ^#?(:cljd bool :default boolean) indexing? [db attr] (is-attr? db attr :db/index)) -(defn+ ^boolean tuple? [db attr] +(defn+ ^#?(:cljd bool :default boolean) tuple? [db attr] (is-attr? db attr :db.type/tuple)) -(defn+ ^boolean tuple-source? [db attr] +(defn+ ^#?(:cljd bool :default boolean) tuple-source? [db attr] (is-attr? db attr :db/attrTuples)) -(defn+ ^boolean reverse-ref? [attr] - (cond - (keyword? attr) - (= \_ (nth (name attr) 0)) - - (string? attr) - (boolean (re-matches #"(?:([^/]+)/)?_([^/]+)" attr)) - - :else - (util/raise "Bad attribute type: " attr ", expected keyword or string" - {:error :transact/syntax, :attribute attr}))) - -(defn reverse-ref [attr] - (cond - (keyword? attr) - (if (reverse-ref? attr) - (keyword (namespace attr) (subs (name attr) 1)) - (keyword (namespace attr) (str "_" (name attr)))) - - (string? attr) - (let [[_ ns name] (re-matches #"(?:([^/]+)/)?([^/]+)" attr)] - (if (= \_ (nth name 0)) - (if ns (str ns "/" (subs name 1)) (subs name 1)) - (if ns (str ns "/_" name) (str "_" name)))) - - :else - (util/raise "Bad attribute type: " attr ", expected keyword or string" - {:error :transact/syntax, :attribute attr}))) - -(defn resolve-tuple-refs [db a vs] - (mapv - (fn [a v] - (if (and (ref? db a) (sequential? v)) ;; lookup-ref - (entid-strict db v) - v)) - (-> db -schema (get a) :db/tupleAttrs) vs)) - -(defn+ ^number entid [db eid] +(defn+ ^#?(:cljd int? :default number) entid [db eid] {:pre [(db? db)]} (cond (and (number? eid) (pos? eid)) (if (> eid emax) - (util/raise "Highest supported entity id is " emax ", got " eid {:error :entity-id :value eid}) - eid) - + (raise "Highest supported entity id is " emax ", got " eid {:error :entity-id :value eid}) + (int eid)) + (sequential? eid) (let [[attr value] eid] (cond (not= (count eid) 2) - (util/raise "Lookup ref should contain 2 elements: " eid - {:error :lookup-ref/syntax, :entity-id eid}) - + (raise "Lookup ref should contain 2 elements: " eid + {:error :lookup-ref/syntax, :entity-id eid}) (not (is-attr? db attr :db/unique)) - (util/raise "Lookup ref attribute should be marked as :db/unique: " eid - {:error :lookup-ref/unique, :entity-id eid}) - - (tuple? db attr) - (let [value' (resolve-tuple-refs db attr value)] - (-> (-datoms db :avet attr value' nil nil) first :e)) - + (raise "Lookup ref attribute should be marked as :db/unique: " eid + {:error :lookup-ref/unique, :entity-id eid}) (nil? value) nil - :else (-> (-datoms db :avet attr value nil nil) first :e))) - + #?@(:cljs [(array? eid) (recur db (array-seq eid))]) - + (keyword? eid) (-> (-datoms db :avet :db/ident eid nil nil) first :e) :else - (util/raise "Expected number or lookup ref for entity id, got " eid - {:error :entity-id/syntax, :entity-id eid}))) + (raise "Expected number or lookup ref for entity id, got " eid + {:error :entity-id/syntax, :entity-id eid}))) -(defn+ ^boolean numeric-eid-exists? [db eid] +(defn+ ^#?(:cljd bool :default boolean) numeric-eid-exists? [db eid] (= eid (-> (-seek-datoms db :eavt eid nil nil nil) first :e))) -(defn+ ^number entid-strict [db eid] +(defn+ ^#?(:cljd int :default number) entid-strict [db eid] (or - (entid db eid) - (util/raise "Nothing found for entity id " eid - {:error :entity-id/missing - :entity-id eid}))) + (entid db eid) + (raise "Nothing found for entity id " eid + {:error :entity-id/missing + :entity-id eid}))) -(defn+ ^number entid-some [db eid] +(defn+ ^#?(:cljd int? :default number) entid-some [db eid] (when (some? eid) (entid-strict db eid))) ;;;;;;;;;; Transacting -(def *last-auto-tempid - (atom 0)) - -(deftype AutoTempid [id] - #?@(:cljs - [IPrintWithWriter - (-pr-writer [d writer opts] - (pr-sequential-writer writer pr-writer "#datascript/AutoTempid [" " " "]" opts [id]))] - :clj - [Object - (toString [d] - (str "#datascript/AutoTempid [" id "]"))])) - -#?(:clj - (defmethod print-method AutoTempid [^AutoTempid id, ^java.io.Writer w] - (.write w (str "#datascript/AutoTempid ")) - (binding [*out* w] - (pr [(.-id id)])))) - -(defn auto-tempid [] - (AutoTempid. (swap! *last-auto-tempid inc))) - -(defn+ ^boolean auto-tempid? [x] - (instance? AutoTempid x)) - -(defn assoc-auto-tempids [db tx-data] - (for [entity tx-data] - (util/cond+ - (map? entity) - (reduce-kv - (fn [entity a v] - (cond - (not (or (keyword? a) (string? a))) - (assoc entity a v) - - (and (ref? db a) (multi-value? db a v)) - (assoc entity a (assoc-auto-tempids db v)) - - (ref? db a) - (assoc entity a (first (assoc-auto-tempids db [v]))) - - (and (reverse-ref? a) (sequential? v)) - (assoc entity a (assoc-auto-tempids db v)) - - (reverse-ref? a) - (assoc entity a (first (assoc-auto-tempids db [v]))) - - :else - (assoc entity a v))) - {} - (if (contains? entity :db/id) - entity - (assoc entity :db/id (auto-tempid)))) - - (and - (sequential? entity) - :let [[op e a v] entity] - (= :db/add op) - (ref? db a)) - (if (multi-value? db a v) - [op e a (assoc-auto-tempids db v)] - [op e a (first (assoc-auto-tempids db [v]))]) - - :else - entity))) - (defn validate-datom [db ^Datom datom] (when (and (datom-added datom) - (is-attr? db (.-a datom) :db/unique)) + (is-attr? db (.-a datom) :db/unique)) (when-some [found (not-empty (-datoms db :avet (.-a datom) (.-v datom) nil nil))] - (util/raise "Cannot add " datom " because of unique constraint: " found - {:error :transact/unique - :attribute (.-a datom) - :datom datom})))) + (raise "Cannot add " datom " because of unique constraint: " found + {:error :transact/unique + :attribute (.-a datom) + :datom datom})))) (defn- current-tx - #?(:clj {:inline (fn [report] `(-> ~report :db-before :max-tx long inc))}) - ^long [report] - (-> report :db-before :max-tx long inc)) + #?(:cljd {} + :clj {:inline (fn [report] `(-> ~report :db-before :max-tx long inc))}) + ^#?(:cljd int :default long) [report] + (-> report :db-before :max-tx #?(:cljd int :default long) inc)) (defn- next-eid - #?(:clj {:inline (fn [db] `(inc (long (:max-eid ~db))))}) - ^long [db] - (inc (long (:max-eid db)))) + #?(:cljd {} + :clj {:inline (fn [db] `(inc (long (:max-eid ~db))))}) + ^#?(:cljd int :default long) [db] + (inc (#?(:cljd int :default long) (:max-eid db)))) -#?(:clj +#?(:cljd + (defn- ^bool tx-id? + [e] + (or (identical? :db/current-tx e) + (.== ":db/current-tx" e) ;; for datascript.js interop + (.== "datomic.tx" e) + (.== "datascript.tx" e))) + + :clj (defn- ^Boolean tx-id? [e] (or (identical? :db/current-tx e) - (.equals ":db/current-tx" e) ;; for datascript.js interop - (.equals "datomic.tx" e) - (.equals "datascript.tx" e))) + (.equals ":db/current-tx" e) ;; for datascript.js interop + (.equals "datomic.tx" e) + (.equals "datascript.tx" e))) :cljs (defn- ^boolean tx-id? [e] (or (= e :db/current-tx) - (= e ":db/current-tx") ;; for datascript.js interop - (= e "datomic.tx") - (= e "datascript.tx")))) + (= e ":db/current-tx") ;; for datascript.js interop + (= e "datomic.tx") + (= e "datascript.tx")))) -(defn- #?@(:clj [^Boolean tempid?] - :cljs [^boolean tempid?]) +(defn- ^#?(:cljd bool :clj Boolean :cljs boolean) tempid? [x] - (or - (and (number? x) (neg? x)) - (string? x) - (auto-tempid? x))) + (or (and (number? x) (neg? x)) (string? x))) (defn- new-eid? [db eid] (and (> eid (:max-eid db)) - (< eid tx0))) ;; tx0 is max eid + (< eid tx0))) ;; tx0 is max eid (defn- advance-max-eid [db eid] (cond-> db (new-eid? db eid) - (assoc :max-eid eid))) + (assoc :max-eid eid))) (defn- allocate-eid ([report eid] - (update report :db-after advance-max-eid eid)) + (update report :db-after advance-max-eid eid)) ([report e eid] - (cond-> report - (tx-id? e) - (-> - (update :tempids assoc e eid) - (update ::reverse-tempids update eid util/conjs e)) - - (tempid? e) - (-> - (update :tempids assoc e eid) - (update ::reverse-tempids update eid util/conjs e)) - - (and (not (tempid? e)) (new-eid? (:db-after report) eid)) - (update :tempids assoc eid eid) - - true - (update :db-after advance-max-eid eid)))) + (cond-> report + (tx-id? e) + (update :tempids assoc e eid) + + (tempid? e) + (update :tempids assoc e eid) + + (and (not (tempid? e)) (new-eid? (:db-after report) eid)) + (update :tempids assoc eid eid) + + true + (update :db-after advance-max-eid eid)))) ;; In context of `with-datom` we can use faster comparators which ;; do not check for nil (~10-15% performance gain in `transact`) @@ -1428,16 +1496,16 @@ (let [indexing? (indexing? db (.-a datom))] (if (datom-added datom) (cond-> db - true (update :eavt set/conj datom cmp-datoms-eavt-quick) - true (update :aevt set/conj datom cmp-datoms-aevt-quick) - indexing? (update :avet set/conj datom cmp-datoms-avet-quick) + true (update :eavt set/conj datom #?(:cljd cmp-datoms-eavt-quick-cmp :default cmp-datoms-eavt-quick)) + true (update :aevt set/conj datom #?(:cljd cmp-datoms-aevt-quick-cmp :default cmp-datoms-aevt-quick)) + indexing? (update :avet set/conj datom #?(:cljd cmp-datoms-avet-quick-cmp :default cmp-datoms-avet-quick)) true (advance-max-eid (.-e datom)) true (assoc :hash (atom 0))) (if-some [removing (fsearch db [(.-e datom) (.-a datom) (.-v datom)])] (cond-> db - true (update :eavt set/disj removing cmp-datoms-eavt-quick) - true (update :aevt set/disj removing cmp-datoms-aevt-quick) - indexing? (update :avet set/disj removing cmp-datoms-avet-quick) + true (update :eavt set/disj removing #?(:cljd cmp-datoms-eavt-quick-cmp :default cmp-datoms-eavt-quick)) + true (update :aevt set/disj removing #?(:cljd cmp-datoms-aevt-quick-cmp :default cmp-datoms-aevt-quick)) + indexing? (update :avet set/disj removing #?(:cljd cmp-datoms-avet-quick-cmp :default cmp-datoms-avet-quick)) true (assoc :hash (atom 0))) db)))) @@ -1470,6 +1538,35 @@ (update report' ::queued-tuples assoc e queue')) report'))) +(defn ^#?(:cljd bool :clj Boolean :cljs boolean) reverse-ref? [attr] + (cond + (keyword? attr) + (= \_ (nth (name attr) 0)) + + (string? attr) + (boolean (re-matches #"(?:([^/]+)/)?_([^/]+)" attr)) + + :else + (raise "Bad attribute type: " attr ", expected keyword or string" + {:error :transact/syntax, :attribute attr}))) + +(defn reverse-ref [attr] + (cond + (keyword? attr) + (if (reverse-ref? attr) + (keyword (namespace attr) (subs (name attr) 1)) + (keyword (namespace attr) (str "_" (name attr)))) + + (string? attr) + (let [[_ ns name] (re-matches #"(?:([^/]+)/)?([^/]+)" attr)] + (if (= \_ (nth name 0)) + (if ns (str ns "/" (subs name 1)) (subs name 1)) + (if ns (str ns "/_" name) (str "_" name)))) + + :else + (raise "Bad attribute type: " attr ", expected keyword or string" + {:error :transact/syntax, :attribute attr}))) + (defn- resolve-upserts "Returns [entity' upserts]. Upsert attributes that resolve to existing entities are removed from entity, rest are kept in entity for insertion. No validation is performed. @@ -1481,12 +1578,7 @@ [db entity] (if-some [idents (not-empty (-attrs-by db :db.unique/identity))] (let [resolve (fn [a v] - (cond - (not (ref? db a)) - (:e (first (-datoms db :avet a v nil nil))) - - (not (tempid? v)) - (:e (first (-datoms db :avet a (entid db v) nil nil))))) + (:e (first (-datoms db :avet a v nil nil)))) split (fn [a vs] (reduce (fn [acc v] @@ -1502,7 +1594,11 @@ (not (contains? idents a)) [(assoc entity' a v) upserts] - (multi-value? db a v) + (and + (multival? db a) + (or + #?(:cljd (dart/is? v List) :default (arrays/array? v)) + (and (coll? v) (not (map? v))))) (let [[insert upsert] (split a v)] [(cond-> entity' (not (empty? insert)) (assoc a insert)) @@ -1518,7 +1614,7 @@ [entity nil])) (defn validate-upserts - "Throws if not all upserts point to the same entity. + "Throws if not all upserts point to the same entity. Returns single eid that all upserts point to, or null." [entity upserts] (let [upsert-ids (reduce-kv @@ -1531,7 +1627,7 @@ (if (<= 2 (count upsert-ids)) (let [[e1 [a1 v1]] (first upsert-ids) [e2 [a2 v2]] (second upsert-ids)] - (util/raise "Conflicting upserts: " [a1 v1] " resolves to " e1 ", but " [a2 v2] " resolves to " e2 + (raise "Conflicting upserts: " [a1 v1] " resolves to " e1 ", but " [a2 v2] " resolves to " e2 {:error :transact/upsert :assertion [e1 a1 v1] :conflict [e2 a2 v2]})) @@ -1542,7 +1638,7 @@ (some? eid) (not (tempid? eid)) (not= upsert-id eid)) - (util/raise "Conflicting upsert: " [a v] " resolves to " upsert-id ", but entity already has :db/id " eid + (raise "Conflicting upsert: " [a v] " resolves to " upsert-id ", but entity already has :db/id " eid {:error :transact/upsert :assertion [upsert-id a v] :conflict {:db/id eid}})) @@ -1553,19 +1649,19 @@ (cond ;; not a multival context (not (or (reverse-ref? a) - (multival? db a))) + (multival? db a))) [vs] ;; not a collection at all, so definitely a single value - (not (or (arrays/array? vs) + (not (or #?(:cljd (dart/is? vs List) :default (arrays/array? vs)) (and (coll? vs) (not (map? vs))))) [vs] - + ;; probably lookup ref (and (= (count vs) 2) - (is-attr? db (first vs) :db.unique/identity)) + (is-attr? db (first vs) :db.unique/identity)) [vs] - + :else vs)) (defn- explode [db entity] @@ -1582,8 +1678,8 @@ reverse? (reverse-ref? a) straight-a (if reverse? (reverse-ref a) a) _ (when (and reverse? (not (ref? db straight-a))) - (util/raise "Bad attribute " a ": reverse attribute name requires {:db/valueType :db.type/ref} in schema" - {:error :transact/syntax, :attribute a, :context {:db/id eid, a vs}}))] + (raise "Bad attribute " a ": reverse attribute name requires {:db/valueType :db.type/ref} in schema" + {:error :transact/syntax, :attribute a, :context {:db/id eid, a vs}}))] v (maybe-wrap-multival db a vs)] (if (and (ref? db straight-a) (map? v)) ;; another entity specified as nested map (assoc v (reverse-ref a) eid) @@ -1600,20 +1696,20 @@ v (if (ref? db a) (entid-strict db v) v) new-datom (datom e a v tx) multival? (multival? db a) - old-datom ^Datom (if multival? - (fsearch db [e a v]) - (fsearch db [e a]))] - (cond - (nil? old-datom) - (transact-report report new-datom) + old-datom ^#?(:cljd Datom? :default Datom) (if multival? + (fsearch db [e a v]) + (fsearch db [e a]))] + (cond + (nil? old-datom) + (transact-report report new-datom) - (= (.-v old-datom) v) - (update report ::tx-redundant util/conjv new-datom) + (= (.-v old-datom) v) + (update report ::tx-redundant conjv new-datom) - :else - (-> report - (transact-report (datom e a (.-v old-datom) tx false)) - (transact-report new-datom))))) + :else + (-> report + (transact-report (datom e a (.-v old-datom) tx false)) + (transact-report new-datom))))) (defn- transact-retract-datom [report ^Datom d] (let [tx (current-tx report)] @@ -1624,23 +1720,19 @@ (filter (fn [^Datom d] (component? db (.-a d)))) (map (fn [^Datom d] [:db.fn/retractEntity (.-v d)]))) datoms)) -#?(:clj (declare transact-tx-data-impl) - :cljs (defn transact-tx-data-impl [initial-report initial-es])) +(declare+ transact-tx-data [initial-report initial-es]) (defn- retry-with-tempid [initial-report report es tempid upserted-eid] - (if-some [eid (get (::upserted-tempids initial-report) tempid)] - (util/raise "Conflicting upsert: " tempid " resolves" - " both to " upserted-eid " and " eid + (if (contains? (:tempids initial-report) tempid) + (raise "Conflicting upsert: " tempid " resolves" + " both to " upserted-eid " and " (get-in initial-report [:tempids tempid]) {:error :transact/upsert}) ;; try to re-run from the beginning ;; but remembering that `tempid` will resolve to `upserted-eid` (let [tempids' (-> (:tempids report) (assoc tempid upserted-eid)) - report' (-> initial-report - (assoc :tempids tempids') - (update ::upserted-tempids assoc tempid upserted-eid))] - (util/log "retry" tempid "->" upserted-eid) - (transact-tx-data-impl report' es)))) + report' (assoc initial-report :tempids tempids')] + (transact-tx-data report' es)))) (def builtin-fn? #{:db.fn/call @@ -1653,7 +1745,9 @@ :db/retractEntity}) (defn flush-tuples [report] - (let [db (:db-after report)] + (let [db (:db-after report) + schema (-schema db) + attr-tuples (-attrs-by db :db/attrTuples)] (reduce-kv (fn [entities eid tuples+values] (reduce-kv @@ -1671,20 +1765,33 @@ (defn check-value-tempids [report] (if-let [tempids (::value-tempids report)] - (let [all-tempids (transient tempids) - reduce-fn (fn [tempids datom] - (if (datom-added datom) - (dissoc! tempids (:e datom)) - tempids)) - unused (reduce reduce-fn all-tempids (:tx-data report)) - unused (reduce reduce-fn unused (::tx-redundant report))] + (let [#?@(:cljd + [reduce-fn (fn [tempids datom] + (if (datom-added datom) + (dissoc tempids (:e datom)) + tempids)) + unused (reduce reduce-fn tempids (:tx-data report)) + unused (reduce reduce-fn unused (::tx-redundant report))] + :default + [all-tempids (transient tempids) + reduce-fn (fn [tempids datom] + (if (datom-added datom) + (dissoc! tempids (:e datom)) + tempids)) + unused (reduce reduce-fn all-tempids (:tx-data report)) + unused (reduce reduce-fn unused (::tx-redundant report)) + unused (persistent! unused)])] (if (zero? (count unused)) (dissoc report ::value-tempids ::tx-redundant) - (util/raise "Tempids used only as value in transaction: " (sort (vals (persistent! unused))) - {:error :transact/syntax, :tempids unused}))) + (raise "Tempids used only as value in transaction: " (sort (vals unused)) + {:error :transact/syntax, :tempids unused}))) (dissoc report ::value-tempids ::tx-redundant))) -(defn+ transact-tx-data-impl [initial-report initial-es] +(defn+ transact-tx-data [initial-report initial-es] + (when-not (or (nil? initial-es) + (sequential? initial-es)) + (raise "Bad transaction data " initial-es ", expected sequential collection" + {:error :transact/syntax, :tx-data initial-es})) (let [initial-report' (-> initial-report #_(update :db-after transient)) has-tuples? (not (empty? (-attrs-by (:db-after initial-report) :db.type/tuple))) @@ -1693,14 +1800,10 @@ initial-es)] (loop [report initial-report' es initial-es'] - (util/log "transact" es) (util/cond+ (empty? es) (-> report (check-value-tempids) - (dissoc ::upserted-tempids) - (dissoc ::reverse-tempids) - (update :tempids #(util/removem auto-tempid? %)) (update :tempids assoc :db/current-tx (current-tx report)) (update :db-after update :max-tx inc) #_(update :db-after persistent!)) @@ -1733,50 +1836,53 @@ (tx-id? old-eid) (let [id (current-tx report)] (recur (allocate-eid report old-eid id) - (cons (assoc entity :db/id id) entities))) - + (cons (assoc entity :db/id id) entities))) + ;; lookup-ref => resolved | error (sequential? old-eid) (let [id (entid-strict db old-eid)] (recur report - (cons (assoc entity :db/id id) entities))) - + (cons (assoc entity :db/id id) entities))) + ;; upserted => explode | error :let [[entity' upserts] (resolve-upserts db entity) upserted-eid (validate-upserts entity' upserts)] (some? upserted-eid) - (if (and - (tempid? old-eid) - (contains? tempids old-eid) - (not= upserted-eid (get tempids old-eid))) + (if (and (tempid? old-eid) + (contains? tempids old-eid) + (not= upserted-eid (get tempids old-eid))) (retry-with-tempid initial-report report initial-es old-eid upserted-eid) (recur (-> report (allocate-eid old-eid upserted-eid) - (update ::tx-redundant util/conjv (datom upserted-eid nil nil tx0))) + (update ::tx-redundant conjv (datom upserted-eid nil nil tx0))) (concat (explode db (assoc entity' :db/id upserted-eid)) entities))) - + ;; resolved | allocated-tempid | tempid | nil => explode - (or - (number? old-eid) - (nil? old-eid) - (string? old-eid) - (auto-tempid? old-eid)) - (recur report (concat (explode db entity) entities)) - + (or (number? old-eid) + (nil? old-eid) + (string? old-eid)) + (let [new-eid (cond + (nil? old-eid) (next-eid db) + (tempid? old-eid) (or (get tempids old-eid) (next-eid db)) + :else old-eid) + new-entity (assoc entity :db/id new-eid)] + (recur (allocate-eid report old-eid new-eid) + (concat (explode db new-entity) entities))) + ;; trash => error :else - (util/raise "Expected number, string or lookup ref for :db/id, got " old-eid - {:error :entity-id/syntax, :entity entity}))) + (raise "Expected number, string or lookup ref for :db/id, got " old-eid + { :error :entity-id/syntax, :entity entity }))) (sequential? entity) (let [[op e a v] entity] - (util/cond+ + (cond (= op :db.fn/call) (let [[_ f & args] entity] - (recur report (concat (assoc-auto-tempids db (apply f db args)) entities))) - + (recur report (concat (apply f db args) entities))) + (and (keyword? op) (not (builtin-fn? op))) (if-some [ident (entid db op)] @@ -1784,15 +1890,15 @@ args (next entity)] (if (fn? fun) (recur report (concat (apply fun db args) entities)) - (util/raise "Entity " op " expected to have :db/fn attribute with fn? value" - {:error :transact/syntax, :operation :db.fn/call, :tx-data entity}))) - (util/raise "Can’t find entity for transaction fn " op - {:error :transact/syntax, :operation :db.fn/call, :tx-data entity})) - + (raise "Entity " op " expected to have :db/fn attribute with fn? value" + {:error :transact/syntax, :operation :db.fn/call, :tx-data entity}))) + (raise "Can’t find entity for transaction fn " op + {:error :transact/syntax, :operation :db.fn/call, :tx-data entity})) + (and (tempid? e) (not= op :db/add)) - (util/raise "Can't use tempid in '" entity "'. Tempids are allowed in :db/add only" - {:error :transact/syntax, :op entity}) + (raise "Can't use tempid in '" entity "'. Tempids are allowed in :db/add only" + { :error :transact/syntax, :op entity }) (or (= op :db.fn/cas) (= op :db/cas)) @@ -1806,13 +1912,13 @@ (if (multival? db a) (if (some (fn [^Datom d] (= (.-v d) ov)) datoms) (recur (transact-add report [:db/add e a nv]) entities) - (util/raise ":db.fn/cas failed on datom [" e " " a " " (map :v datoms) "], expected " ov - {:error :transact/cas, :old datoms, :expected ov, :new nv})) + (raise ":db.fn/cas failed on datom [" e " " a " " (map :v datoms) "], expected " ov + {:error :transact/cas, :old datoms, :expected ov, :new nv})) (let [v (:v (first datoms))] (if (= v ov) (recur (transact-add report [:db/add e a nv]) entities) - (util/raise ":db.fn/cas failed on datom [" e " " a " " v "], expected " ov - {:error :transact/cas, :old (first datoms), :expected ov, :new nv}))))) + (raise ":db.fn/cas failed on datom [" e " " a " " v "], expected " ov + {:error :transact/cas, :old (first datoms), :expected ov, :new nv }))))) (tx-id? e) (recur (allocate-eid report e (current-tx report)) (cons [op (current-tx report) a v] entities)) @@ -1829,14 +1935,6 @@ (allocate-eid v resolved) (update ::value-tempids assoc resolved v))] (recur report' es))) - - (and - (or (= op :db/add) (= op :db/retract)) - (not (::internal (meta entity))) - (tuple? db a) - :let [v' (resolve-tuple-refs db a v)] - (not= v v')) - (recur report (cons [op e a v'] entities)) (tempid? e) (let [upserted-eid (when (is-attr? db a :db.unique/identity) @@ -1847,35 +1945,20 @@ (let [eid (or upserted-eid allocated-eid (next-eid db))] (recur (allocate-eid report e eid) (cons [op eid a v] entities))))) - (and - (is-attr? db a :db.unique/identity) - (contains? (::reverse-tempids report) e) - :let [upserted-eid (:e (first (-datoms db :avet a v nil nil)))] - e - upserted-eid - (not= e upserted-eid)) - (let [tempids (get (::reverse-tempids report) e) - tempid (util/find #(not (contains? (::upserted-tempids report) %)) tempids)] - (if tempid - (retry-with-tempid initial-report report initial-es tempid upserted-eid) - (util/raise "Conflicting upsert: " e " resolves to " upserted-eid " via " entity - {:error :transact/upsert}))) - - (and - (not (::internal (meta entity))) + (and (not (::internal (meta entity))) (tuple? db a)) ;; allow transacting in tuples if they fully match already existing values (let [tuple-attrs (get-in db [:schema a :db/tupleAttrs])] (if (and (= (count tuple-attrs) (count v)) (every? some? v) - (every? + (every? (fn [[tuple-attr tuple-value]] (let [db-value (:v (first (-datoms db :eavt e tuple-attr nil nil)))] (= tuple-value db-value))) (map vector tuple-attrs v))) (recur report entities) - (util/raise "Can’t modify tuple attrs directly: " entity + (raise "Can’t modify tuple attrs directly: " entity {:error :transact/syntax, :tx-data entity}))) (= op :db/add) @@ -1892,41 +1975,32 @@ (recur report entities)) (or (= op :db.fn/retractAttribute) - (= op :db/retract)) + (= op :db/retract)) (if-some [e (entid db e)] (let [_ (validate-attr a entity) datoms (vec (-search db [e a]))] (recur (reduce transact-retract-datom report datoms) - (concat (retract-components db datoms) entities))) + (concat (retract-components db datoms) entities))) (recur report entities)) (or (= op :db.fn/retractEntity) - (= op :db/retractEntity)) + (= op :db/retractEntity)) (if-some [e (entid db e)] (let [e-datoms (vec (-search db [e])) v-datoms (vec (mapcat (fn [a] (-search db [nil a e])) (-attrs-by db :db.type/ref)))] (recur (reduce transact-retract-datom report (concat e-datoms v-datoms)) - (concat (retract-components db e-datoms) entities))) + (concat (retract-components db e-datoms) entities))) (recur report entities)) - :else - (util/raise "Unknown operation at " entity ", expected :db/add, :db/retract, :db.fn/call, :db.fn/retractAttribute, :db.fn/retractEntity or an ident corresponding to an installed transaction function (e.g. {:db/ident :db/fn }, usage of :db/ident requires {:db/unique :db.unique/identity} in schema)" {:error :transact/syntax, :operation op, :tx-data entity}))) - - (datom? entity) - (let [[e a v tx added] entity] - (if added - (recur (transact-add report [:db/add e a v tx]) entities) - (recur report (cons [:db/retract e a v] entities)))) + :else + (raise "Unknown operation at " entity ", expected :db/add, :db/retract, :db.fn/call, :db.fn/retractAttribute, :db.fn/retractEntity or an ident corresponding to an installed transaction function (e.g. {:db/ident :db/fn }, usage of :db/ident requires {:db/unique :db.unique/identity} in schema)" {:error :transact/syntax, :operation op, :tx-data entity}))) - :else - (util/raise "Bad entity type at " entity ", expected map or vector" - {:error :transact/syntax, :tx-data entity}))))) - -(defn transact-tx-data [report es] - (when-not (or - (nil? es) - (sequential? es)) - (util/raise "Bad transaction data " es ", expected sequential collection" - {:error :transact/syntax, :tx-data es})) - (let [es' (assoc-auto-tempids (:db-before report) es)] - (transact-tx-data-impl report es'))) \ No newline at end of file + (datom? entity) + (let [[e a v tx added] entity] + (if added + (recur (transact-add report [:db/add e a v tx]) entities) + (recur report (cons [:db/retract e a v] entities)))) + + :else + (raise "Bad entity type at " entity ", expected map or vector" + {:error :transact/syntax, :tx-data entity}))))) diff --git a/src/datascript/impl/entity.cljc b/src/datascript/impl/entity.cljc index feed9d93..545f421e 100644 --- a/src/datascript/impl/entity.cljc +++ b/src/datascript/impl/entity.cljc @@ -1,14 +1,15 @@ (ns ^:no-doc datascript.impl.entity (:refer-clojure :exclude [keys get]) - (:require [#?(:cljs cljs.core :clj clojure.core) :as c] - [datascript.db :as db])) + (:require [#?(:cljd cljd.core :cljs cljs.core :clj clojure.core) :as c] + [datascript.db :as db #?@(:cljd [:refer [Datom]])] + #?(:cljd ["dart:collection" :as dart-coll]))) (declare entity ->Entity equiv-entity lookup-entity touch hash-entity) (defn- entid [db eid] (when (or (number? eid) - (sequential? eid) - (keyword? eid)) + (sequential? eid) + (keyword? eid)) (db/entid db eid))) (defn entity [db eid] @@ -20,17 +21,17 @@ (defn- entity-attr [db a datoms] (if (db/multival? db a) (if (db/ref? db a) - (reduce #(conj %1 (entity db (:v %2))) #{} datoms) - (reduce #(conj %1 (:v %2)) #{} datoms)) + (reduce #(conj %1 (entity db #?(:cljd (.-v ^Datom %2) :default (:v %2)))) #{} datoms) + (reduce #(conj %1 #?(:cljd (.-v ^Datom %2) :default (:v %2))) #{} datoms)) (if (db/ref? db a) - (entity db (:v (first datoms))) - (:v (first datoms))))) + (entity db #?(:cljd (.-v ^Datom (first datoms)) :default (:v (first datoms)))) + #?(:cljd (.-v ^Datom (first datoms)) :default (:v (first datoms)))))) (defn- -lookup-backwards [db eid attr not-found] (if-let [datoms (not-empty (db/-search db [nil attr eid]))] (if (db/component? db attr) - (entity db (:e (first datoms))) - (reduce #(conj %1 (entity db (:e %2))) #{} datoms)) + (entity db #?(:cljd (.-e ^Datom (first datoms)) :default (:e (first datoms)))) + (reduce #(conj %1 (entity db #?(:cljd (.-e ^Datom %2) :default (:e %2)))) #{} datoms)) not-found)) #?(:cljs @@ -45,47 +46,103 @@ [a (multival->js v)] [a v])))) -#?(:cljs - (unchecked-set (.-prototype ES6Iterator) cljs.core/ITER_SYMBOL - (fn [] - (this-as this# this#)))) +(deftype #?(:cljd #/(Entity K V) :default Entity) [db eid touched cache] + #?@( + :cljd + [^:mixin c/ToStringMixin + ^:mixin c/EqualsEquivMixin + + ;; dart map + ;; ^:mixin #/(dart-coll/MapMixin K V) + ^:mixin ^{:type-params [K V]} dart-coll/MapMixin + (entries [coll] + ;; ^#/(Map K V) + (let [^^{:type-params [K V]} Map m @cache] + (.-entries m))) + ("[]" [coll k] + (-lookup coll k nil)) + ("[]=" [coll key val] + (throw (UnsupportedError. "[]= not supported on Entity"))) + (remove [coll val] + (throw (UnsupportedError. "remove not supported on Entity"))) + (clear [coll] + (throw (UnsupportedError. "clear not supported on Entity"))) + (keys [coll] + (let [^^{:type-params [K V]} Map m @cache] + (.-keys m))) + (values [coll] + (let [^^{:type-params [K V]} Map m @cache] + (.-values m))) + ;; (^#/(Entity RK RV) #/(cast RK RV) [coll] + ;; (new #/(Entity RK RV) db eid touched cache)) + (^^{:type-params [RK RV]} Entity ^{:type-params [RK RV]} cast [coll] + (new #/(Entity RK RV) db eid touched cache)) + + cljd.core/IEquiv + (-equiv [this o] (equiv-entity this o)) -#?(:cljs - (unchecked-set (.-prototype ES6EntriesIterator) cljs.core/ITER_SYMBOL - (fn [] - (this-as this# this#)))) + cljd.core/IHash + (-hash [this] + (hash-entity this)) + + cljd.core/ISeqable + (-seq [this] + (touch this) + (seq @cache)) + + cljd.core/ICounted + (-count [this] + (touch this) + (count @cache)) -(deftype Entity [db eid touched cache] - #?@(:cljs + cljd.core/ILookup + (-lookup [this attr] (lookup-entity this attr nil)) + (-lookup [this attr not-found] (lookup-entity this attr not-found)) + + cljd.core/ILookup + (-contains-key? [this k] + (not= ::nf (lookup-entity this k ::nf))) + + cljd.core/IFn + (-invoke [this k] + (lookup-entity this k)) + (-invoke [this k not-found] + (lookup-entity this k not-found)) + + cljd.core/IPrint + (-print [_ sink] + (-print (assoc @cache :db/id eid) sink))] + + :cljs [Object (toString [this] - (pr-str* this)) + (pr-str* this)) (equiv [this other] - (equiv-entity this other)) + (equiv-entity this other)) ;; js/map interface (keys [this] - (es6-iterator (c/keys this))) + (es6-iterator (c/keys this))) (entries [this] - (es6-entries-iterator (js-seq this))) + (es6-entries-iterator (js-seq this))) (values [this] - (es6-iterator (map second (js-seq this)))) + (es6-iterator (map second (js-seq this)))) (has [this attr] - (not (nil? (.get this attr)))) + (not (nil? (.get this attr)))) (get [this attr] - (if (= attr ":db/id") - eid - (if (db/reverse-ref? attr) - (-> (-lookup-backwards db eid (db/reverse-ref attr) nil) - multival->js) - (cond-> (lookup-entity this attr) - (db/multival? db attr) multival->js)))) + (if (= attr ":db/id") + eid + (if (db/reverse-ref? attr) + (-> (-lookup-backwards db eid (db/reverse-ref attr) nil) + multival->js) + (cond-> (lookup-entity this attr) + (db/multival? db attr) multival->js)))) (forEach [this f] - (doseq [[a v] (js-seq this)] - (f v a this))) + (doseq [[a v] (js-seq this)] + (f v a this))) (forEach [this f use-as-this] - (doseq [[a v] (js-seq this)] - (.call f use-as-this v a this))) + (doseq [[a v] (js-seq this)] + (.call f use-as-this v a this))) ;; js fallbacks (key_set [this] (to-array (c/keys this))) @@ -97,17 +154,17 @@ IHash (-hash [this] - (hash-entity this)) + (hash-entity this)) ISeqable (-seq [this] - (touch this) - (seq @cache)) + (touch this) + (seq @cache)) ICounted (-count [this] - (touch this) - (count @cache)) + (touch this) + (count @cache)) ILookup (-lookup [this attr] (lookup-entity this attr nil)) @@ -115,17 +172,17 @@ IAssociative (-contains-key? [this k] - (not= ::nf (lookup-entity this k ::nf))) + (not= ::nf (lookup-entity this k ::nf))) IFn (-invoke [this k] - (lookup-entity this k)) + (lookup-entity this k)) (-invoke [this k not-found] - (lookup-entity this k not-found)) + (lookup-entity this k not-found)) IPrintWithWriter (-pr-writer [_ writer opts] - (-pr-writer (assoc @cache :db/id eid) writer opts))] + (-pr-writer (assoc @cache :db/id eid) writer opts))] :clj [Object @@ -152,30 +209,28 @@ clojure.lang.IFn (invoke [e k] (lookup-entity e k)) - (invoke [e k not-found] (lookup-entity e k not-found))])) + (invoke [e k not-found] (lookup-entity e k not-found)) + ])) (defn entity? [x] (instance? Entity x)) -#?(:cljs - (unchecked-set (.-prototype Entity) cljs.core/ITER_SYMBOL - (fn [] - (this-as this# (.entries this#))))) - -#?(:clj +#?(:cljd nil + :clj (defmethod print-method Entity [e, ^java.io.Writer w] (.write w (str e)))) (defn- equiv-entity [^Entity this that] (and - (instance? Entity that) - (identical? (.-db this) (.-db ^Entity that)) ; `=` and `hash` on db is expensive - (= (.-eid this) (.-eid ^Entity that)))) + (instance? Entity that) + (identical? (.-db this) (.-db ^Entity that)) ; `=` and `hash` on db is expensive + (= (.-eid this) (.-eid ^Entity that)))) (defn- hash-entity [^Entity e] (db/combine-hashes (hash (.-eid e)) ;; A hash compatible with `identical?`. Consistent with `=`. - (#?(:clj System/identityHashCode :cljs goog/getUid) (.-db e)))) + (#?(:cljd dart:core/identityHashCode + :clj System/identityHashCode :cljs goog/getUid) (.-db e)))) (defn- lookup-entity ([this attr] (lookup-entity this attr nil)) @@ -207,18 +262,18 @@ (defn- datoms->cache [db datoms] (reduce (fn [acc part] - (let [a (:a (first part))] - (assoc acc a (entity-attr db a part)))) - {} (partition-by :a datoms))) + (let [a #?(:cljd (.-a ^Datom (first part)) :default (:a (first part)))] + (assoc acc a (entity-attr db a part)))) + {} (partition-by #?(:cljd #(.-a ^Datom %) :default :a) datoms))) -(defn touch [^Entity e] +(defn touch [^#?(:cljd Entity? :default Entity) e] {:pre [(or (nil? e) (entity? e))]} (when (some? e) (when-not @(.-touched e) (when-let [datoms (not-empty (db/-search (.-db e) [(.-eid e)]))] (vreset! (.-cache e) (->> datoms - (datoms->cache (.-db e)) - (touch-components (.-db e)))) + (datoms->cache (.-db e)) + (touch-components (.-db e)))) (vreset! (.-touched e) true))) e)) diff --git a/src/datascript/lru.cljc b/src/datascript/lru.cljc index cadb89b1..d58a579c 100644 --- a/src/datascript/lru.cljc +++ b/src/datascript/lru.cljc @@ -3,25 +3,36 @@ (declare assoc-lru cleanup-lru) #?(:cljs - (deftype LRU [key-value gen-key key-gen gen limit] - IAssociative - (-assoc [this k v] (assoc-lru this k v)) - (-contains-key? [_ k] (-contains-key? key-value k)) - ILookup - (-lookup [_ k] (-lookup key-value k nil)) - (-lookup [_ k nf] (-lookup key-value k nf)) - IPrintWithWriter - (-pr-writer [_ writer opts] - (-pr-writer key-value writer opts))) + (deftype LRU [key-value gen-key key-gen gen limit] + IAssociative + (-assoc [this k v] (assoc-lru this k v)) + (-contains-key? [_ k] (-contains-key? key-value k)) + ILookup + (-lookup [_ k] (-lookup key-value k nil)) + (-lookup [_ k nf] (-lookup key-value k nf)) + IPrintWithWriter + (-pr-writer [_ writer opts] + (-pr-writer key-value writer opts))) + :cljd + (deftype LRU [key-value gen-key key-gen gen limit] + cljd.core/IAssociative + (-assoc [this k v] (assoc-lru this k v)) + cljd.core/ILookup + (-lookup [_ k] (-lookup key-value k nil)) + (-lookup [_ k nf] (-lookup key-value k nf)) + (-contains-key? [_ k] (-contains-key? key-value k)) + cljd.core/IPrint + (-print [_ sink] + (-print key-value sink))) :clj - (deftype LRU [^clojure.lang.Associative key-value gen-key key-gen gen limit] - clojure.lang.ILookup - (valAt [_ k] (.valAt key-value k)) - (valAt [_ k not-found] (.valAt key-value k not-found)) - clojure.lang.Associative - (containsKey [_ k] (.containsKey key-value k)) - (entryAt [_ k] (.entryAt key-value k)) - (assoc [this k v] (assoc-lru this k v)))) + (deftype LRU [^clojure.lang.Associative key-value gen-key key-gen gen limit] + clojure.lang.ILookup + (valAt [_ k] (.valAt key-value k)) + (valAt [_ k not-found] (.valAt key-value k not-found)) + clojure.lang.Associative + (containsKey [_ k] (.containsKey key-value k)) + (entryAt [_ k] (.entryAt key-value k)) + (assoc [this k v] (assoc-lru this k v)))) (defn assoc-lru [^LRU lru k v] (let [key-value (.-key-value lru) @@ -33,8 +44,8 @@ (LRU. key-value (-> gen-key - (dissoc g) - (assoc gen k)) + (dissoc g) + (assoc gen k)) (assoc key-gen k gen) (inc gen) limit) @@ -74,7 +85,7 @@ (-get [_ key compute-fn] (if-some [cached (get @*impl key nil)] (do (vswap! *impl assoc key cached) - cached) + cached) (let [computed (compute-fn)] (vswap! *impl assoc key computed) computed)))))) diff --git a/src/datascript/parser.cljc b/src/datascript/parser.cljc index 1b1447ac..f9afdde7 100644 --- a/src/datascript/parser.cljc +++ b/src/datascript/parser.cljc @@ -3,8 +3,7 @@ #?(:cljs (:require-macros [datascript.parser :refer [deftrecord]])) (:require [clojure.set :as set] - [datascript.db :as db] - [datascript.util :as util])) + [datascript.db :as db #?(:cljs :refer-macros :clj :refer) [raise]])) ;; utils @@ -25,7 +24,7 @@ `(defrecord ~tagname ~fields ITraversable (~'-postwalk [this# ~f] - (let [new# (new ~tagname ~@(map #(list 'datascript.parser/postwalk % f) fields))] + (let [new# (~(symbol (str "->" tagname)) ~@(map #(list 'datascript.parser/postwalk % f) fields))] (if-let [meta# (meta this#)] (with-meta new# meta#) new#))) @@ -39,27 +38,27 @@ (defn of-size? [form size] (and (sequential? form) - (= (count form) size))) + (= (count form) size))) (defn parse-seq [parse-el form] (when (sequential? form) (reduce #(if-let [parsed (parse-el %2)] (conj %1 parsed) (reduced nil)) - [] form))) + [] form))) (defn collect ([pred form] (collect pred form [])) ([pred form acc] - (cond - (pred form) (conj acc form) - (satisfies? ITraversable form) (-collect form pred acc) - (db/seqable? form) (reduce (fn [acc form] (collect pred form acc)) acc form) - :else acc))) + (cond + (pred form) (conj acc form) + (satisfies? ITraversable form) (-collect form pred acc) + (db/seqable? form) (reduce (fn [acc form] (collect pred form acc)) acc form) + :else acc))) (defn distinct? [coll] (or (empty? coll) - (apply clojure.core/distinct? coll))) + (apply clojure.core/distinct? coll))) (defn postwalk [form f] (cond @@ -92,45 +91,46 @@ (deftrecord Constant [value]) (deftrecord PlainSymbol [symbol]) + (defn parse-placeholder [form] (when (= '_ form) - (Placeholder.))) + (->Placeholder))) (defn parse-variable [form] (when (and (symbol? form) - (= (first (name form)) \?)) - (Variable. form))) + (= (first (name form)) \?)) + (->Variable form))) (defn parse-var-required [form] (or (parse-variable form) - (util/raise "Cannot parse var, expected symbol starting with ?, got: " form + (raise "Cannot parse var, expected symbol starting with ?, got: " form {:error :parser/rule-var, :form form}))) (defn parse-src-var [form] (when (and (symbol? form) - (= (first (name form)) \$)) - (SrcVar. form))) + (= (first (name form)) \$)) + (->SrcVar form))) (defn parse-rules-var [form] (when (= '% form) - (RulesVar.))) + (->RulesVar))) (defn parse-constant [form] (when-not (and (symbol? form) - (= (first (name form)) \?)) - (Constant. form))) + (= (first (name form)) \?)) + (->Constant form))) (defn parse-plain-symbol [form] (when (and (symbol? form) - (not (parse-variable form)) - (not (parse-src-var form)) - (not (parse-rules-var form)) - (not (parse-placeholder form))) - (PlainSymbol. form))) + (not (parse-variable form)) + (not (parse-src-var form)) + (not (parse-rules-var form)) + (not (parse-placeholder form))) + (->PlainSymbol form))) (defn parse-plain-variable [form] (when (parse-plain-symbol form) - (Variable. form))) + (->Variable form))) @@ -138,8 +138,8 @@ (defn parse-fn-arg [form] (or (parse-variable form) - (parse-src-var form) - (parse-constant form))) + (parse-src-var form) + (parse-constant form))) ;; rule-vars = [ variable+ | ([ variable+ ] variable*) ] @@ -153,14 +153,14 @@ required* (parse-seq parse-var-required required) free* (parse-seq parse-var-required rest)] (when (and (empty? required*) (empty? free*)) - (util/raise "Cannot parse rule-vars, expected [ variable+ | ([ variable+ ] variable*) ]" - {:error :parser/rule-vars, :form form})) + (raise "Cannot parse rule-vars, expected [ variable+ | ([ variable+ ] variable*) ]" + {:error :parser/rule-vars, :form form})) (when-not (distinct? (concat required* free*)) - (util/raise "Rule variables should be distinct" - {:error :parser/rule-vars, :form form})) - (RuleVars. required* free*)) - (util/raise "Cannot parse rule-vars, expected [ variable+ | ([ variable+ ] variable*) ]" - {:error :parser/rule-vars, :form form}))) + (raise "Rule variables should be distinct" + {:error :parser/rule-vars, :form form})) + (->RuleVars required* free*)) + (raise "Cannot parse rule-vars, expected [ variable+ | ([ variable+ ] variable*) ]" + {:error :parser/rule-vars, :form form}))) (defn flatten-rule-vars [rule-vars] (concat @@ -185,45 +185,45 @@ (defn parse-bind-ignore [form] (when (= '_ form) - (with-source (BindIgnore.) form))) + (with-source (->BindIgnore) form))) (defn parse-bind-scalar [form] (when-let [var (parse-variable form)] - (with-source (BindScalar. var) form))) + (with-source (->BindScalar var) form))) (defn parse-bind-coll [form] (when (and (of-size? form 2) - (= (second form) '...)) + (= (second form) '...)) (if-let [sub-bind (parse-binding (first form))] - (with-source (BindColl. sub-bind) form) - (util/raise "Cannot parse collection binding" - {:error :parser/binding, :form form})))) + (with-source (->BindColl sub-bind) form) + (raise "Cannot parse collection binding" + {:error :parser/binding, :form form})))) (defn parse-tuple-el [form] (or (parse-bind-ignore form) - (parse-binding form))) + (parse-binding form))) (defn parse-bind-tuple [form] (when-let [sub-bindings (parse-seq parse-tuple-el form)] (if-not (empty? sub-bindings) - (with-source (BindTuple. sub-bindings) form) - (util/raise "Tuple binding cannot be empty" - {:error :parser/binding, :form form})))) + (with-source (->BindTuple sub-bindings) form) + (raise "Tuple binding cannot be empty" + {:error :parser/binding, :form form})))) (defn parse-bind-rel [form] (when (and (of-size? form 1) - (sequential? (first form))) + (sequential? (first form))) ;; relation is just a sequence of tuples - (with-source (BindColl. (parse-bind-tuple (first form))) form))) + (with-source (->BindColl (parse-bind-tuple (first form))) form))) (defn parse-binding [form] (or (parse-bind-coll form) - (parse-bind-rel form) - (parse-bind-tuple form) - (parse-bind-ignore form) - (parse-bind-scalar form) - (util/raise "Cannot parse binding, expected (bind-scalar | bind-tuple | bind-coll | bind-rel)" - {:error :parser/binding, :form form}))) + (parse-bind-rel form) + (parse-bind-tuple form) + (parse-bind-ignore form) + (parse-bind-scalar form) + (raise "Cannot parse binding, expected (bind-scalar | bind-tuple | bind-coll | bind-rel)" + {:error :parser/binding, :form form}))) ;; find-spec = ':find' (find-rel | find-coll | find-tuple | find-scalar) @@ -231,7 +231,7 @@ ;; find-coll = [ find-elem '...' ] ;; find-scalar = find-elem '.' ;; find-tuple = [ find-elem+ ] -;; find-elem = (variable | pull-expr | aggregate | custom-aggregate) +;; find-elem = (variable | pull-expr | aggregate | custom-aggregate) ;; pull-expr = [ 'pull' src-var? variable pull-pattern ] ;; pull-pattern = (constant | variable | plain-symbol) ;; aggregate = [ aggregate-fn fn-arg+ ] @@ -275,91 +275,92 @@ (defn pull? [element] (instance? Pull element)) + (defn parse-aggregate [form] (when (and (sequential? form) - (>= (count form) 2)) + (>= (count form) 2)) (let [[fn & args] form fn* (parse-plain-symbol fn) args* (parse-seq parse-fn-arg args)] (when (and fn* args*) - (Aggregate. fn* args*))))) + (->Aggregate fn* args*))))) (defn parse-aggregate-custom [form] (when (and (sequential? form) - (= (first form) 'aggregate)) + (= (first form) 'aggregate)) (if (>= (count form) 3) (let [[_ fn & args] form fn* (parse-variable fn) args* (parse-seq parse-fn-arg args)] (if (and fn* args*) - (Aggregate. fn* args*) - (util/raise "Cannot parse custom aggregate call, expect ['aggregate' variable fn-arg+]" - {:error :parser/find, :fragment form}))) - (util/raise "Cannot parse custom aggregate call, expect ['aggregate' variable fn-arg+]" - {:error :parser/find, :fragment form})))) + (->Aggregate fn* args*) + (raise "Cannot parse custom aggregate call, expect ['aggregate' variable fn-arg+]" + {:error :parser/find, :fragment form}))) + (raise "Cannot parse custom aggregate call, expect ['aggregate' variable fn-arg+]" + {:error :parser/find, :fragment form})))) (defn parse-pull-expr [form] (when (and (sequential? form) - (= (first form) 'pull)) + (= (first form) 'pull)) (if (<= 3 (count form) 4) (let [long? (= (count form) 4) src (if long? (nth form 1) '$) [var pattern] (if long? (nnext form) (next form)) - src* (parse-src-var src) + src* (parse-src-var src) var* (parse-variable var) pattern* (or (parse-variable pattern) - (parse-plain-variable pattern) - (parse-constant pattern))] + (parse-plain-variable pattern) + (parse-constant pattern))] (if (and src* var* pattern*) - (Pull. src* var* pattern*) - (util/raise "Cannot parse pull expression, expect ['pull' src-var? variable (constant | variable | plain-symbol)]" - {:error :parser/find, :fragment form}))) - (util/raise "Cannot parse pull expression, expect ['pull' src-var? variable (constant | variable | plain-symbol)]" - {:error :parser/find, :fragment form})))) + (->Pull src* var* pattern*) + (raise "Cannot parse pull expression, expect ['pull' src-var? variable (constant | variable | plain-symbol)]" + {:error :parser/find, :fragment form}))) + (raise "Cannot parse pull expression, expect ['pull' src-var? variable (constant | variable | plain-symbol)]" + {:error :parser/find, :fragment form})))) (defn parse-find-elem [form] (or (parse-variable form) - (parse-pull-expr form) - (parse-aggregate-custom form) - (parse-aggregate form))) + (parse-pull-expr form) + (parse-aggregate-custom form) + (parse-aggregate form))) (defn parse-find-rel [form] (some-> (parse-seq parse-find-elem form) - (FindRel.))) + (->FindRel))) (defn parse-find-coll [form] (when (and (sequential? form) - (= (count form) 1)) + (= (count form) 1)) (let [inner (first form)] (when (and (sequential? inner) - (= (count inner) 2) - (= (second inner) '...)) + (= (count inner) 2) + (= (second inner) '...)) (some-> (parse-find-elem (first inner)) - (FindColl.)))))) + (->FindColl)))))) (defn parse-find-scalar [form] (when (and (sequential? form) - (= (count form) 2) - (= (second form) '.)) + (= (count form) 2) + (= (second form) '.)) (some-> (parse-find-elem (first form)) - (FindScalar.)))) + (->FindScalar)))) (defn parse-find-tuple [form] (when (and (sequential? form) - (= (count form) 1)) + (= (count form) 1)) (let [inner (first form)] (some-> (parse-seq parse-find-elem inner) - (FindTuple.))))) + (->FindTuple))))) (defn parse-find [form] (or (parse-find-rel form) - (parse-find-coll form) - (parse-find-scalar form) - (parse-find-tuple form) - (util/raise "Cannot parse :find, expected: (find-rel | find-coll | find-tuple | find-scalar)" - {:error :parser/find, :fragment form}))) + (parse-find-coll form) + (parse-find-scalar form) + (parse-find-tuple form) + (raise "Cannot parse :find, expected: (find-rel | find-coll | find-tuple | find-scalar)" + {:error :parser/find, :fragment form}))) ;; return-map = (return-keys | return-syms | return-strs) @@ -373,9 +374,9 @@ (when (and (not (empty? form)) (every? symbol? form)) (case type - :keys (ReturnMap. type (mapv keyword form)) - :syms (ReturnMap. type (vec form)) - :strs (ReturnMap. type (mapv str form)) + :keys (->ReturnMap type (mapv keyword form)) + :syms (->ReturnMap type (vec form)) + :strs (->ReturnMap type (mapv str form)) nil))) ;; with = [ variable+ ] @@ -383,24 +384,24 @@ (defn parse-with [form] (or (parse-seq parse-variable form) - (util/raise "Cannot parse :with clause, expected [ variable+ ]" - {:error :parser/with, :form form}))) + (raise "Cannot parse :with clause, expected [ variable+ ]" + {:error :parser/with, :form form}))) ;; in = [ (src-var | rules-var | plain-symbol | binding)+ ] (defn- parse-in-binding [form] (if-let [var (or (parse-src-var form) - (parse-rules-var form) - (parse-plain-variable form))] - (with-source (BindScalar. var) form) + (parse-rules-var form) + (parse-plain-variable form))] + (with-source (->BindScalar var) form) (parse-binding form))) (defn parse-in [form] (or (parse-seq parse-in-binding form) - (util/raise "Cannot parse :in clause, expected (src-var | % | plain-symbol | bind-scalar | bind-tuple | bind-coll | bind-rel)" - {:error :parser/in, :form form}))) + (raise "Cannot parse :in clause, expected (src-var | % | plain-symbol | bind-scalar | bind-tuple | bind-coll | bind-rel)" + {:error :parser/in, :form form}))) ;; clause = (data-pattern | pred-expr | fn-expr | rule-expr | not-clause | not-join-clause | or-clause | or-join-clause) @@ -418,37 +419,38 @@ (deftrecord Pattern [source pattern]) (deftrecord Predicate [fn args]) -(deftrecord Function [fn args binding]) +(deftrecord FunctionCall [fn args binding]) (deftrecord RuleExpr [source name args]) ;; TODO rule with constant or '_' as argument (deftrecord Not [source vars clauses]) (deftrecord Or [source rule-vars clauses]) (deftrecord And [clauses]) + (defn parse-pattern-el [form] (or (parse-placeholder form) - (parse-variable form) - (parse-constant form))) + (parse-variable form) + (parse-constant form))) (defn take-source [form] (when (sequential? form) (if-let [source* (parse-src-var (first form))] [source* (next form)] - [(DefaultSrc.) form]))) - + [(->DefaultSrc) form]))) + (defn parse-pattern [form] (when-let [[source* next-form] (take-source form)] (when-let [pattern* (parse-seq parse-pattern-el next-form)] (if-not (empty? pattern*) - (with-source (Pattern. source* pattern*) form) - (util/raise "Pattern could not be empty" - {:error :parser/where, :form form}))))) + (with-source (->Pattern source* pattern*) form) + (raise "Pattern could not be empty" + {:error :parser/where, :form form}))))) (defn parse-call [form] (when (sequential? form) (let [[fn & args] form args (if (nil? args) [] args) fn* (or (parse-plain-symbol fn) - (parse-variable fn)) + (parse-variable fn)) args* (parse-seq parse-fn-arg args)] (when (and fn* args*) [fn* args*])))) @@ -456,16 +458,16 @@ (defn parse-pred [form] (when (of-size? form 1) (when-let [[fn* args*] (parse-call (first form))] - (-> (Predicate. fn* args*) - (with-source form))))) + (-> (->Predicate fn* args*) + (with-source form))))) (defn parse-fn [form] (when (of-size? form 2) (let [[call binding] form] (when-let [[fn* args*] (parse-call call)] (when-let [binding* (parse-binding binding)] - (-> (Function. fn* args* binding*) - (with-source form))))))) + (-> (->FunctionCall fn* args* binding*) + (with-source form))))))) (defn parse-rule-expr [form] (when-let [[source* next-form] (take-source form)] @@ -475,37 +477,38 @@ (when name* (cond (empty? args) - (util/raise "rule-expr requires at least one argument" - {:error :parser/where, :form form}) + (raise "rule-expr requires at least one argument" + {:error :parser/where, :form form}) (nil? args*) - (util/raise "Cannot parse rule-expr arguments, expected [ (variable | constant | '_')+ ]" - {:error :parser/where, :form form}) + (raise "Cannot parse rule-expr arguments, expected [ (variable | constant | '_')+ ]" + {:error :parser/where, :form form}) :else - (RuleExpr. source* name* args*)))))) + (->RuleExpr source* name* args*) + ))))) (defn- collect-vars-acc [acc form] (cond (instance? Variable form) - (conj acc form) + (conj acc form) (instance? Not form) - (into acc (:vars form)) + (into acc (:vars form)) (instance? Or form) - (collect-vars-acc acc (:rule-vars form)) + (collect-vars-acc acc (:rule-vars form)) (satisfies? ITraversable form) - (-collect-vars form acc) + (-collect-vars form acc) (sequential? form) - (reduce collect-vars-acc acc form) + (reduce collect-vars-acc acc form) :else acc)) (defn- collect-vars [form] (collect-vars-acc [] form)) - + (defn collect-vars-distinct [form] (vec (distinct (collect-vars form)))) (defn- validate-join-vars [required free form] (when (and (empty? required) (empty? free)) - (util/raise "Join variables should not be empty" + (raise "Join variables should not be empty" {:error :parser/where, :form form}))) (defn- validate-not [clause form] @@ -517,11 +520,11 @@ (let [[sym & clauses] next-form] (when (= 'not sym) (if-let [clauses* (parse-clauses clauses)] - (-> (Not. source* (collect-vars-distinct clauses*) clauses*) - (with-source form) - (validate-not form)) - (util/raise "Cannot parse 'not' clause, expected [ src-var? 'not' clause+ ]" - {:error :parser/where, :form form})))))) + (-> (->Not source* (collect-vars-distinct clauses*) clauses*) + (with-source form) + (validate-not form)) + (raise "Cannot parse 'not' clause, expected [ src-var? 'not' clause+ ]" + {:error :parser/where, :form form})))))) (defn parse-not-join [form] (when-let [[source* next-form] (take-source form)] @@ -530,11 +533,11 @@ (let [vars* (parse-seq parse-variable vars) clauses* (parse-clauses clauses)] (if (and vars* clauses*) - (-> (Not. source* vars* clauses*) - (with-source form) - (validate-not form)) - (util/raise "Cannot parse 'not-join' clause, expected [ src-var? 'not-join' [variable+] clause+ ]" - {:error :parser/where, :form form}))))))) + (-> (->Not source* vars* clauses*) + (with-source form) + (validate-not form)) + (raise "Cannot parse 'not-join' clause, expected [ src-var? 'not-join' [variable+] clause+ ]" + {:error :parser/where, :form form}))))))) (defn validate-or [clause form] (let [{{required :required @@ -544,23 +547,23 @@ (defn parse-and [form] (when (and (sequential? form) - (= 'and (first form))) + (= 'and (first form))) (let [clauses* (parse-clauses (next form))] (if (not-empty clauses*) - (And. clauses*) - (util/raise "Cannot parse 'and' clause, expected [ 'and' clause+ ]" - {:error :parser/where, :form form}))))) + (->And clauses*) + (raise "Cannot parse 'and' clause, expected [ 'and' clause+ ]" + {:error :parser/where, :form form}))))) (defn parse-or [form] (when-let [[source* next-form] (take-source form)] (let [[sym & clauses] next-form] (when (= 'or sym) (if-let [clauses* (parse-seq (some-fn parse-and parse-clause) clauses)] - (-> (Or. source* (RuleVars. nil (collect-vars-distinct clauses*)) clauses*) - (with-source form) - (validate-or form)) - (util/raise "Cannot parse 'or' clause, expected [ src-var? 'or' clause+ ]" - {:error :parser/where, :form form})))))) + (-> (->Or source* (->RuleVars nil (collect-vars-distinct clauses*)) clauses*) + (with-source form) + (validate-or form)) + (raise "Cannot parse 'or' clause, expected [ src-var? 'or' clause+ ]" + {:error :parser/where, :form form})))))) (defn parse-or-join [form] (when-let [[source* next-form] (take-source form)] @@ -569,60 +572,61 @@ (let [vars* (parse-rule-vars vars) clauses* (parse-seq (some-fn parse-and parse-clause) clauses)] (if (and vars* clauses*) - (-> (Or. source* vars* clauses*) - (with-source form) - (validate-or form)) - (util/raise "Cannot parse 'or-join' clause, expected [ src-var? 'or-join' [variable+] clause+ ]" - {:error :parser/where, :form form}))))))) + (-> (->Or source* vars* clauses*) + (with-source form) + (validate-or form)) + (raise "Cannot parse 'or-join' clause, expected [ src-var? 'or-join' [variable+] clause+ ]" + {:error :parser/where, :form form}))))))) #_(defn reorder-nots [parent-vars clauses] - (loop [acc [] - clauses clauses - vars (set parent-vars) - pending []] - (if-let [sufficient (not-empty (filter #(set/subset? (set (:vars %)) vars) pending))] - (recur (into acc sufficient) - clauses - vars - (remove (set sufficient) pending)) - (if-let [clause (first clauses)] - (if (instance? Not clause) - (recur acc (next clauses) vars (conj pending clause)) - (recur (conj acc clause) - (next clauses) - (into vars (collect-vars clause)) - pending)) - (if (empty? pending) - acc - (let [not (first pending) - missing (->> (set/difference (set (:vars not)) vars) - (into #{} (map :symbol)))] - (throw (ex-info (str "Insufficient bindings: " missing " are not bound in clause " (source not)) - {:error :parser/where - :form (source not) - :vars missing})))))))) + (loop [acc [] + clauses clauses + vars (set parent-vars) + pending []] + (if-let [sufficient (not-empty (filter #(set/subset? (set (:vars %)) vars) pending))] + (recur (into acc sufficient) + clauses + vars + (remove (set sufficient) pending)) + (if-let [clause (first clauses)] + (if (instance? Not clause) + (recur acc (next clauses) vars (conj pending clause)) + (recur (conj acc clause) + (next clauses) + (into vars (collect-vars clause)) + pending)) + (if (empty? pending) + acc + (let [not (first pending) + missing (->> (set/difference (set (:vars not)) vars) + (into #{} (map :symbol)))] + (throw (ex-info (str "Insufficient bindings: " missing " are not bound in clause " (source not)) + {:error :parser/where + :form (source not) + :vars missing})))))))) + (defn parse-clause [form] - (or - (parse-not form) - (parse-not-join form) - (parse-or form) - (parse-or-join form) - (parse-pred form) - (parse-fn form) - (parse-rule-expr form) - (parse-pattern form) - (util/raise "Cannot parse clause, expected (data-pattern | pred-expr | fn-expr | rule-expr | not-clause | not-join-clause | or-clause | or-join-clause)" - {:error :parser/where, :form form}))) + (or + (parse-not form) + (parse-not-join form) + (parse-or form) + (parse-or-join form) + (parse-pred form) + (parse-fn form) + (parse-rule-expr form) + (parse-pattern form) + (raise "Cannot parse clause, expected (data-pattern | pred-expr | fn-expr | rule-expr | not-clause | not-join-clause | or-clause | or-join-clause)" + {:error :parser/where, :form form} ))) (defn parse-clauses [clauses] (parse-seq parse-clause clauses)) (defn parse-where [form] (or (parse-clauses form) - (util/raise "Cannot parse :where clause, expected [clause+]" - {:error :parser/where, :form form}))) + (raise "Cannot parse :where clause, expected [clause+]" + {:error :parser/where, :form form}))) ;; rule-branch = [rule-head clause+] @@ -638,18 +642,18 @@ (if (sequential? head) (let [[name & vars] head name* (or (parse-plain-symbol name) - (util/raise "Cannot parse rule name, expected plain-symbol" - {:error :parser/rule, :form form})) + (raise "Cannot parse rule name, expected plain-symbol" + {:error :parser/rule, :form form})) vars* (parse-rule-vars vars) clauses* (or (not-empty (parse-clauses clauses)) - (util/raise "Rule branch should have clauses" - {:error :parser/rule, :form form}))] - {:name name* - :vars vars* - :clauses clauses*}) - (util/raise "Cannot parse rule head, expected [rule-name rule-vars], got: " head + (raise "Rule branch should have clauses" + {:error :parser/rule, :form form}))] + {:name name* + :vars vars* + :clauses clauses*}) + (raise "Cannot parse rule head, expected [rule-name rule-vars], got: " head {:error :parser/rule, :form form}))) - (util/raise "Cannot parse rule, expected [rule-head clause+]" + (raise "Cannot parse rule, expected [rule-head clause+]" {:error :parser/rule, :form form}))) (defn validate-arity [name branches] @@ -658,18 +662,18 @@ (doseq [b (next branches) :let [vars (:vars b)]] (when (not= arity0 (rule-vars-arity vars)) - (util/raise "Arity mismatch for rule '" (:symbol name) "': " - (flatten-rule-vars vars0) " vs. " (flatten-rule-vars vars) - {:error :parser/rule, :rule name}))))) + (raise "Arity mismatch for rule '" (:symbol name) "': " + (flatten-rule-vars vars0) " vs. " (flatten-rule-vars vars) + {:error :parser/rule, :rule name}))))) (defn parse-rules [form] (vec ;; group rule branches by name (for [[name branches] (group-by :name (parse-seq parse-rule form)) - :let [branches (mapv #(RuleBranch. (:vars %) (:clauses %)) branches)]] + :let [branches (mapv #(->RuleBranch (:vars %) (:clauses %)) branches)]] (do (validate-arity name branches) - (Rule. name branches))))) + (->Rule name branches))))) ;; query @@ -704,27 +708,27 @@ in-vars (set (collect-vars (:qin q))) where-vars (set (collect-vars (:qwhere q))) unknown (set/difference (set/union find-vars with-vars) - (set/union where-vars in-vars)) + (set/union where-vars in-vars)) shared (set/intersection find-vars with-vars)] (when-not (empty? unknown) - (util/raise "Query for unknown vars: " (mapv :symbol unknown) + (raise "Query for unknown vars: " (mapv :symbol unknown) {:error :parser/query, :vars unknown, :form form})) (when-not (empty? shared) - (util/raise ":find and :with should not use same variables: " (mapv :symbol shared) + (raise ":find and :with should not use same variables: " (mapv :symbol shared) {:error :parser/query, :vars shared, :form form}))) (when-some [return-map (:qreturn-map q)] (when (instance? FindScalar (:qfind q)) - (util/raise (:type return-map) " does not work with single-scalar :find" + (raise (:type return-map) " does not work with single-scalar :find" {:error :parser/query, :form form})) (when (instance? FindColl (:qfind q)) - (util/raise (:type return-map) " does not work with collection :find" + (raise (:type return-map) " does not work with collection :find" {:error :parser/query, :form form}))) (when-some [return-symbols (:symbols (:qreturn-map q))] (let [find-elements (find-elements (:qfind q))] (when-not (= (count return-symbols) (count find-elements)) - (util/raise "Count of " (:type (:qreturn-map q)) " must match count of :find" + (raise "Count of " (:type (:qreturn-map q)) " must match count of :find" {:error :parser/query :return-map (cons (:type (:qreturn-map q)) return-symbols) :find find-elements @@ -733,43 +737,43 @@ (when (< 1 (->> [(:keys form-map) (:syms form-map) (:strs form-map)] (filter some?) (count))) - (util/raise "Only one of :keys/:syms/:strs must be present" + (raise "Only one of :keys/:syms/:strs must be present" {:error :parser/query, :form form})) - + (let [in-vars (collect-vars (:qin q)) in-sources (collect #(instance? SrcVar %) (:qin q)) in-rules (collect #(instance? RulesVar %) (:qin q))] (when-not (and (distinct? in-vars) - (distinct? in-sources) - (distinct? in-rules)) - (util/raise "Vars used in :in should be distinct" - {:error :parser/query, :form form}))) - + (distinct? in-sources) + (distinct? in-rules)) + (raise "Vars used in :in should be distinct" + {:error :parser/query, :form form}))) + (let [with-vars (collect-vars (:qwith q))] (when-not (distinct? with-vars) - (util/raise "Vars used in :with should be distinct" - {:error :parser/query, :form form}))) - + (raise "Vars used in :with should be distinct" + {:error :parser/query, :form form}))) + (let [in-sources (collect #(instance? SrcVar %) (:qin q) #{}) where-sources (collect #(instance? SrcVar %) (:qwhere q) #{}) unknown (set/difference where-sources in-sources)] (when-not (empty? unknown) - (util/raise "Where uses unknown source vars: " (mapv :symbol unknown) - {:error :parser/query, :vars unknown, :form form}))) - + (raise "Where uses unknown source vars: " (mapv :symbol unknown) + {:error :parser/query, :vars unknown, :form form}))) + (let [rule-exprs (collect #(instance? RuleExpr %) (:qwhere q)) rules-vars (collect #(instance? RulesVar %) (:qin q))] (when (and (not (empty? rule-exprs)) - (empty? rules-vars)) - (util/raise "Missing rules var '%' in :in" - {:error :parser/query, :form form})))) + (empty? rules-vars)) + (raise "Missing rules var '%' in :in" + {:error :parser/query, :form form})))) (defn parse-query [q] (let [qm (cond (map? q) q (sequential? q) (query->map q) - :else (util/raise "Query should be a vector or a map" - {:error :parser/query, :form q})) + :else (raise "Query should be a vector or a map" + {:error :parser/query, :form q})) qwhere (parse-where (:where qm [])) res (map->Query {:qfind (parse-find (:find qm)) diff --git a/src/datascript/pull_api.cljc b/src/datascript/pull_api.cljc index 478eda83..049facd8 100644 --- a/src/datascript/pull_api.cljc +++ b/src/datascript/pull_api.cljc @@ -1,33 +1,39 @@ (ns ^:no-doc datascript.pull-api (:require - [clojure.string :as str] - [datascript.pull-parser :as dpp] - [datascript.db :as db #?@(:cljs [:refer [DB]])] - [datascript.lru :as lru] - [datascript.util :as util] - [me.tonsky.persistent-sorted-set :as set]) - #?(:clj + [clojure.string :as str] + [datascript.pull-parser :as dpp #?@(:cljd [:refer [PullAttr PullPattern]])] + #?(:cljd [datascript.db :as db :refer [DB Datom]] + :clj [datascript.db :as db] + :cljs [datascript.db :as db :refer [DB]]) + [datascript.lru :as lru] + [datascript.util :as util] + #?(:cljd nil + :default [me.tonsky.persistent-sorted-set :as set]) + #?(:cljd [cljd.core :refer [Keyword]])) + #?(:cljd nil + :clj (:import - [clojure.lang ISeq] - [datascript.db Datom DB] - [datascript.pull_parser PullAttr PullPattern]))) + [clojure.lang ISeq] + [datascript.db Datom DB] + [datascript.pull_parser PullAttr PullPattern]))) (declare pull-impl attrs-frame ref-frame ->ReverseAttrsFrame) -(defn- first-seq [#?(:clj ^ISeq xs :cljs ^seq xs)] +(defn- first-seq [#?(:cljd ^some xs :clj ^ISeq xs :cljs ^seq xs)] (if (nil? xs) nil - #?(:clj (.first xs) :cljs (-first xs)))) + #?(:cljd (-first xs) :clj (.first xs) :cljs (-first xs)))) -(defn- next-seq [#?(:clj ^ISeq xs :cljs ^seq xs)] +(defn- next-seq [#?(:cljd ^some xs :clj ^ISeq xs :cljs ^seq xs)] (if (nil? xs) nil - #?(:clj (.next xs) :cljs (-next xs)))) + #?(:cljd (-next xs) :clj (.next xs) :cljs (-next xs)))) -(defn- conj-seq [#?(:clj ^ISeq xs :cljs ^seq xs) x] +(defn- conj-seq [#?(:cljd ^some xs :clj ^ISeq xs :cljs ^seq xs) x] (if (nil? xs) (list x) - #?(:clj (.cons xs x) :cljs (-conj xs x)))) + #?(:cljd (-conj xs x) :clj (.cons xs x) :cljs (-conj xs x)))) + (defn- assoc-some! [m k v] (if (nil? v) m (assoc! m k v))) @@ -59,185 +65,215 @@ (-run [this context] (loop [acc acc datoms datoms] + #_(dart:core/print (pr-str :pull attr (map #(nth acc %) (range (count acc))) + (first-seq datoms)) + ) (util/cond+ - :let [^Datom datom (first-seq datoms)] - - (or (nil? datom) (not= (.-a datom) (.-name attr))) - [(ResultFrame. (not-empty (persistent! acc)) (or datoms ()))] - - ; got limit, skip rest of the datoms - (and (.-limit attr) (>= (count acc) (.-limit attr))) - (loop [datoms datoms] - (let [^Datom datom (first-seq datoms)] - (if (or (nil? datom) (not= (.-a datom) (.-name attr))) - [(ResultFrame. (persistent! acc) (or datoms ()))] - (recur (next-seq datoms))))) - - :else - (recur (conj! acc (.-v datom)) (next-seq datoms))))) - + :let [#?(:cljd ^Datom? datom :default ^Datom datom) (first-seq datoms)] + + (or (nil? datom) (not= (.-a datom) (.-name attr))) + [(#?(:cljd ->ResultFrame :default ResultFrame.) ((.-xform attr) (not-empty (persistent! acc))) (or datoms ()))] + +; got limit, skip rest of the datoms + (and (.-limit attr) (>= (count acc) (.-limit attr))) + (loop [datoms datoms] + (let [#?(:cljd ^Datom? datom :default ^Datom datom) (first-seq datoms)] + (if (or (nil? datom) (not= (.-a datom) (.-name attr))) + [(#?(:cljd ->ResultFrame :default ResultFrame.) (persistent! acc) (or datoms ()))] + (recur (next-seq datoms))))) + + :else + (recur (conj! acc (.-v datom)) (next-seq datoms))))) + (-str [this] (str "MultivalAttrFrame"))) (defrecord MultivalRefAttrFrame [seen recursion-limits acc pattern ^PullAttr attr datoms] IFrame (-merge [this result] - (MultivalRefAttrFrame. - seen - recursion-limits - (conj-some! acc (.-value ^ResultFrame result)) - pattern - attr - (next-seq datoms))) - + (#?(:cljd ->MultivalRefAttrFrame :default MultivalRefAttrFrame.) + seen + recursion-limits + (conj-some! acc (.-value ^ResultFrame result)) + pattern + attr + (next-seq datoms))) + (-run [this context] (util/cond+ - :let [^Datom datom (first-seq datoms)] + :let [#?(:cljd ^Datom? datom :default ^Datom datom) (first-seq datoms)] - (or (nil? datom) (not= (.-a datom) (.-name attr))) - [(ResultFrame. (not-empty (persistent! acc)) (or datoms ()))] + (or (nil? datom) (not= (.-a datom) (.-name attr))) + [(#?(:cljd ->ResultFrame :default ResultFrame.) ((.-xform attr) (not-empty (persistent! acc))) (or datoms ()))] - ; got limit, skip rest of the datoms - (and (.-limit attr) (>= (count acc) (.-limit attr))) - (loop [datoms datoms] - (let [^Datom datom (first-seq datoms)] - (if (or (nil? datom) (not= (.-a datom) (.-name attr))) - [(ResultFrame. (persistent! acc) (or datoms ()))] - (recur (next-seq datoms))))) +; got limit, skip rest of the datoms + (and (.-limit attr) (>= (count acc) (.-limit attr))) + (loop [datoms datoms] + (let [#?(:cljd ^Datom? datom :default ^Datom datom) (first-seq datoms)] + (if (or (nil? datom) (not= (.-a datom) (.-name attr))) + [(#?(:cljd ->ResultFrame :default ResultFrame.) (persistent! acc) (or datoms ()))] + (recur (next-seq datoms))))) - :let [id (if (.-reverse? attr) (.-e datom) (.-v datom))] + :let [id (if (.-reverse? attr) (.-e datom) (.-v datom))] + + :else + [this (ref-frame context seen recursion-limits pattern attr id)])) - :else - [this (ref-frame context seen recursion-limits pattern attr id)])) - (-str [this] (str "MultivalAttrFrame"))) -(defrecord AttrsFrame [seen recursion-limits acc ^PullPattern pattern ^PullAttr attr attrs datoms id] +(defrecord AttrsFrame [seen recursion-limits acc ^PullPattern pattern #?(:cljd ^PullAttr? attr :default ^PullAttr attr) attrs datoms id] IFrame (-merge [this result] - (AttrsFrame. - seen - recursion-limits - (assoc-some! acc (.-as attr) ((.-xform attr) (.-value ^ResultFrame result))) - pattern - (first-seq attrs) - (next-seq attrs) - (not-empty (or (.-datoms ^ResultFrame result) (next-seq datoms))) - id)) + (#?(:cljd ->AttrsFrame :default AttrsFrame.) + seen + recursion-limits + (assoc-some! acc (.-as attr) (.-value ^ResultFrame result)) + pattern + (first-seq attrs) + (next-seq attrs) + (not-empty (or (.-datoms ^ResultFrame result) (next-seq datoms))) + id)) (-run [this context] (loop [acc acc - attr attr + #?(:cljd ^PullAttr? attr :default attr) attr ; cljd bug except for the nil attrs attrs datoms datoms] (util/cond+ - ;; exit - (and (nil? datoms) (nil? attr)) - [(->ReverseAttrsFrame seen recursion-limits acc pattern (first-seq (.-reverse-attrs pattern)) (next-seq (.-reverse-attrs pattern)) id)] - - ;; :db/id - (and (some? attr) (= :db/id (.-name attr))) - (recur (assoc! acc (.-as attr) ((.-xform attr) id)) (first-seq attrs) (next-seq attrs) datoms) - - :let [^Datom datom (first-seq datoms) - cmp (when (and datom attr) - (compare (.-name attr) (.-a datom))) - attr-ahead? (or (nil? attr) (and cmp (pos? cmp))) - datom-ahead? (or (nil? datom) (and cmp (neg? cmp)))] - - ;; wildcard - (and (.-wildcard? pattern) (some? datom) attr-ahead?) - (let [datom-attr (lru/-get - (.-pull-attrs (db/unfiltered-db (.-db ^Context context))) - (.-a datom) - #(dpp/parse-attr-name (.-db ^Context context) (.-a datom)))] - (recur acc datom-attr (when attr (conj-seq attrs attr)) datoms)) - - ;; advance datom - attr-ahead? - (recur acc attr attrs (next-seq datoms)) - - :do (visit context :db.pull/attr id (.-name attr) nil) - - ;; advance attr - (and datom-ahead? (nil? attr)) - (recur acc (first-seq attrs) (next-seq attrs) datoms) - - ;; default - (and datom-ahead? (some? (#?(:clj .-default :cljs :default) attr))) - (recur (assoc! acc (.-as attr) (#?(:clj .-default :cljs :default) attr)) (first-seq attrs) (next-seq attrs) datoms) - - ;; xform - datom-ahead? - (if-some [value ((.-xform attr) nil)] - (recur (assoc! acc (.-as attr) value) (first-seq attrs) (next-seq attrs) datoms) - (recur acc (first-seq attrs) (next-seq attrs) datoms)) - - ;; matching attr - (and (.-multival? attr) (.-ref? attr)) - [(AttrsFrame. seen recursion-limits acc pattern attr attrs datoms id) - (MultivalRefAttrFrame. seen recursion-limits (transient []) pattern attr datoms)] - - (.-multival? attr) - [(AttrsFrame. seen recursion-limits acc pattern attr attrs datoms id) - (MultivalAttrFrame. (transient []) attr datoms)] - - (.-ref? attr) - [(AttrsFrame. seen recursion-limits acc pattern attr attrs datoms id) - (ref-frame context seen recursion-limits pattern attr (.-v datom))] - - :else - (recur - (assoc! acc (.-as attr) ((.-xform attr) (.-v datom))) - (first-seq attrs) - (next-seq attrs) - (next-seq datoms))))) - + ;; exit + (and (nil? datoms) (nil? attr)) + [(->ReverseAttrsFrame seen recursion-limits acc pattern (first-seq (.-reverse-attrs pattern)) (next-seq (.-reverse-attrs pattern)) id)] + + ;; :db/id + (and (some? attr) (= :db/id (.-name attr))) + (recur (assoc! acc (.-as attr) ((.-xform attr) id)) (first-seq attrs) (next-seq attrs) datoms) + + :let [#?(:cljd ^Datom? datom :default ^Datom datom) (first-seq datoms) + cmp (when (and datom attr) + #?(:cljd + (let [^Keyword kw-a (.-name attr) + ^Keyword kw-b (.-a datom)] + (if (identical? kw-a kw-b) + 0 + (let [ns-a (.-ns kw-a) + ns-b (.-ns kw-b)] + (if (identical? ns-a ns-b) + (int (.compareTo (.-name kw-a) (.-name kw-b))) + (if (nil? ns-a) + -1 + (if (nil? ns-b) + 1 + (let [c (int (.compareTo ns-a ns-b))] + (if (== 0 c) + (int (.compareTo (.-name kw-a) (.-name kw-b))) + c)))))))) + :default (compare (.-name attr) (.-a datom)))) + attr-ahead? (or (nil? attr) (and cmp (pos? cmp))) + datom-ahead? (or (nil? datom) (and cmp (neg? cmp)))] + + ;; wildcard + (and (.-wildcard? pattern) (some? datom) attr-ahead?) + (let [datom-attr (lru/-get + (.-pull-attrs (db/unfiltered-db (.-db ^Context context))) + (.-a datom) + #(dpp/parse-attr-name (.-db ^Context context) (.-a datom)))] + (recur acc datom-attr (when attr (conj-seq attrs attr)) datoms)) + + ;; advance datom + attr-ahead? + (recur acc attr attrs (next-seq datoms)) + + :do (visit context :db.pull/attr id (.-name attr) nil) + + ;; advance attr + (and datom-ahead? (nil? attr)) + (recur acc (first-seq attrs) (next-seq attrs) datoms) + + ;; default + (and datom-ahead? (some? (.-default-val attr))) + (recur (assoc! acc (.-as attr) (.-default-val attr)) (first-seq attrs) (next-seq attrs) datoms) + + ;; xform + datom-ahead? + (if-some [value ((.-xform attr) nil)] + (recur (assoc! acc (.-as attr) value) (first-seq attrs) (next-seq attrs) datoms) + (recur acc (first-seq attrs) (next-seq attrs) datoms)) + + ;; matching attr + (and (.-multival? attr) (.-ref? attr)) + [(#?(:cljd ->AttrsFrame :default AttrsFrame.) + seen recursion-limits acc pattern attr attrs datoms id) + (#?(:cljd ->MultivalRefAttrFrame :default MultivalRefAttrFrame.) + seen recursion-limits (transient []) pattern attr datoms)] + + (.-multival? attr) + [(#?(:cljd ->AttrsFrame :default AttrsFrame.) + seen recursion-limits acc pattern attr attrs datoms id) + (#?(:cljd ->MultivalAttrFrame :default MultivalAttrFrame.) + (transient []) attr datoms)] + + (.-ref? attr) + [(#?(:cljd ->AttrsFrame :default AttrsFrame.) + seen recursion-limits acc pattern attr attrs datoms id) + (ref-frame context seen recursion-limits pattern attr (.-v datom))] + + :else + (recur + (assoc! acc (.-as attr) ((.-xform attr) (.-v datom))) + (first-seq attrs) + (next-seq attrs) + (next-seq datoms))))) + (-str [this] (str "AttrsFrame"))) -(defrecord ReverseAttrsFrame [seen recursion-limits acc pattern ^PullAttr attr attrs id] +(defrecord ReverseAttrsFrame [seen recursion-limits acc pattern #?(:cljd ^PullAttr? attr :default ^PullAttr attr) attrs id] IFrame (-merge [this result] - (ReverseAttrsFrame. - seen - recursion-limits - (assoc-some! acc (.-as attr) ((.-xform attr) (.-value ^ResultFrame result))) - pattern - (first-seq attrs) - (next-seq attrs) - id)) - + (#?(:cljd ->ReverseAttrsFrame :default ReverseAttrsFrame.) + seen + recursion-limits + (assoc-some! acc (.-as attr) (.-value ^ResultFrame result)) + pattern + (first-seq attrs) + (next-seq attrs) + id)) + (-run [this context] (loop [acc acc - attr attr + #?(:cljd ^PullAttr? attr :default attr) attr ; cljd loop inference bug attrs attrs] (util/cond+ - (nil? attr) - [(ResultFrame. (not-empty (persistent! acc)) nil)] + (nil? attr) + [(#?(:cljd ->ResultFrame :default ResultFrame.) + (not-empty (persistent! acc)) nil)] - :let [name (.-name attr) - db (.-db ^Context context) - datoms (if (instance? DB db) - (set/slice (.-avet ^DB db) (db/datom db/e0 name id db/tx0) (db/datom db/emax name id db/txmax)) - (db/-search db [nil name id]))] + :let [name (.-name attr) + db (.-db ^Context context) + datoms (if (instance? DB db) + (#?(:cljd db/set-slice :default set/slice) + (.-avet ^DB db) (db/datom db/e0 name id db/tx0) (db/datom db/emax name id db/txmax)) + (db/-search db [nil name id]))] - :do (visit context :db.pull/reverse nil name id) + :do (visit context :db.pull/reverse nil name id) - (and (empty? datoms) (some? (#?(:clj .-default :cljs :default) attr))) - (recur (assoc! acc (.-as attr) (#?(:clj .-default :cljs :default) attr)) (first-seq attrs) (next-seq attrs)) + (and (empty? datoms) (some? (.-default-val attr))) + (recur (assoc! acc (.-as attr) (.-default-val attr)) (first-seq attrs) (next-seq attrs)) - (empty? datoms) - (recur acc (first-seq attrs) (next-seq attrs)) + (empty? datoms) + (recur acc (first-seq attrs) (next-seq attrs)) - (.-component? attr) - [(ReverseAttrsFrame. seen recursion-limits acc pattern attr attrs id) - (ref-frame context seen recursion-limits pattern attr (.-e ^Datom (first-seq datoms)))] + (.-component? attr) + [(#?(:cljd ->ReverseAttrsFrame :default ReverseAttrsFrame.) + seen recursion-limits acc pattern attr attrs id) + (ref-frame context seen recursion-limits pattern attr (.-e ^Datom (first-seq datoms)))] + + :else + [(#?(:cljd ->ReverseAttrsFrame :default ReverseAttrsFrame.) + seen recursion-limits acc pattern attr attrs id) + (#?(:cljd ->MultivalRefAttrFrame :default MultivalRefAttrFrame.) + seen recursion-limits (transient []) pattern attr datoms)]))) - :else - [(ReverseAttrsFrame. seen recursion-limits acc pattern attr attrs id) - (MultivalRefAttrFrame. seen recursion-limits (transient []) pattern attr datoms)]))) - (-str [this] (str "ReverseAttrsFrame"))) @@ -254,12 +290,14 @@ (attrs-frame context seen recursion-limits (.-pattern attr) id) (seen id) - (ResultFrame. {:db/id id} nil) + (#?(:cljd ->ResultFrame :default ResultFrame.) + {:db/id id} nil) :let [lim (recursion-limits attr)] (and lim (<= lim 0)) - (ResultFrame. nil nil) + (#?(:cljd ->ResultFrame :default ResultFrame.) + nil nil) :let [seen' (conj seen id) recursion-limits' (cond @@ -270,69 +308,124 @@ :else (attrs-frame context seen' recursion-limits' (if (.-recursive? attr) pattern (.-pattern attr)) id))) + (defn attrs-frame [^Context context seen recursion-limits ^PullPattern pattern id] (let [db (.-db context) datoms (util/cond+ - (and (.-wildcard? pattern) (instance? DB db)) - (set/slice (.-eavt ^DB db) (db/datom id nil nil db/tx0) (db/datom id nil nil db/txmax)) - - (.-wildcard? pattern) - (db/-search db [id]) - - (nil? (.-first-attr pattern)) - nil - - :let [from (.-name ^PullAttr (.-first-attr pattern)) - to (.-name ^PullAttr (.-last-attr pattern))] - - (instance? DB db) - (set/slice (.-eavt ^DB db) (db/datom id from nil db/tx0) (db/datom id to nil db/txmax)) - - :else - (->> (db/-seek-datoms db :eavt id nil nil nil)) - (take-while - (fn [^Datom d] - (and - (= (.-e d) id) - (<= (compare (.-a d) to) 0)))))] + (and (.-wildcard? pattern) (instance? DB db)) + (#?(:cljd db/set-slice :default set/slice) + (.-eavt ^DB db) (db/datom id nil nil db/tx0) (db/datom id nil nil db/txmax)) + + (.-wildcard? pattern) + (db/-search db [id]) + + (nil? (.-first-attr pattern)) + nil + + :let [from (.-name ^PullAttr (.-first-attr pattern)) + to (.-name ^PullAttr (.-last-attr pattern))] + + (instance? DB db) + (do + #_(when (= 1500 (.-limit (.-first-attr pattern))) + (dart:core/print (pr-str (db/datom id from nil db/tx0) (db/datom id to nil db/txmax))) + (dart:core/print (pr-str + (count (.-eavt ^DB db)) + 'x + (count (subseq (.-eavt ^DB db) + >= (db/datom id from nil db/tx0) + <= (db/datom id to nil db/txmax))) + (let [akas (for [{:flds [e a] :as d} (.-eavt ^DB db) + :when (and (= e id) (= a from))] + d)] + [(count akas) + (first akas) (second akas) (db/datom id from nil db/tx0) + (db/cmp-datoms-eavt (first akas) (db/datom id from nil db/tx0)) + (db/cmp-datoms-eavt (first akas) (second akas)) + (db/cmp-datoms-eavt (db/datom id from nil db/tx0) (first akas)) + (db/cmp-datoms-eavt (last akas) (db/datom id from nil db/txmax)) + (db/cmp-datoms-eavt (db/datom id from nil db/txmax) (last akas)) + (count (subseq (.-eavt ^DB db) + >= (first akas) + <= (last akas)))]) + #_(count (for [{:flds [e a] :as d} (.-eavt ^DB db) + :when (and (= e id) (= a from))] + d)) + #_(count (->> (.-eavt ^DB db) + (drop-while #(neg? (db/cmp-datoms-eavt % (db/datom id from nil db/tx0)))) + (take-while #(neg? (db/cmp-datoms-eavt (db/datom id to nil db/txmax) %))))) + (count (#?(:cljd db/set-slice :default set/slice) + (.-eavt ^DB db) (db/datom id from nil db/tx0) (db/datom id to nil db/txmax)))))) + #?(:cljd (db/set-slice (.-eavt ^DB db) (db/datom id from db/MIN db/tx0) (db/datom id to db/MAX db/txmax)) + :default (set/slice (.-eavt ^DB db) (db/datom id from nil db/tx0) (db/datom id to nil db/txmax)))) + + :else + (->> (db/-seek-datoms db :eavt id nil nil nil)) + (take-while + (fn [^Datom d] + (and + (= (.-e d) id) + (<= (compare (.-a d) to) 0)))))] (when (.-wildcard? pattern) (visit context :db.pull/wildcard id nil nil)) - (AttrsFrame. - seen - recursion-limits - (transient {}) - pattern - (first-seq (.-attrs pattern)) - (next-seq (.-attrs pattern)) - datoms - id))) - -(defn pull-impl [parsed-opts id] - (let [{^Context context :context - ^PullPattern pattern :pattern} parsed-opts] - (when-some [eid (db/entid (.-db context) id)] - (loop [stack (list (attrs-frame context #{} {} pattern eid))] - (util/cond+ - :let [last (first-seq stack) - stack' (next-seq stack)] - - (not (instance? ResultFrame last)) - (recur (reduce conj-seq stack' (-run last context))) - - (nil? stack') - (.-value ^ResultFrame last) - - :let [penultimate (first-seq stack') - stack'' (next-seq stack')] - - :else - (recur (conj-seq stack'' (-merge penultimate last)))))))) + (#?(:cljd ->AttrsFrame :default AttrsFrame.) + seen + recursion-limits + (transient {}) + pattern + (first-seq (.-attrs pattern)) + (next-seq (.-attrs pattern)) + datoms + id))) + +#?(:cljd + (defn pull-impl [parsed-opts id] + (let [{^Context context :context + ^PullPattern pattern :pattern} parsed-opts] + (when-some [eid (db/entid (.-db context) id)] + (let [stack (.empty #/(List dynamic) .growable true)] + (.add stack (attrs-frame context #{} {} pattern eid)) + (loop [] + (let [top (.removeLast stack)] + (if (instance? ResultFrame top) + (if (.isEmpty stack) + (.-value ^ResultFrame top) + (do + (.add stack (-merge (.removeLast stack) top)) + (recur))) + (let [result (-run top context)] + (.add stack (. result "[]" 0)) + (when (> (.-length result) 1) + (.add stack (. result "[]" 1))) + (recur))))))))) + :default + (defn pull-impl [parsed-opts id] + (let [{^Context context :context + ^PullPattern pattern :pattern} parsed-opts] + (when-some [eid (db/entid (.-db context) id)] + (loop [stack (list (attrs-frame context #{} {} pattern eid))] + (util/cond+ + :let [last (first-seq stack) + stack' (next-seq stack)] + + (not (instance? ResultFrame last)) + (recur (reduce conj-seq stack' (-run last context))) + + (nil? stack') + (.-value ^ResultFrame last) + + :let [penultimate (first-seq stack') + stack'' (next-seq stack')] + + :else + (recur (conj-seq stack'' (-merge penultimate last))))))))) (defn parse-opts ([db pattern] (parse-opts db pattern nil)) ([db pattern {:keys [visitor]}] {:pattern (lru/-get (.-pull-patterns (db/unfiltered-db db)) pattern #(dpp/parse-pattern db pattern)) - :context (Context. db visitor)})) + :context (#?(:cljd ->Context :default Context.) + db visitor)})) (defn pull "Supported opts: @@ -354,3 +447,26 @@ {:pre [(db/db? db)]} (let [parsed-opts (parse-opts db pattern opts)] (mapv #(pull-impl parsed-opts %) ids)))) + +(comment + (do + (set! *warn-on-reflection* true) + (require 'datascript.test :reload-all) + (binding [clojure.test/*report-counters* (ref clojure.test/*initial-report-counters*)] + (clojure.test/test-vars + [#'datascript.test.pull-parser/test-parse-pattern + #'datascript.test.pull-api/test-pull-attr-spec + #'datascript.test.pull-api/test-pull-reverse-attr-spec + #'datascript.test.pull-api/test-pull-component-attr + #'datascript.test.pull-api/test-pull-wildcard + #'datascript.test.pull-api/test-pull-limit + #'datascript.test.pull-api/test-pull-default + #'datascript.test.pull-api/test-pull-as + #'datascript.test.pull-api/test-pull-attr-with-opts + #'datascript.test.pull-api/test-pull-map + #'datascript.test.pull-api/test-pull-recursion + #'datascript.test.pull-api/test-dual-recursion + #'datascript.test.pull-api/test-deep-recursion + #'datascript.test.pull-api/test-lookup-ref-pull + ]) + @clojure.test/*report-counters*))) diff --git a/src/datascript/pull_parser.cljc b/src/datascript/pull_parser.cljc index abb05c56..d3a133da 100644 --- a/src/datascript/pull_parser.cljc +++ b/src/datascript/pull_parser.cljc @@ -4,7 +4,7 @@ [datascript.db :as db] [datascript.util :as util])) -(defrecord PullAttr [as default limit name pattern recursion-limit recursive? reverse? xform multival? ref? component?]) +(defrecord PullAttr [as default-val limit name pattern recursion-limit recursive? reverse? xform multival? ref? component?]) (defrecord PullPattern [attrs first-attr last-attr reverse-attrs wildcard?]) @@ -67,7 +67,8 @@ (when (fn? sym-or-fn) sym-or-fn) (get built-ins/query-fns sym-or-fn) - #?(:clj (when (namespace sym-or-fn) + #?(:cljd nil + :clj (when (namespace sym-or-fn) (when-some [v (requiring-resolve sym-or-fn)] @v))) (util/raise "Can't resolve symbol " sym-or-fn {:error :parser/pull, :fragment sym-or-fn}))) @@ -82,7 +83,7 @@ :limit (do (check-limit db pull-attr value) (assoc pull-attr :limit value)) - :default (assoc pull-attr :default value) + :default (assoc pull-attr :default-val value) :xform (assoc pull-attr :xform (resolve-xform value)) #_else (check false "one of :as, :limit, :default, :xform" attr-spec))) pull-attr @@ -103,7 +104,7 @@ (check (= (count attr-spec) 3) expected attr-spec) (let [[_ attr default] attr-spec pull-attr (parse-attr-spec db attr)] - (assoc pull-attr :default default))))) + (assoc pull-attr :default-val default))))) (defn parse-attr-spec [db attr-spec] (cond @@ -188,11 +189,11 @@ result attr-spec)] (recur (next pattern) result')) - + :let [pull-attr (parse-attr-spec db attr-spec)] (nil? pull-attr) (check false "attr-name | attr-expr | map-spec | *" attr-spec) - + :else (recur (next pattern) (conj-attr result pull-attr))))) diff --git a/src/datascript/query.cljc b/src/datascript/query.cljc index eb434f45..a23a42fb 100644 --- a/src/datascript/query.cljc +++ b/src/datascript/query.cljc @@ -1,20 +1,25 @@ (ns ^:no-doc datascript.query + (:refer-clojure :exclude [make-array]) (:require - [#?(:cljs cljs.reader :clj clojure.edn) :as edn] + [#?(:cljd cljd.reader :cljs cljs.reader :clj clojure.edn) :as edn] [clojure.set :as set] [clojure.string :as str] [clojure.walk :as walk] [datascript.built-ins :as built-ins] [datascript.db :as db] - [me.tonsky.persistent-sorted-set.arrays :as da] + #?(:cljd nil :default [me.tonsky.persistent-sorted-set.arrays :as da]) [datascript.lru :as lru] [datascript.impl.entity :as de] [datascript.parser :as dp #?@(:cljs [:refer [BindColl BindIgnore BindScalar BindTuple Constant + FindColl FindRel FindScalar FindTuple PlainSymbol + RulesVar SrcVar Variable]] + :cljd [:refer [BindColl BindIgnore BindScalar BindTuple Constant FindColl FindRel FindScalar FindTuple PlainSymbol RulesVar SrcVar Variable]])] [datascript.pull-api :as dpa] - [datascript.util :as util]) - #?(:clj + [datascript.util :as util :refer [raise cond+]]) + #?(:cljd nil + :clj (:import [clojure.lang ILookup LazilyPersistentVector] [datascript.parser BindColl BindIgnore BindScalar BindTuple @@ -25,10 +30,13 @@ ;; ---------------------------------------------------------------------------- -(def ^:dynamic *query-cache* - (lru/cache 100)) +(def #?(:cljd ^List make-array :default make-array) + #?(:cljd (fn [n] (.filled #/(List dynamic) n nil)) + :default da/make-array)) + +(def ^:dynamic *query-cache* (lru/cache 100)) -(declare -collect collect -resolve-clause resolve-clause) +(declare -collect -resolve-clause resolve-clause) ;; Records @@ -37,77 +45,91 @@ ;; attrs: ;; {?e 0, ?v 1} or {?e2 "a", ?age "v"} ;; tuples: -;; [#js [1 "Ivan" 5 14] ...] -;; or [(Datom. 2 "Oleg" 1 55) ...] +;; [ #js [1 "Ivan" 5 14] ... ] +;; or [ (Datom. 2 "Oleg" 1 55) ... ] (defrecord Relation [attrs tuples]) -#?(:clj - (defmethod print-method Relation [r, ^java.io.Writer w] - (.write w "#Relation{:attrs ") - (.write w (pr-str (:attrs r))) - (.write w ", :tuples [") - (.write w (str/join " " (map seq (:tuples r)))) - (.write w "]}"))) - ;; Utilities +(defn single [coll] + (assert (nil? (next coll)) "Expected single element") + (first coll)) + (defn intersect-keys [attrs1 attrs2] (set/intersection (set (keys attrs1)) - (set (keys attrs2)))) + (set (keys attrs2)))) + +(defn concatv [& xs] + (into [] cat xs)) + +(defn zip + ([a b] (mapv vector a b)) + ([a b & rest] (apply mapv vector a b rest))) (defn same-keys? [a b] (and (= (count a) (count b)) - (every? #(contains? b %) (keys a)) - (every? #(contains? a %) (keys b)))) + (every? #(contains? b %) (keys a)) + (every? #(contains? b %) (keys a)))) (defn- looks-like? [pattern form] (cond (= '_ pattern) - true + true (= '[*] pattern) - (sequential? form) + (sequential? form) (symbol? pattern) - (= form pattern) + (= form pattern) (sequential? pattern) - (if (= (last pattern) '*) - (and (sequential? form) - (every? (fn [[pattern-el form-el]] (looks-like? pattern-el form-el)) - (map vector (butlast pattern) form))) - (and (sequential? form) - (= (count form) (count pattern)) - (every? (fn [[pattern-el form-el]] (looks-like? pattern-el form-el)) - (map vector pattern form)))) + (if (= (last pattern) '*) + (and (sequential? form) + (every? (fn [[pattern-el form-el]] (looks-like? pattern-el form-el)) + (map vector (butlast pattern) form))) + (and (sequential? form) + (= (count form) (count pattern)) + (every? (fn [[pattern-el form-el]] (looks-like? pattern-el form-el)) + (map vector pattern form)))) :else ;; (predicate? pattern) - (pattern form))) + (pattern form))) (defn source? [sym] (and (symbol? sym) - (= \$ (first (name sym))))) + (= \$ (first (name sym))))) (defn free-var? [sym] (and (symbol? sym) - (= \? (first (name sym))))) + (= \? (first (name sym))))) (defn attr? [form] (or (keyword? form) (string? form))) (defn lookup-ref? [form] - (and - (or (sequential? form) (da/array? form)) - (= 2 (count form)) - (attr? (first form)))) + (looks-like? [attr? '_] form)) ;; Relation algebra -#?(:clj (set! *unchecked-math* true)) - -#?(:clj +#?(:cljd nil + :clj (set! *unchecked-math* true)) + +#?(:cljd + (defn join-tuples [t1 ^List idxs1 + t2 ^List idxs2] + (let [l1 (int (alength idxs1)) + l2 (int (alength idxs2)) + res (make-array (+ l1 l2))] + (if (instance? List t1) + (dotimes [i l1] (aset res i (aget ^List t1 (aget idxs1 i)))) + (dotimes [i l1] (aset res i (get t1 (aget idxs1 i))))) + (if (instance? List t2) + (dotimes [i l2] (aset res (+ l1 i) (aget ^List t2 (aget idxs2 i)))) + (dotimes [i l2] (aset res (+ l1 i) (get t2 (aget idxs2 i))))) + res)) + :clj (defn join-tuples [t1 ^{:tag "[[Ljava.lang.Object;"} idxs1 t2 ^{:tag "[[Ljava.lang.Object;"} idxs2] (let [l1 (alength idxs1) l2 (alength idxs2) - res (da/make-array (+ l1 l2))] + res (make-array (+ l1 l2))] (if (.isArray (.getClass ^Object t1)) (dotimes [i l1] (aset res i (aget ^objects t1 (aget idxs1 i)))) (dotimes [i l1] (aset res i (get t1 (aget idxs1 i))))) @@ -120,69 +142,63 @@ t2 idxs2] (let [l1 (alength idxs1) l2 (alength idxs2) - res (da/make-array (+ l1 l2))] + res (make-array (+ l1 l2))] (dotimes [i l1] (aset res i (da/aget t1 (aget idxs1 i)))) (dotimes [i l2] (aset res (+ l1 i) (da/aget t2 (aget idxs2 i)))) res))) -#?(:clj (set! *unchecked-math* false)) - -(defn- sum-rel* [attrs-a tuples-a attrs-b tuples-b] - (let [idxb->idxa (vec (for [[sym idx-b] attrs-b] - [idx-b (attrs-a sym)])) - tlen (->> (vals attrs-a) (reduce max) (inc)) - tuples' (persistent! - (reduce - (fn [acc tuple-b] - (let [tuple' (da/make-array tlen)] - (doseq [[idx-b idx-a] idxb->idxa] - (aset tuple' idx-a (#?(:cljs da/aget :clj get) tuple-b idx-b))) - (conj! acc tuple'))) - (transient (vec tuples-a)) - tuples-b))] - (Relation. attrs-a tuples'))) +#?(:cljd nil + :clj (set! *unchecked-math* false)) (defn sum-rel [a b] (let [{attrs-a :attrs, tuples-a :tuples} a {attrs-b :attrs, tuples-b :tuples} b] (cond (= attrs-a attrs-b) - (Relation. attrs-a (into (vec tuples-a) tuples-b)) - - ;; BEFORE checking same-keys - ;; because one rel could have had its resolution shortcircuited - (empty? tuples-a) b - (empty? tuples-b) a + (->Relation attrs-a (into (vec tuples-a) tuples-b)) (not (same-keys? attrs-a attrs-b)) - (util/raise "Can’t sum relations with different attrs: " attrs-a " and " attrs-b - {:error :query/where}) + (raise "Can’t sum relations with different attrs: " attrs-a " and " attrs-b + {:error :query/where}) (every? number? (vals attrs-a)) ;; can’t conj into BTSetIter - (sum-rel* attrs-a tuples-a attrs-b tuples-b) + (let [idxb->idxa (vec (for [[sym idx-b] attrs-b] + [idx-b (attrs-a sym)])) + tlen (->> (vals attrs-a) (reduce max) (inc)) + tuples' (persistent! + (reduce + (fn [acc tuple-b] + (let [tuple' (make-array tlen)] + (doseq [[idx-b idx-a] idxb->idxa] + (aset tuple' idx-a (#?(:cljs da/aget :default get) tuple-b idx-b))) + (conj! acc tuple'))) + (transient (vec tuples-a)) + tuples-b))] + (->Relation attrs-a tuples')) :else - (let [number-attrs (zipmap (keys attrs-a) (range))] - (-> (sum-rel* number-attrs [] attrs-a tuples-a) - (sum-rel b)))))) + (let [all-attrs (zipmap (keys (merge attrs-a attrs-b)) (range))] + (-> (->Relation all-attrs []) + (sum-rel a) + (sum-rel b)))))) (defn prod-rel - ([] - (Relation. {} [(da/make-array 0)])) + ([] (->Relation {} [(make-array 0)])) ([rel1 rel2] - (let [attrs1 (keys (:attrs rel1)) - attrs2 (keys (:attrs rel2)) - idxs1 (to-array (map (:attrs rel1) attrs1)) - idxs2 (to-array (map (:attrs rel2) attrs2))] - (Relation. - (zipmap (concat attrs1 attrs2) (range)) - (persistent! - (reduce - (fn [acc t1] - (reduce (fn [acc t2] - (conj! acc (join-tuples t1 idxs1 t2 idxs2))) - acc (:tuples rel2))) - (transient []) (:tuples rel1))))))) + (let [attrs1 (keys (:attrs rel1)) + attrs2 (keys (:attrs rel2)) + idxs1 (to-array (map (:attrs rel1) attrs1)) + idxs2 (to-array (map (:attrs rel2) attrs2))] + (->Relation + (zipmap (concat attrs1 attrs2) (range)) + (persistent! + (reduce + (fn [acc t1] + (reduce (fn [acc t2] + (conj! acc (join-tuples t1 idxs1 t2 idxs2))) + acc (:tuples rel2))) + (transient []) (:tuples rel1))) + )))) ;; @@ -194,67 +210,67 @@ (defn empty-rel [binding] (let [vars (->> (dp/collect-vars-distinct binding) (map :symbol))] - (Relation. (zipmap vars (range)) []))) + (->Relation (zipmap vars (range)) []))) (defprotocol IBinding (in->rel [binding value])) (extend-protocol IBinding BindIgnore - (in->rel [_ _] + (in->rel [_ _cljd_bug] (prod-rel)) - + BindScalar (in->rel [binding value] - (Relation. {(get-in binding [:variable :symbol]) 0} [(into-array [value])])) - + (->Relation {(get-in binding [:variable :symbol]) 0} [(into-array [value])])) + BindColl (in->rel [binding coll] (cond (not (db/seqable? coll)) - (util/raise "Cannot bind value " coll " to collection " (dp/source binding) - {:error :query/binding, :value coll, :binding (dp/source binding)}) + (raise "Cannot bind value " coll " to collection " (dp/source binding) + {:error :query/binding, :value coll, :binding (dp/source binding)}) (empty? coll) - (empty-rel binding) + (empty-rel binding) :else - (->> coll - (map #(in->rel (:binding binding) %)) - (reduce sum-rel)))) - + (->> coll + (map #(in->rel (:binding binding) %)) + (reduce sum-rel)))) + BindTuple (in->rel [binding coll] (cond (not (db/seqable? coll)) - (util/raise "Cannot bind value " coll " to tuple " (dp/source binding) - {:error :query/binding, :value coll, :binding (dp/source binding)}) + (raise "Cannot bind value " coll " to tuple " (dp/source binding) + {:error :query/binding, :value coll, :binding (dp/source binding)}) (< (count coll) (count (:bindings binding))) - (util/raise "Not enough elements in a collection " coll " to bind tuple " (dp/source binding) - {:error :query/binding, :value coll, :binding (dp/source binding)}) + (raise "Not enough elements in a collection " coll " to bind tuple " (dp/source binding) + {:error :query/binding, :value coll, :binding (dp/source binding)}) :else - (reduce prod-rel - (map #(in->rel %1 %2) (:bindings binding) coll))))) + (reduce prod-rel + (map #(in->rel %1 %2) (:bindings binding) coll))))) (defn resolve-in [context [binding value]] (cond (and (instance? BindScalar binding) - (instance? SrcVar (:variable binding))) - (update context :sources assoc (get-in binding [:variable :symbol]) value) + (instance? SrcVar (:variable binding))) + (update context :sources assoc (get-in binding [:variable :symbol]) value) (and (instance? BindScalar binding) - (instance? RulesVar (:variable binding))) - (assoc context :rules (parse-rules value)) + (instance? RulesVar (:variable binding))) + (assoc context :rules (parse-rules value)) :else - (update context :rels conj (in->rel binding value)))) + (update context :rels conj (in->rel binding value)))) (defn resolve-ins [context bindings values] (let [cb (count bindings) cv (count values)] (cond (< cb cv) - (util/raise "Extra inputs passed, expected: " (mapv #(:source (meta %)) bindings) ", got: " cv + (raise "Extra inputs passed, expected: " (mapv #(:source (meta %)) bindings) ", got: " cv {:error :query/inputs :expected bindings :got values}) (> cb cv) - (util/raise "Too few inputs passed, expected: " (mapv #(:source (meta %)) bindings) ", got: " cv + (raise "Too few inputs passed, expected: " (mapv #(:source (meta %)) bindings) ", got: " cv {:error :query/inputs :expected bindings :got values}) :else @@ -277,50 +293,71 @@ (let [idx (int idx)] (fn contained-int-getter-fn [tuple] (let [eid #?(:cljs (da/aget tuple idx) + :cljd (if (instance? List tuple) + (aget ^objects tuple idx) + (nth tuple idx)) :clj (if (.isArray (.getClass ^Object tuple)) (aget ^objects tuple idx) (nth tuple idx)))] (cond (number? eid) eid ;; quick path to avoid fn call (sequential? eid) (db/entid *implicit-source* eid) - (da/array? eid) (db/entid *implicit-source* eid) + #?(:cljd (dart/is? eid List) + :default (da/array? eid)) (db/entid *implicit-source* eid) :else eid)))) ;; If the index is not an int?, the target can never be an array (fn contained-getter-fn [tuple] (let [eid #?(:cljs (da/aget tuple idx) + :cljd (get tuple idx) :clj (.valAt ^ILookup tuple idx))] (cond (number? eid) eid ;; quick path to avoid fn call (sequential? eid) (db/entid *implicit-source* eid) - (da/array? eid) (db/entid *implicit-source* eid) + #?(:cljd (dart/is? eid List) + :default (da/array? eid)) (db/entid *implicit-source* eid) :else eid)))) (if (int? idx) (let [idx (int idx)] (fn int-getter [tuple] #?(:cljs (da/aget tuple idx) + :cljd (if (instance? List tuple) + (aget ^objects tuple idx) + (nth tuple idx)) :clj (if (.isArray (.getClass ^Object tuple)) (aget ^objects tuple idx) (nth tuple idx))))) ;; If the index is not an int?, the target can never be an array (fn getter [tuple] - #?(:cljs (da/aget tuple idx) + #?(:cljd (get tuple idx) + :cljs (da/aget tuple idx) :clj (.valAt ^ILookup tuple idx))))))) + (defn tuple-key-fn [attrs common-attrs] (let [n (count common-attrs)] (if (== n 1) (getter-fn attrs (first common-attrs)) - (let [^objects getters-arr #?(:clj (into-array Object common-attrs) - :cljs (into-array common-attrs))] + (let [^#?(:cljd List :default objects) getters-arr #?(:cljd (into-array common-attrs) + :clj (into-array Object common-attrs) + :cljs (into-array common-attrs))] (loop [i 0] (if (< i n) (do (aset getters-arr i (getter-fn attrs (aget getters-arr i))) - (recur (unchecked-inc i))) - #?(:clj + (recur (#?(:cljd inc :default unchecked-inc) i))) + #?(:cljd + (fn [tuple] + (let [^List arr (make-array n)] + (loop [i 0] + (if (< i n) + (do + (aset arr i ((aget getters-arr i) tuple)) + (recur (inc i))) + (-vec-owning arr))))) + :clj (fn [tuple] - (let [^objects arr (make-array Object n)] + (let [^objects arr (clojure.core/make-array Object n)] (loop [i 0] (if (< i n) (do @@ -333,15 +370,19 @@ (defn -group-by [f init coll] (persistent! - (reduce - (fn [ret x] - (let [k (f x)] - (assoc! ret k (conj (get ret k init) x)))) - (transient {}) coll))) + (reduce + (fn [ret x] + (let [k (f x)] + (assoc! ret k (conj (get ret k init) x)))) + (transient {}) coll))) (defn hash-attrs [key-fn tuples] (-group-by key-fn '() tuples)) +#?(:cljd + (defn ->Eduction [xform coll] + (into [] xform coll))) + (defn hash-join [rel1 rel2] (let [tuples1 (:tuples rel1) tuples2 (:tuples rel2) @@ -350,30 +391,30 @@ common-attrs (vec (intersect-keys (:attrs rel1) (:attrs rel2))) keep-attrs1 (keys attrs1) keep-attrs2 (->> attrs2 - (reduce-kv (fn keeper [vec k _] - (if (attrs1 k) - vec - (conj! vec k))) - (transient [])) - persistent!) ; keys in attrs2-attrs1 + (reduce-kv (fn keeper [vec k _] + (if (attrs1 k) + vec + (conj! vec k))) + (transient [])) + persistent!) ; keys in attrs2-attrs1 keep-idxs1 (to-array (vals attrs1)) keep-idxs2 (to-array (->Eduction (map attrs2) keep-attrs2)) ; vals in attrs2-attrs1 by keys key-fn1 (tuple-key-fn attrs1 common-attrs) key-fn2 (tuple-key-fn attrs2 common-attrs) hash (hash-attrs key-fn1 tuples1) new-tuples (->> - tuples2 - (reduce (fn outer [acc tuple2] - (let [key (key-fn2 tuple2)] - (if-some [tuples1 #?(:clj (hash key) :cljs (get hash key))] - (reduce (fn inner [acc tuple1] - (conj! acc (join-tuples tuple1 keep-idxs1 tuple2 keep-idxs2))) - acc tuples1) - acc))) - (transient [])) - (persistent!))] - (Relation. (zipmap (concat keep-attrs1 keep-attrs2) (range)) - new-tuples))) + tuples2 + (reduce (fn outer [acc tuple2] + (let [key (key-fn2 tuple2)] + (if-some [tuples1 #?(:clj (hash key) :cljs (get hash key) :cljd (hash key))] + (reduce (fn inner [acc tuple1] + (conj! acc (join-tuples tuple1 keep-idxs1 tuple2 keep-idxs2))) + acc tuples1) + acc))) + (transient []) ) + (persistent!))] + (->Relation (zipmap (concat keep-attrs1 keep-attrs2) (range)) + new-tuples))) (defn subtract-rel [a b] (let [{attrs-a :attrs, tuples-a :tuples} a @@ -385,46 +426,14 @@ (assoc a :tuples (filterv #(nil? (hash (key-fn-a %))) tuples-a)))) -(defn- rel-with-attr [context sym] - (some #(when (contains? (:attrs %) sym) %) (:rels context))) - -(defn substitute-constant [context pattern-el] - (when (free-var? pattern-el) - (when-some [rel (rel-with-attr context pattern-el)] - (when-some [tuple (first (:tuples rel))] - (when (nil? (fnext (:tuples rel))) - (let [idx (get (:attrs rel) pattern-el)] - (#?(:cljs da/aget :clj get) tuple idx))))))) - -(defn substitute-constants [context pattern] - (mapv #(or (substitute-constant context %) %) pattern)) - -(defn resolve-pattern-lookup-refs [source pattern] - (if (satisfies? db/IDB source) - (let [[e a v tx] pattern - e' (if (or (lookup-ref? e) (attr? e)) - (db/entid-strict source e) - e) - v' (if (and v (attr? a) (db/ref? source a) (or (lookup-ref? v) (attr? v))) - (db/entid-strict source v) - v) - tx' (if (lookup-ref? tx) - (db/entid-strict source tx) - tx)] - (subvec [e' a v' tx'] 0 (count pattern))) - pattern)) - -(defn lookup-pattern-db [context db pattern] +(defn lookup-pattern-db [db pattern] ;; TODO optimize with bound attrs min/max values here - (let [search-pattern (->> pattern - (substitute-constants context) - (resolve-pattern-lookup-refs db) - (mapv #(if (or (= % '_) (free-var? %)) nil %))) + (let [search-pattern (mapv #(if (or (= % '_) (free-var? %)) nil %) pattern) datoms (db/-search db search-pattern) attr->prop (->> (map vector pattern ["e" "a" "v" "tx"]) - (filter (fn [[s _]] (free-var? s))) - (into {}))] - (Relation. attr->prop datoms))) + (filter (fn [[s _]] (free-var? s))) + (into {}))] + (->Relation attr->prop datoms))) (defn matches-pattern? [pattern tuple] (loop [tuple tuple @@ -437,22 +446,24 @@ false)) true))) -(defn lookup-pattern-coll [context coll pattern] +(defn lookup-pattern-coll [coll pattern] (let [data (filter #(matches-pattern? pattern %) coll) attr->idx (->> (map vector pattern (range)) - (filter (fn [[s _]] (free-var? s))) - (into {}))] - (Relation. attr->idx (mapv to-array data)))) ;; FIXME to-array + (filter (fn [[s _]] (free-var? s))) + (into {}))] + (->Relation attr->idx (mapv to-array data)))) ;; FIXME to-array (defn normalize-pattern-clause [clause] (if (source? (first clause)) clause (concat ['$] clause))) -(defn lookup-pattern [context source pattern] - (if (satisfies? db/ISearch source) - (lookup-pattern-db context source pattern) - (lookup-pattern-coll context source pattern))) +(defn lookup-pattern [source pattern] + (cond + (satisfies? db/ISearch source) + (lookup-pattern-db source pattern) + :else + (lookup-pattern-coll source pattern))) (defn collapse-rels [rels new-rel] (loop [rels rels @@ -464,10 +475,13 @@ (recur (next rels) new-rel (conj acc rel))) (conj acc new-rel)))) +(defn- rel-with-attr [context sym] + (some #(when (contains? (:attrs %) sym) %) (:rels context))) + (defn- context-resolve-val [context sym] (when-some [rel (rel-with-attr context sym)] (when-some [tuple (first (:tuples rel))] - (#?(:cljs da/aget :clj get) tuple ((:attrs rel) sym))))) + (#?(:cljs da/aget :clj get :cljd get) tuple ((:attrs rel) sym))))) (defn- rel-contains-attrs? [rel attrs] (some #(contains? (:attrs rel) %) attrs)) @@ -481,48 +495,50 @@ (let [sources (:sources context) attrs (:attrs rel) len (count args) - static-args (da/make-array len) - tuples-args (da/make-array len)] + static-args (make-array len) + tuples-args (make-array len)] (dotimes [i len] (let [arg (nth args i)] - (if (symbol? arg) + (if (symbol? arg) (if-some [source (get sources arg)] - (da/aset static-args i source) - (da/aset tuples-args i (get attrs arg))) - (da/aset static-args i arg)))) + (#?(:cljd aset :default da/aset) static-args i source) + (#?(:cljd aset :default da/aset) tuples-args i (get attrs arg))) + (#?(:cljd aset :default da/aset) static-args i arg)))) ;; CLJS `apply` + `vector` will hold onto mutable array of arguments directly - ;; issue-262 + ;; https://github.com/tonsky/datascript/issues/262 (if #?(:clj false + :cljd false :cljs (identical? f vector)) (fn [tuple] ;; TODO raise if not all args are bound (let [args (da/aclone static-args)] (dotimes [i len] (when-some [tuple-idx (aget tuples-args i)] - (let [v (#?(:cljs da/aget :clj get) tuple tuple-idx)] - (da/aset args i v)))) + (let [v (#?(:cljd get :cljs da/aget :clj get) tuple tuple-idx)] + (#?(:cljd aset :default da/aset) args i v)))) (apply f args))) (fn [tuple] ;; TODO raise if not all args are bound (dotimes [i len] (when-some [tuple-idx (aget tuples-args i)] - (let [v (#?(:cljs da/aget :clj get) tuple tuple-idx)] - (da/aset static-args i v)))) + (let [v (#?(:cljd get :cljs da/aget :clj get) tuple tuple-idx)] + (#?(:cljd aset :default da/aset) static-args i v)))) (apply f static-args))))) (defn- resolve-sym [sym] #?(:cljs nil + :cljd nil :clj (when (namespace sym) (when-some [v (resolve sym)] @v)))) (defn filter-by-pred [context clause] (let [[[f & args]] clause pred (or (get built-ins/query-fns f) - (context-resolve-val context f) - (resolve-sym f) - (when (nil? (rel-with-attr context f)) - (util/raise "Unknown predicate '" f " in " clause - {:error :query/where, :form clause, :var f}))) + (context-resolve-val context f) + (resolve-sym f) + (when (nil? (rel-with-attr context f)) + (raise "Unknown predicate '" f " in " clause + {:error :query/where, :form clause, :var f}))) [context production] (rel-prod-by-attrs context (filter symbol? args)) new-rel (if pred (let [tuple-pred (-call-fn context production pred args)] @@ -534,41 +550,35 @@ (let [[[f & args] out] clause binding (dp/parse-binding out) fun (or (get built-ins/query-fns f) - (context-resolve-val context f) - (resolve-sym f) - (when (nil? (rel-with-attr context f)) - (util/raise "Unknown function '" f " in " clause - {:error :query/where, :form clause, :var f}))) + (context-resolve-val context f) + (resolve-sym f) + (when (nil? (rel-with-attr context f)) + (raise "Unknown function '" f " in " clause + {:error :query/where, :form clause, :var f}))) [context production] (rel-prod-by-attrs context (filter symbol? args)) new-rel (if fun (let [tuple-fn (-call-fn context production fun args) - rels (for [tuple (:tuples production) - :let [val (tuple-fn tuple)] - :when (not (nil? val))] - (reduce prod-rel - (collapse-rels - [(Relation. (:attrs production) [tuple])] - (in->rel binding val))))] + rels (for [tuple (:tuples production) + :let [val (tuple-fn tuple)] + :when (not (nil? val))] + (prod-rel (->Relation (:attrs production) [tuple]) + (in->rel binding val)))] (if (empty? rels) - (prod-rel - production - (empty-rel binding)) + (prod-rel production (empty-rel binding)) (reduce sum-rel rels))) - (prod-rel - (assoc production :tuples []) - (empty-rel binding)))] + (prod-rel (assoc production :tuples []) (empty-rel binding)))] (update context :rels collapse-rels new-rel))) ;;; RULES (defn rule? [context clause] - (util/cond+ + (cond+ (not (sequential? clause)) false :let [head (if (source? (first clause)) - (second clause) - (first clause))] + (second clause) + (first clause))] (not (symbol? head)) false @@ -580,7 +590,7 @@ false (not (contains? (:rules context) head)) - (util/raise "Unknown rule '" head " in " clause + (raise "Unknown rule '" head " in " clause {:error :query/where :form clause}) @@ -596,16 +606,16 @@ :let [[[_ & rule-args] & clauses] branch replacements (zipmap rule-args call-args)]] (walk/postwalk - #(if (free-var? %) - (util/some-of - (replacements %) - (symbol (str (name %) "__auto__" seqid))) - %) + #(if (free-var? %) + (db/some-of + (replacements %) + (symbol (str (name %) "__auto__" seqid))) + %) clauses)))) (defn remove-pairs [xs ys] (let [pairs (->> (map vector xs ys) - (remove (fn [[x y]] (= x y))))] + (remove (fn [[x y]] (= x y))))] [(map first pairs) (map second pairs)])) @@ -633,7 +643,7 @@ (defn solve-rule [context clause] (let [final-attrs (filter free-var? clause) final-attrs-map (zipmap final-attrs (range)) - ;; clause-cache (atom {}) ;; TODO +;; clause-cache (atom {}) ;; TODO solve (fn [prefix-context clauses] (reduce -resolve-clause prefix-context clauses)) empty-rels? (fn [context] @@ -643,22 +653,22 @@ :clauses [clause] :used-args {} :pending-guards {}}) - rel (Relation. final-attrs-map [])] + rel (->Relation final-attrs-map [])] (if-some [frame (first stack)] (let [[clauses [rule-clause & next-clauses]] (split-with #(not (rule? context %)) (:clauses frame))] (if (nil? rule-clause) ;; no rules -> expand, collect, sum (let [context (solve (:prefix-context frame) clauses) - tuples (util/distinct-by vec (-collect context final-attrs)) - new-rel (Relation. final-attrs-map tuples)] + tuples (-collect context final-attrs) + new-rel (->Relation final-attrs-map tuples)] (recur (next stack) (sum-rel rel new-rel))) ;; has rule -> add guards -> check if dead -> expand rule -> push to stack, recur (let [[rule & call-args] rule-clause guards (rule-gen-guards rule-clause (:used-args frame)) [active-gs pending-gs] (split-guards (concat (:prefix-clauses frame) clauses) - (concat guards (:pending-guards frame)))] + (concat guards (:pending-guards frame)))] (if (some #(= % '[(-differ?)]) active-gs) ;; trivial always false case like [(not= [?a ?b] [?a ?b])] ;; this branch has no data, just drop it from stack @@ -679,13 +689,24 @@ (for [branch branches] {:prefix-clauses prefix-clauses :prefix-context prefix-context - :clauses (util/concatv branch next-clauses) + :clauses (concatv branch next-clauses) :used-args used-args :pending-guards pending-gs}) (next stack)) - rel)))))))) + rel)))))))) rel)))) +(defn resolve-pattern-lookup-refs [source pattern] + (if (satisfies? db/IDB source) + (let [[e a v tx] pattern] + (-> + [(if (or (lookup-ref? e) (attr? e)) (db/entid-strict source e) e) + a + (if (and v (attr? a) (db/ref? source a) (or (lookup-ref? v) (attr? v))) (db/entid-strict source v) v) + (if (lookup-ref? tx) (db/entid-strict source tx) tx)] + (subvec 0 (count pattern)))) + pattern)) + (defn dynamic-lookup-attrs [source pattern] (let [[e a v tx] pattern] (cond-> #{} @@ -703,7 +724,7 @@ (defn limit-context [context vars] (assoc context :rels (->> (:rels context) - (keep #(limit-rel % vars))))) + (keep #(limit-rel % vars))))) (defn bound-vars [context] (into #{} (mapcat #(keys (:attrs %)) (:rels context)))) @@ -711,63 +732,63 @@ (defn check-bound [bound vars form] (when-not (set/subset? vars bound) (let [missing (set/difference (set vars) bound)] - (util/raise "Insufficient bindings: " missing " not bound in " form - {:error :query/where - :form form - :vars missing})))) + (raise "Insufficient bindings: " missing " not bound in " form + {:error :query/where + :form form + :vars missing})))) (defn check-free-same [bound branches form] (let [free (mapv #(set/difference (collect-vars %) bound) branches)] (when-not (apply = free) - (util/raise "All clauses in 'or' must use same set of free vars, had " free " in " form - {:error :query/where - :form form - :vars free})))) + (raise "All clauses in 'or' must use same set of free vars, had " free " in " form + {:error :query/where + :form form + :vars free})))) (defn check-free-subset [bound vars branches] (let [free (set (remove bound vars))] (doseq [branch branches] (when-some [missing (not-empty (set/difference free (collect-vars branch)))] (prn branch bound vars free) - (util/raise "All clauses in 'or' must use same set of free vars, had " missing " not bound in " branch + (raise "All clauses in 'or' must use same set of free vars, had " missing " not bound in " branch {:error :query/where :form branch :vars missing}))))) (defn -resolve-clause ([context clause] - (-resolve-clause context clause clause)) + (-resolve-clause context clause clause)) ([context clause orig-clause] (condp looks-like? clause [[symbol? '*]] ;; predicate [(pred ?a ?b ?c)] (do (check-bound (bound-vars context) (filter free-var? (nfirst clause)) clause) (filter-by-pred context clause)) - + [[symbol? '*] '_] ;; function [(fn ?a ?b) ?res] (do (check-bound (bound-vars context) (filter free-var? (nfirst clause)) clause) (bind-by-fn context clause)) - + [source? '*] ;; source + anything (let [[source-sym & rest] clause] (binding [*implicit-source* (get (:sources context) source-sym)] (-resolve-clause context rest clause))) - + '[or *] ;; (or ...) (let [[_ & branches] clause _ (check-free-same (bound-vars context) branches clause) contexts (map #(resolve-clause context %) branches) rels (map #(reduce hash-join (:rels %)) contexts)] (assoc (first contexts) :rels [(reduce sum-rel rels)])) - + '[or-join [[*] *] *] ;; (or-join [[req-vars] vars] ...) (let [[_ [req-vars & vars] & branches] clause bound (bound-vars context)] (check-bound bound req-vars orig-clause) (check-free-subset bound vars branches) (recur context (list* 'or-join (concat req-vars vars) branches) clause)) - + '[or-join [*] *] ;; (or-join [vars] ...) (let [[_ vars & branches] clause vars (set vars) @@ -777,26 +798,26 @@ rels (map #(reduce hash-join (:rels %)) contexts) sum-rel (reduce sum-rel rels)] (update context :rels collapse-rels sum-rel)) - + '[and *] ;; (and ...) (let [[_ & clauses] clause] (reduce resolve-clause context clauses)) - + '[not *] ;; (not ...) (let [[_ & clauses] clause bound (bound-vars context) negation-vars (collect-vars clauses) _ (when (empty? (set/intersection bound negation-vars)) - (util/raise "Insufficient bindings: none of " negation-vars " is bound in " orig-clause + (raise "Insufficient bindings: none of " negation-vars " is bound in " orig-clause {:error :query/where :form orig-clause})) context' (assoc context :rels [(reduce hash-join (:rels context))]) negation-context (reduce resolve-clause context' clauses) negation (subtract-rel - (util/single (:rels context')) + (single (:rels context')) (reduce hash-join (:rels negation-context)))] (assoc context' :rels [negation])) - + '[not-join [*] *] ;; (not-join [vars] ...) (let [[_ vars & clauses] clause bound (bound-vars context) @@ -806,88 +827,85 @@ negation-context (-> (reduce resolve-clause join-context clauses) (limit-context vars)) negation (subtract-rel - (util/single (:rels context')) + (single (:rels context')) (reduce hash-join (:rels negation-context)))] (assoc context' :rels [negation])) - + '[*] ;; pattern (let [source *implicit-source* - pattern' (resolve-pattern-lookup-refs source clause) - relation (lookup-pattern context source pattern')] + pattern (resolve-pattern-lookup-refs source clause) + relation (lookup-pattern source pattern)] (binding [*lookup-attrs* (if (satisfies? db/IDB source) - (dynamic-lookup-attrs source pattern') + (dynamic-lookup-attrs source pattern) *lookup-attrs*)] (update context :rels collapse-rels relation)))))) -(defn short-circuit-empty-rel [context] - (if (some #(empty? (:tuples %)) (:rels context)) - (assoc context - :rels - [(Relation. - (zipmap (mapcat #(keys (:attrs %)) (:rels context)) (range)) - [])]) - context)) - (defn resolve-clause [context clause] - (if (->> (:rels context) (some (comp empty? :tuples))) - context ; The result is empty; short-circuit processing - (short-circuit-empty-rel - (if (rule? context clause) - (if (source? (first clause)) - (binding [*implicit-source* (get (:sources context) (first clause))] - (resolve-clause context (next clause))) - (update context :rels collapse-rels (solve-rule context clause))) - (-resolve-clause context clause))))) + (if (rule? context clause) + (if (source? (first clause)) + (binding [*implicit-source* (get (:sources context) (first clause))] + (resolve-clause context (next clause))) + (update context :rels collapse-rels (solve-rule context clause))) + (-resolve-clause context clause))) (defn -q [context clauses] (binding [*implicit-source* (get (:sources context) '$)] (reduce resolve-clause context clauses))) (defn -collect-tuples - [acc rel ^long len copy-map] + [acc rel ^#?(:cljd int :default long) len copy-map] (->Eduction - (comp - (map - (fn [#?(:cljs t1 - :clj ^{:tag "[[Ljava.lang.Object;"} t1)] - (->Eduction - (map - (fn [t2] - (let [res (aclone t1)] - #?(:clj - (if (.isArray (.getClass ^Object t2)) - (dotimes [i len] - (when-some [idx (aget ^objects copy-map i)] - (aset res i (aget ^objects t2 idx)))) - (dotimes [i len] - (when-some [idx (aget ^objects copy-map i)] - (aset res i (get t2 idx))))) - :cljs - (dotimes [i len] - (when-some [idx (aget ^objects copy-map i)] - (aset res i (da/aget ^objects t2 idx))))) - res))) - (:tuples rel)))) - cat) - acc)) + (comp + (map + (fn [#?(:cljs t1 + :cljd t1 + :clj ^{:tag "[[Ljava.lang.Object;"} t1)] + (->Eduction + (map + (fn [t2] + (let [res (aclone t1)] + #?(:cljd + (if (instance? List t2) + (dotimes [i len] + (when-some [idx (aget ^objects copy-map i)] + (aset res i (aget ^objects t2 idx)))) + (dotimes [i len] + (when-some [idx (aget ^objects copy-map i)] + (aset res i (get t2 idx))))) + :clj + (if (.isArray (.getClass ^Object t2)) + (dotimes [i len] + (when-some [idx (aget ^objects copy-map i)] + (aset res i (aget ^objects t2 idx)))) + (dotimes [i len] + (when-some [idx (aget ^objects copy-map i)] + (aset res i (get t2 idx))))) + :cljs + (dotimes [i len] + (when-some [idx (aget ^objects copy-map i)] + (aset res i (da/aget ^objects t2 idx))))) + res))) + (:tuples rel)))) + cat) + acc)) (defn -collect ([context symbols] - (let [rels (:rels context)] - (-collect [(da/make-array (count symbols))] rels symbols))) + (let [rels (:rels context)] + (-collect [(make-array (count symbols))] rels symbols))) ([acc rels symbols] - (util/cond+ + (cond+ :let [rel (first rels)] - + (nil? rel) acc - + ;; one empty rel means final set has to be empty (empty? (:tuples rel)) [] - + :let [keep-attrs (select-keys (:attrs rel) symbols)] - + (empty? keep-attrs) (recur acc (next rels) symbols) - + :let [copy-map (to-array (map #(get keep-attrs %) symbols)) len (count symbols)] @@ -910,7 +928,7 @@ PlainSymbol (-context-resolve [var _] (or (get built-ins/aggregates (.-symbol var)) - (resolve-sym (.-symbol var)))) + (resolve-sym (.-symbol var)))) Constant (-context-resolve [var _] (.-value var))) @@ -929,7 +947,7 @@ (defn- idxs-of [pred coll] (->> (map #(when (pred %1) %2) coll (range)) - (remove nil?))) + (remove nil?))) (defn aggregate [find-elements context resultset] (let [group-idxs (idxs-of (complement dp/aggregate?) find-elements) @@ -1003,17 +1021,17 @@ q (cond-> q (sequential? q) dp/query->map) wheres (:where q) - context (-> (Context. [] {} {}) + context (-> (->Context [] {} {}) (resolve-ins (:qin parsed-q) inputs)) resultset (-> context (-q wheres) (collect all-vars))] (cond->> resultset (:with q) - (mapv #(vec (subvec % 0 result-arity))) + (mapv #(vec (subvec % 0 result-arity))) (some dp/aggregate? find-elements) - (aggregate find-elements context) + (aggregate find-elements context) (some dp/pull? find-elements) - (pull find-elements context) + (pull find-elements context) true - (-post-process find (:qreturn-map parsed-q))))) + (-post-process find (:qreturn-map parsed-q))))) diff --git a/src/datascript/query_v3.cljc b/src/datascript/query_v3.cljc index 145d1e01..04cc2701 100644 --- a/src/datascript/query_v3.cljc +++ b/src/datascript/query_v3.cljc @@ -1,4 +1,5 @@ (ns ^:no-doc datascript.query-v3 + (:refer-clojure :exclude [make-array]) (:require [clojure.set :as set] [datascript.built-ins :as built-ins] @@ -6,13 +7,17 @@ [datascript.db :as db] [datascript.query :as dq] [datascript.lru :as lru] - [me.tonsky.persistent-sorted-set.arrays :as da] + #?(:cljd nil :default [me.tonsky.persistent-sorted-set.arrays :as da]) [datascript.parser :as dp #?@(:cljs [:refer [BindColl BindIgnore BindScalar BindTuple + Constant DefaultSrc Pattern RulesVar SrcVar Variable + Not Or And Predicate PlainSymbol]] + :cljd [:refer [BindColl BindIgnore BindScalar BindTuple Constant DefaultSrc Pattern RulesVar SrcVar Variable Not Or And Predicate PlainSymbol]])] [datascript.util :as util]) - #?(:clj - (:import + #?(:cljd nil + :clj + (:import [datascript.parser BindColl BindIgnore BindScalar BindTuple Constant DefaultSrc Pattern RulesVar SrcVar Variable @@ -30,8 +35,15 @@ (defn arange [start end] (to-array (range start end))) +(def #?(:cljd ^List make-array :default make-array) + #?(:cljd (fn [n] (.filled #/(List dynamic) n nil)) + :default da/make-array)) (defn subarr [arr start end] - (da/acopy arr start end (da/make-array (- end start)) 0)) + #?(:cljd (let [len (- end start) + dest (.filled #/(List dynamic) len nil)] + (dotimes [i len] (aset dest i (get arr (+ start i)))) + dest) + :default (da/acopy arr start end (make-array (- end start)) 0))) (defn concatv [& xs] (into [] cat xs)) @@ -219,11 +231,12 @@ ;;; ArrayRelation -(defn pr-rel [rel ^java.io.Writer w] +(defn pr-rel [rel w] (doto w (.write "#") (.write #?(:clj (.getSimpleName ^Class (class rel)) - :cljs (str (type rel)))) + :cljs (str (type rel)) + :cljd "")) (.write "{:symbols ") (.write (pr-str (-symbols rel))) (.write ", :coll ") @@ -243,12 +256,12 @@ (-getter [_ symbol] (let [idx (offset-map symbol)] (fn [tuple] - (da/aget tuple idx)))) + (#?(:cljd get :default da/aget) tuple idx)))) (-indexes [_ syms] (mapa offset-map syms)) (-copy-tuple [_ tuple idxs target target-idxs] - (dotimes [i (da/alength idxs)] - (da/aset target (da/aget target-idxs i) (da/aget tuple (da/aget idxs i))))) + (dotimes [i (#?(:cljd count :default da/alength) idxs)] + (#?(:cljd aset :default da/aset) target (#?(:cljd get :default da/aget) target-idxs i) (#?(:cljd get :default da/aget) tuple (#?(:cljd get :default da/aget) idxs i))))) (-union [_ rel] (assert (instance? ArrayRelation rel)) (assert (= offset-map (:offset-map rel))) @@ -281,8 +294,8 @@ (-indexes [_ syms] (mapa offset-map syms)) (-copy-tuple [_ tuple idxs target target-idxs] - (dotimes [i (da/alength idxs)] - (da/aset target (da/aget target-idxs i) (nth tuple (da/aget idxs i))))) + (dotimes [i (#?(:cljd count :default da/alength) idxs)] + (#?(:cljd aset :default da/aset) target (#?(:cljd get :default da/aget) target-idxs i) (nth tuple (#?(:cljd get :default da/aget) idxs i))))) (-union [_ rel] (assert (instance? CollRelation rel)) (assert (= offset-map (:offset-map rel))) @@ -369,7 +382,7 @@ rel2 t2 idxs2 arity target-idxs1 target-idxs2] - (let [arr (da/make-array arity)] + (let [arr (make-array arity)] (-copy-tuple rel1 t1 idxs1 arr target-idxs1) (-copy-tuple rel2 t2 idxs2 arr target-idxs2) arr)) @@ -410,7 +423,7 @@ (let [idxs (-indexes rel syms) target-idxs (arange 0 arity)] (fn [t] - (let [arr (da/make-array arity)] + (let [arr (make-array arity)] (-copy-tuple rel t idxs arr target-idxs) (vec arr))))))) @@ -468,7 +481,7 @@ BindScalar (let [symbol (get-in binding [:variable :symbol]) idx (get indexes symbol)] - (run! #(da/aset % idx source) tuples) + (run! #(#?(:cljd aset :default da/aset) % idx source) tuples) tuples) BindColl @@ -482,7 +495,7 @@ (into [] ;; TODO fast-arr (comp (map #(bind! tuples inner-binding % indexes)) cat - (map da/aclone)) + (map #?(:cljd vec :default da/aclone))) source)))) BindTuple @@ -505,7 +518,7 @@ (defn bind [binding source] (let [syms (map :symbol (dp/collect-vars-distinct binding)) indexes (zipmap syms (range)) - tuples (bind! [(da/make-array (count syms))] binding source indexes)] + tuples (bind! [(make-array (count syms))] binding source indexes)] (array-rel syms tuples))) (defn- rel->consts [rel] @@ -599,7 +612,7 @@ (if (instance? Variable form) (let [sym (:symbol form)] (if-let [subs (get (:consts context) (:symbol form))] - (Constant. subs) + #?(:cljd (dp/->Constant subs) :default (Constant. subs)) form)) form))) clause))) @@ -620,7 +633,7 @@ [related (assoc context :rels unrelated)])))) (defn join-unrelated [context rel] - (case (long (-size rel)) + (case #?(:cljd (-size rel) :default (long (-size rel))) 0 empty-context 1 (update context :consts merge (rel->consts rel)) (update context :rels conj rel))) @@ -756,14 +769,14 @@ (cond (instance? Variable arg) (when (contains? consts sym) - (da/aset target i (get consts sym))) + (#?(:cljd aset :default da/aset) target i (get consts sym))) (instance? SrcVar arg) (if (contains? sources sym) - (da/aset target i (get sources sym)) + (#?(:cljd aset :default da/aset) target i (get sources sym)) (throw (ex-info (str "Unbound source variable: " sym " in " form) { :error :query/where, :form form, :var sym}))) (instance? Constant arg) - (da/aset target i (:value arg)))))) + (#?(:cljd aset :default da/aset) target i (:value arg)))))) (defn get-f [context fun form] (let [sym (:symbol fun)] @@ -779,7 +792,7 @@ (let [{fun :fn, args :args} clause form (dp/source clause) f (get-f context fun form) - args-arr (da/make-array (count args)) + args-arr (make-array (count args)) _ (collect-args! context args args-arr form) consts (:consts context) sym+idx (for [[arg i] (zip args (range)) @@ -815,7 +828,7 @@ array (into (fast-arr) (apply comp (concat xfs [(filter pred)])) - [(da/make-array (count prod-syms))]) + [(make-array (count prod-syms))]) prod-rel* (array-rel prod-syms array)] (join-unrelated context* prod-rel*))))))) @@ -861,7 +874,7 @@ (doseq [[sym i] syms-indexed] (when (contains? consts sym) (let [val (get consts sym)] - (da/aset specimen i val))))) + (#?(:cljd aset :default da/aset) specimen i val))))) (defn collect-rel-xf [syms-indexed rel] @@ -877,16 +890,16 @@ ([result specimen] (-fold rel (fn [acc tuple] - (let [t (da/aclone specimen)] + (let [t (#?(:cljd vec :default da/aclone) specimen)] (-copy-tuple rel tuple idxs t target-idxs) (rf acc t))) result)))))) (defn collect-to ([context syms acc] - (collect-to context syms acc [] (da/make-array (count syms)))) + (collect-to context syms acc [] (make-array (count syms)))) ([context syms acc xfs] - (collect-to context syms acc xfs (da/make-array (count syms)))) + (collect-to context syms acc xfs (make-array (count syms)))) ([context syms acc xfs specimen] ;; TODO don't collect if array-rel and matches symbols (if (:empty? context) diff --git a/src/datascript/serialize.cljc b/src/datascript/serialize.cljc index 55c5bd9b..ff852c97 100644 --- a/src/datascript/serialize.cljc +++ b/src/datascript/serialize.cljc @@ -1,59 +1,90 @@ (ns datascript.serialize (:refer-clojure :exclude [amap array?]) (:require - [clojure.edn :as edn] + [#?(:cljd cljd.reader :default clojure.edn) :as edn] [clojure.string :as str] - [datascript.db :as db #?@(:cljs [:refer [Datom]])] + [datascript.db :as db #?(:cljd :refer :cljs :refer-macros :clj :refer) [raise] #?@(:cljs [:refer [Datom]] :cljd [:refer [Datom]])] + [datascript.util :as util] [datascript.lru :as lru] [datascript.storage :as storage] - [datascript.util :as util] [me.tonsky.persistent-sorted-set :as set] [me.tonsky.persistent-sorted-set.arrays :as arrays]) #?(:cljs (:require-macros [datascript.serialize :refer [array dict]])) - #?(:clj + #?(:cljd nil + :clj (:import [datascript.db Datom] [me.tonsky.persistent_sorted_set PersistentSortedSet]))) -(def ^:const ^:private marker-kw 0) -(def ^:const ^:private marker-other 1) -(def ^:const ^:private marker-inf 2) -(def ^:const ^:private marker-minus-inf 3) -(def ^:const ^:private marker-nan 4) +(def #?(:cljd ^:private marker-kw :default ^:const ^:private marker-kw) 0) +(def #?(:cljd ^:private marker-other :default ^:const ^:private marker-other) 1) +(def #?(:cljd ^:private marker-inf :default ^:const ^:private marker-inf) 2) +(def #?(:cljd ^:private marker-minus-inf :default ^:const ^:private marker-minus-inf) 3) +(def #?(:cljd ^:private marker-nan :default ^:const ^:private marker-nan) 4) (defn- if-cljs [env then else] (if (:ns env) then else)) -#?(:clj +#?(:cljd + ; cgrand: I wonder if a plain vec wouldn't work as well and that it + ; doesn't really matter if it's an "array" + (defmacro array + "Platform-native array representation (java.util.List on JVM, Array on JS)" + [& args] + `(doto (.filled #/(List dynamic) ~(count args) nil) + ~@(map-indexed + (fn [i arg] + `(. "[]=" ~i ~arg)) + args))) + :clj (defmacro array "Platform-native array representation (java.util.List on JVM, Array on JS)" [& args] (if-cljs &env - (list* 'js* (str "[" (str/join "," (repeat (count args) "~{}")) "]") args) - (vec args)))) + (list* 'js* (str "[" (str/join "," (repeat (count args) "~{}")) "]") args) + (vec args)))) -#?(:clj +#?(:cljd + (defmacro dict + "Platform-native dictionary representation (java.util.Map on JVM, Object on JS)" + [& args] + `(hash-map ~@args)) + :clj (defmacro dict "Platform-native dictionary representation (java.util.Map on JVM, Object on JS)" [& args] (if-cljs &env - (list* 'js* (str "{" (str/join "," (repeat (/ (count args) 2) "~{}:~{}")) "}") args) - `(array-map ~@args)))) + (list* 'js* (str "{" (str/join "," (repeat (/ (count args) 2) "~{}:~{}")) "}") args) + `(array-map ~@args)))) (defn- array-get [d i] - #?(:clj (.get ^java.util.List d (int i)) + #?(:cljd (. ^List d "[]" (int i)) + :clj (.get ^java.util.List d (int i)) :cljs (if (cljs.core/array? d) (arrays/aget d i) (nth d i)))) (defn- dict-get [d k] - #?(:clj (.get ^java.util.Map d k) + #?(:cljd (. ^Map d "[]" k) + :clj (.get ^java.util.Map d k) :cljs (if (map? d) (d k) (arrays/aget d k)))) (defn- array? [a] - #?(:clj (instance? java.util.List a) + #?(:cljd (dart/is? a List) + :clj (instance? java.util.List a) :cljs (or (cljs.core/array? a) (vector? a)))) +#?(:cljd + (defn- amap-in-place + [f xs] + (let [arr (.filled #/(List dynamic) (count xs) nil)] + (reduce (fn [idx x] (aset arr idx (f x)) (inc idx)) 0 xs) + arr))) + (defn- amap [f xs] - #?(:clj + #?(:cljd + (let [arr (.filled #/(List dynamic) (count xs) nil)] + (reduce (fn [idx x] (aset arr idx (f x)) (inc idx)) 0 xs) + arr) + :clj (let [arr (java.util.ArrayList. (count xs))] (reduce (fn [idx x] (.add arr (f x)) (inc idx)) 0 xs) arr) @@ -63,7 +94,11 @@ arr))) (defn- amap-indexed [f xs] - #?(:clj + #?(:cljd + (let [arr (.filled #/(List dynamic) (count xs) nil)] + (reduce (fn [idx x] (aset arr idx (f idx x)) (inc idx)) 0 xs) + arr) + :clj (let [arr (java.util.ArrayList. (count xs))] (reduce (fn [idx x] (.add arr (f idx x)) (inc idx)) 0 xs) arr) @@ -75,7 +110,7 @@ (defn- attr-comparator "Looks for a datom with attribute exactly bigger than the given one" [^Datom d1 ^Datom d2] - (cond + (cond (nil? (.-a d2)) -1 (<= (compare (.-a d1) (.-a d2)) 0) -1 true 1)) @@ -86,10 +121,13 @@ (if (empty? (:aevt db)) [] (loop [attrs (transient [(:a (first (:aevt db)))])] - (let [attr (nth attrs (dec (count attrs))) - left (db/datom 0 attr nil) - right (db/datom db/emax nil nil) - next-attr (:a (first (set/slice (:aevt db) left right attr-comparator)))] + (let [attr (nth attrs (dec (count attrs))) + left #?(:cljd (db/min-datom (db/datom db/emax attr nil)) + :default (db/datom 0 attr nil)) + right #?(:cljd (db/max-datom (db/datom db/emax nil nil)) + :default (db/datom db/emax nil nil)) + next-attr (:a (first #?(:cljd (set/seek (seq (:aevt db)) left) + :default (set/slice (:aevt db) left right attr-comparator))))] (if (some? next-attr) (recur (conj! attrs next-attr)) (persistent! attrs)))))) @@ -104,7 +142,7 @@ (defn- serializable-impl "Serialized structure breakdown: - count :: number + count :: number tx0 :: number max-eid :: number max-tx :: number @@ -122,71 +160,72 @@ freeze-kw freeze-kw}}] (when (storage/storage db) (throw (ex-info "serializable doesn't work with databases that have :storage" {}))) - (let [attrs (all-attrs db) - attrs-map (into {} (map vector attrs (range))) - *kws (volatile! (transient [])) - *kw-map (volatile! (transient {})) - write-kw (fn [kw] - (let [idx (or - (get @*kw-map kw) - (let [keywords (vswap! *kws conj! kw) - idx (dec (count keywords))] - (vswap! *kw-map assoc! kw idx) - idx))] - (array marker-kw idx))) + (let [attrs (all-attrs db) + attrs-map (into {} (map vector attrs (range))) + *kws (volatile! (transient [])) + *kw-map (volatile! (transient {})) + write-kw (fn [kw] + (let [idx (or + (get @*kw-map kw) + (let [keywords (vswap! *kws conj! kw) + idx (dec (count keywords))] + (vswap! *kw-map assoc! kw idx) + idx))] + (array marker-kw idx))) write-other (fn [v] (array marker-other (freeze-fn v))) - write-v (fn [v] - (cond - (string? v) v - #?@(:clj [(or - (instance? BigInteger v) - (instance? BigDecimal v) - (instance? clojure.lang.Ratio v) - (instance? clojure.lang.BigInt v)) - (write-other v)]) - - (number? v) - (cond - (== ##Inf v) (array marker-inf) - (== ##-Inf v) (array marker-minus-inf) - #?(:clj (Double/isNaN v) :cljs (js/isNaN v)) (array marker-nan) - :else v) - - (boolean? v) v - (keyword? v) (write-kw v) - true (write-other v))) - eavt (amap-indexed - (fn [idx ^Datom d] - (db/datom-set-idx d idx) - (let [e (.-e d) - a (attrs-map (.-a d)) - v (write-v (.-v d)) - tx (- (.-tx d) db/tx0)] - (array e a v tx))) - (:eavt db)) - aevt (amap-indexed (fn [_ ^Datom d] (db/datom-get-idx d)) (:aevt db)) - avet (amap-indexed (fn [_ ^Datom d] (db/datom-get-idx d)) (:avet db)) - schema (freeze-fn (:schema db)) - attrs (amap freeze-kw attrs) - kws (amap freeze-kw (persistent! @*kws)) - #?@(:clj + write-v (fn [v] + (cond + (string? v) v + #?@(:cljd [] :clj [(ratio? v) (write-other v)]) + + (number? v) + (cond + (== ##Inf v) (array marker-inf) + (== ##-Inf v) (array marker-minus-inf) + #?(:cljd (.-isNaN ^num v) :clj (Double/isNaN v) :cljs (js/isNaN v)) (array marker-nan) + :else v) + + (boolean? v) v + (keyword? v) (write-kw v) + true (write-other v))) + eavt (amap-indexed + (fn [idx ^Datom d] + (db/datom-set-idx d idx) + (let [e (.-e d) + a (attrs-map (.-a d)) + v (write-v (.-v d)) + tx (- (.-tx d) db/tx0)] + (array e a v tx))) + (:eavt db)) + aevt (amap-indexed (fn [_ ^Datom d] (db/datom-get-idx d)) (:aevt db)) + avet (amap-indexed (fn [_ ^Datom d] (db/datom-get-idx d)) (:avet db)) + schema (freeze-fn (:schema db)) + attrs (amap freeze-kw attrs) + kws (amap freeze-kw (persistent! @*kws)) + #?@(:cljd [] + :clj [settings (set/settings (:eavt db))])] (dict - "count" (count (:eavt db)) - "tx0" db/tx0 - "max-eid" (:max-eid db) - "max-tx" (:max-tx db) - "schema" schema - "attrs" attrs + "count" (count (:eavt db)) + "tx0" db/tx0 + "max-eid" (:max-eid db) + "max-tx" (:max-tx db) + "schema" schema + "attrs" attrs "keywords" kws - "eavt" eavt - "aevt" aevt - "avet" avet - #?@(:clj + "eavt" eavt + "aevt" aevt + "avet" avet + #?@(:cljd [] + :clj ["branching-factor" (:branching-factor settings) - "ref-type" (name (:ref-type settings))])))) + "ref-type" (name (:ref-type settings))])))) -#?(:clj +#?(:cljd + (defn serializable + ([db] (serializable-impl db {})) + ([db opts] (serializable-impl db opts))) + :clj (let [lock (Object.)] (defn serializable ([db] (locking lock (serializable-impl db {}))) @@ -197,42 +236,45 @@ ([db opts] (serializable-impl db opts)))) (defn from-serializable - ([from] + ([from] (from-serializable from {})) ([from {:keys [thaw-fn thaw-kw] :or {thaw-fn edn/read-string thaw-kw thaw-kw} - :as opts}] - (let [tx0 (dict-get from "tx0") - schema (thaw-fn (dict-get from "schema")) - _ (#'db/validate-schema schema) - attrs (->> (dict-get from "attrs") (mapv thaw-kw)) + :as opts}] + (let [tx0 (dict-get from "tx0") + schema (thaw-fn (dict-get from "schema")) + _ (#'db/validate-schema schema) + attrs (->> (dict-get from "attrs") (mapv thaw-kw)) keywords (->> (dict-get from "keywords") (mapv thaw-kw)) - eavt (->> (dict-get from "eavt") - (amap (fn [arr] - (let [e (array-get arr 0) - a (nth attrs (array-get arr 1)) - v (array-get arr 2) - v (cond - (number? v) v - (string? v) v - (boolean? v) v - (array? v) (let [marker (array-get v 0)] - (condp == marker - marker-kw (nth keywords (array-get v 1)) - marker-other (thaw-fn (array-get v 1)) - marker-inf ##Inf - marker-minus-inf ##-Inf - marker-nan ##NaN - (util/raise "Unexpected value marker " marker " in " (pr-str v) - {:error :serialize :value v}))) - true (util/raise "Unexpected value type " (type v) " (" (pr-str v) ")" - {:error :serialize :value v})) - tx (+ tx0 (array-get arr 3))] - (db/datom e a v tx)))) - #?(:clj arrays/into-array)) - aevt (some->> (dict-get from "aevt") (amap #(arrays/aget eavt %)) #?(:clj arrays/into-array)) - avet (some->> (dict-get from "avet") (amap #(arrays/aget eavt %)) #?(:clj arrays/into-array)) + eavt (->> (dict-get from "eavt") + ;; TODO: why amap and then into array again?? + ;; possibly for clojure? can't see why cljs would benefit + (#?(:cljd amap-in-place + :default amap) (fn [arr] + (let [e (array-get arr 0) + a (nth attrs (array-get arr 1)) + v (array-get arr 2) + v (cond + (number? v) v + (string? v) v + (boolean? v) v + (array? v) (let [marker (array-get v 0)] + (condp == marker + marker-kw (nth keywords (array-get v 1)) + marker-other (thaw-fn (array-get v 1)) + marker-inf ##Inf + marker-minus-inf ##-Inf + marker-nan ##NaN + (db/raise "Unexpected value marker " marker " in " (pr-str v) + {:error :serialize :value v}))) + true (db/raise "Unexpected value type (" (pr-str v) ")" + {:error :serialize :value v})) + tx (+ tx0 (array-get arr 3))] + (db/datom e a v tx)))) + #?(:cljd do :clj arrays/into-array)) + aevt (some->> (dict-get from "aevt") (amap #(#?(:cljd aget :default arrays/aget) eavt %)) #?(:cljd do :clj arrays/into-array)) + avet (some->> (dict-get from "avet") (amap #(#?(:cljd aget :default arrays/aget) eavt %)) #?(:cljd do :clj arrays/into-array)) settings (merge {:branching-factor (dict-get from "branching-factor") :ref-type (some-> (dict-get from "ref-type") keyword)} @@ -244,3 +286,4 @@ :avet (set/from-sorted-array db/cmp-datoms-avet avet (arrays/alength avet) settings) :max-eid (dict-get from "max-eid") :max-tx (dict-get from "max-tx")})))) + diff --git a/src/datascript/storage.cljd b/src/datascript/storage.cljd new file mode 100644 index 00000000..86082d28 --- /dev/null +++ b/src/datascript/storage.cljd @@ -0,0 +1,303 @@ +(ns datascript.storage + (:require + ["dart:async" :as dart:async] + ["dart:isolate" :as dart:isolate] + [cljd.dart.isolates :as di] + [datascript.db :as db] + [datascript.pull-api :as pull-api] + [datascript.query :as q] + [me.tonsky.persistent-sorted-set :as set] + [me.tonsky.persistent-sorted-set.async :as async-set])) + +(defprotocol IStorage + (-store [_ addr+data-seq]) + (-restore [_ addr]) + (-list-addresses [_]) + (-delete [_ addrs-seq])) + +(defn maybe-adapt-storage [opts] + opts) + +(defn storage [db] + (get db ::storage)) + +(defn attach-storage [db s] + (assoc db ::storage s)) + +(def ^:private root-addr 0) +(def ^:private tail-addr 1) + +(defonce ^:private *max-addr (volatile! 1000000)) + +(defn- gen-addr [] + (vswap! *max-addr inc)) + +(defn serializable-datom [^db/Datom d] + [(.-e d) (.-a d) (.-v d) (.-tx d)]) + +(defn- restore-datom [[e a v tx]] + (db/datom e a v tx)) + +(defn- store-node! [node *buf] + (cond + ;; Sync leaf (BTSet) — direct field access, no await needed + (instance? set/Leaf node) + (let [node-keys (mapv serializable-datom (.-keys node)) + addr (gen-addr)] + (vswap! *buf conj! [addr {:keys node-keys}]) + addr) + + ;; Sync internal node (BTSet) — recurse into children + (instance? set/Node node) + (let [node-keys (mapv serializable-datom (.-keys node)) + addrs (dart/await + (dart:async/Future.wait + (mapv #(store-node! % *buf) (.-pointers node)))) + addr (gen-addr)] + (vswap! *buf conj! [addr {:keys node-keys :addresses addrs}]) + addr) + + ;; Async node (AsyncBTSet) — materialize first, then dispatch + :else + (let [node (dart/await (async-set/async-node-materialize node)) + node-keys (mapv serializable-datom (.-keys node))] + (if (instance? async-set/AsyncLeaf node) + (let [addr (gen-addr)] + (vswap! *buf conj! [addr {:keys node-keys}]) + addr) + (let [addrs (dart/await + (dart:async/Future.wait + (mapv #(store-node! % *buf) (.-pointers node)))) + addr (gen-addr)] + (vswap! *buf conj! [addr {:keys node-keys :addresses addrs}]) + addr))))) + +(defn store-impl! + ([db s] + (dart/await (store-impl! db s false))) + ([db s _force?] + (let [{:keys [eavt aevt avet schema max-eid max-tx]} db + *buf (volatile! (transient [])) + eavt-addr (dart/await (store-node! (.-root eavt) *buf)) + aevt-addr (dart/await (store-node! (.-root aevt) *buf)) + avet-addr (dart/await (store-node! (.-root avet) *buf)) + root-data {:schema schema + :max-eid max-eid + :max-tx max-tx + :max-addr @*max-addr + :eavt {:root-addr eavt-addr :cnt (.-cnt eavt)} + :aevt {:root-addr aevt-addr :cnt (.-cnt aevt)} + :avet {:root-addr avet-addr :cnt (.-cnt avet)}}] + (vswap! *buf conj! [root-addr root-data]) + (vswap! *buf conj! [tail-addr []]) + (dart/await (-store s (persistent! @*buf))) + db))) + +(defn store + ([db] + (if-some [s (storage db)] + (dart/await (store-impl! db s false)) + (throw (ex-info "Database has no associated storage" {})))) + ([db s] + (dart/await (store-impl! db s false)))) + +(defn- build-node [storage {:keys [keys addresses]}] + (let [real-keys (to-array (map restore-datom keys))] + (if addresses + (async-set/->async-node + real-keys + (to-array (map (fn [addr] + (async-set/->async-lazy-node storage addr nil 0)) + addresses))) + (async-set/->async-leaf real-keys)))) + +(defn- make-ds-storage [s] + (reify async-set/IStorage + (restore-node [this address] + (future + (when-some [data (dart/await (-restore s address))] + (build-node this data)))))) + +(defn- load-btset [s root-addr cnt cmp] + (when-some [root-data (dart/await (-restore s root-addr))] + (let [storage' (make-ds-storage s) + async-btset (async-set/async-from-root (build-node storage' root-data) cnt cmp) + all-datoms (dart/await (async-set/async-slice async-btset nil nil))] + (set/from-sequential cmp all-datoms)))) + +(defn restore-impl + ([s] + (dart/await (restore-impl s {}))) + ([s _opts] + (when-some [{:keys [schema max-eid max-tx max-addr eavt aevt avet]} + (dart/await (-restore s root-addr))] + (vswap! *max-addr max max-addr) + (let [tail (dart/await (-restore s tail-addr)) + db (db/restore-db + {:schema schema + :eavt (dart/await (load-btset s (:root-addr eavt) (:cnt eavt) db/cmp-datoms-eavt-cmp)) + :aevt (dart/await (load-btset s (:root-addr aevt) (:cnt aevt) db/cmp-datoms-aevt-cmp)) + :avet (dart/await (load-btset s (:root-addr avet) (:cnt avet) db/cmp-datoms-avet-cmp)) + :max-eid max-eid + :max-tx max-tx})] + [db (mapv #(mapv restore-datom %) (or tail []))])))) + +(defn db-with-tail [db tail] + (reduce + (fn [db datoms] + (if (empty? datoms) + db + (as-> db % + (reduce db/with-datom % datoms) + (assoc % :max-tx (:tx (first datoms)))))) + db + tail)) + +(defn- store-tail* [s tail] + (dart/await + (-store s [[tail-addr (mapv #(mapv serializable-datom %) tail)]]))) + +(defn store-tail [db tail] + (if-some [s (storage db)] + (dart/await (store-tail* s tail)) + (throw (ex-info "Database has no associated storage" {})))) + +(defn- transact-report [db tx-data tx-meta] + (db/transact-tx-data (db/->TxReport db db [] {} tx-meta) tx-data)) + +(defn- dispatch [*conn *tx-tail s [op args ^dart:isolate/SendPort reply]] + (case op + :transact + (let [[tx-data tx-meta] args + report (transact-report @*conn tx-data tx-meta) + db (:db-after report) + tail' (swap! *tx-tail conj (:tx-data report))] + (reset! *conn db) + (if (> (transduce (map count) + 0 tail') + async-set/max-len) + (do + (dart/await (store-impl! db s false)) + (reset! *tx-tail [])) + (dart/await (store-tail* s tail'))) + (.send reply :ok)) + + :q + (let [[query & inputs] args] + (.send reply + (mapv #(if (db/datom? %) (serializable-datom %) %) + (apply q/q query @*conn inputs)))) + + :datoms + (let [[index & components] args] + (.send reply + (mapv serializable-datom + (apply db/-datoms @*conn index components)))) + + :pull + (let [[pattern id] args] + (.send reply (pull-api/pull @*conn pattern id))) + + :db-after + (.send reply nil) + + :store + (do + (dart/await (store-impl! @*conn s false)) + (reset! *tx-tail []) + (.send reply :ok)))) + +(defn- db-isolate-fn + [make-storage schema opts] + (fn [{:keys [in]}] + (let [s (make-storage) + [stored-db stored-tail] (or (dart/await (restore-impl s opts)) [nil []]) + conn (atom (if stored-db + (db-with-tail stored-db stored-tail) + (db/empty-db schema opts))) + *tail (atom (or stored-tail []))] + (.listen ^dart:isolate/ReceivePort in + (fn [msg] (dart/await (dispatch conn *tail s msg))))))) + +(defn spawn-db! + ([make-storage] (spawn-db! make-storage nil {})) + ([make-storage schema] (spawn-db! make-storage schema {})) + ([make-storage schema opts] + (dart/await + (let [{:keys [ports]} (dart/await (di/spawn! (db-isolate-fn make-storage schema opts)))] + (:in ports))))) + +;; ---- In-process async conn ---- +;; +;; A simpler alternative to spawn-db! that lives in the same Dart isolate. +;; - open-conn! restores or creates the DB (async, returns Future) +;; - transact! updates DB synchronously and flushes to storage asynchronously +;; - @conn always gives the current DB value +;; - d/q, d/pull, d/datoms etc. work directly on @conn + +(deftype AsyncConn [state-atom] + cljd.core/IDeref + (-deref [_] (:db @state-atom))) + +(defn open-conn! + "Create or restore a DataScript connection backed by persistent storage. + `make-storage` is a 0-arg fn returning an IStorage implementation. + Returns Future." + ([make-storage] + (open-conn! make-storage nil {})) + ([make-storage schema] + (open-conn! make-storage schema {})) + ([make-storage schema opts] + (let [s (make-storage) + [stored-db stored-tail] (or (dart/await (restore-impl s opts)) [nil []]) + db (if stored-db + (db-with-tail stored-db stored-tail) + (db/empty-db schema opts))] + (->AsyncConn + (atom {:db db + :storage s + :tx-tail (or stored-tail []) + :db-last-stored (or stored-db db) + :listeners {}}))))) + +(defn transact! + "Transact tx-data into conn. Returns Future." + ([^AsyncConn conn tx-data] + (transact! conn tx-data nil)) + ([^AsyncConn conn tx-data tx-meta] + (let [state-atom (.-state-atom conn) + state @state-atom + s (:storage state) + report (transact-report (:db state) tx-data tx-meta) + db' (:db-after report)] + (swap! state-atom assoc :db db') + (when-not (empty? (:tx-data report)) + (let [tx-tail (:tx-tail (swap! state-atom update :tx-tail conj (:tx-data report)))] + (if (> (transduce (map count) + 0 tx-tail) async-set/max-len) + (do + (dart/await (store-impl! db' s false)) + (swap! state-atom assoc :tx-tail [] :db-last-stored db')) + (dart/await (store-tail* s tx-tail))))) + (doseq [[_ cb] (:listeners @state-atom)] + (cb report)) + report))) + +(defn store! + "Force flush the current DB to storage. Returns Future." + [^AsyncConn conn] + (let [state-atom (.-state-atom conn) + state @state-atom] + (dart/await (store-impl! (:db state) (:storage state) false)) + (swap! state-atom assoc :tx-tail [] :db-last-stored (:db state)))) + +(defn listen! + "Register a `(fn [tx-report])` callback on conn. Returns key." + ([^AsyncConn conn callback] + (listen! conn (rand) callback)) + ([^AsyncConn conn key callback] + (swap! (.-state-atom conn) update :listeners assoc key callback) + key)) + +(defn unlisten! + "Deregister a listener by key." + [^AsyncConn conn key] + (swap! (.-state-atom conn) update :listeners dissoc key)) diff --git a/src/datascript/storage/libdbm.cljd b/src/datascript/storage/libdbm.cljd new file mode 100644 index 00000000..6552dd30 --- /dev/null +++ b/src/datascript/storage/libdbm.cljd @@ -0,0 +1,96 @@ +(ns datascript.storage.libdbm + "libdbm-backed persistent storage for DataScript on ClojureDart. + + Add to your pubspec.yaml: + dependencies: + libdbm: ^0.4.0 + + Usage: + (require '[datascript.storage :as storage] + '[datascript.storage.libdbm :as libdbm]) + + ;; Open (or restore) a persistent DB connection + (def conn + (dart/await + (storage/open-conn! + #(libdbm/open-storage \"/data/user/0/myapp.db\") + {:person/name {:db/index true}}))) + + ;; Transact — async (flushes to disk automatically) + (dart/await (storage/transact! conn [{:person/name \"Alice\" :person/age 30}])) + + ;; Query — fully synchronous, @conn is a plain DB value + (d/q '[:find ?n :where [_ :person/name ?n]] @conn) + ;; => #{[\"Alice\"]} + + ;; Force flush before app shutdown (optional — auto-flushed after each tx) + (dart/await (storage/store! conn)) + + ;; Close the underlying file when done + (libdbm/close! (libdbm/storage conn))" + (:require + ["dart:convert" :as dart:convert] + ["dart:io" :as dart:io] + ["package:libdbm/libdbm.dart" :as libdbm] + [cljd.reader :as reader] + [datascript.storage :as storage])) + +;; ---- Serialization helpers ---- + +(defn- int->bytes [^int addr] + (.encode dart:convert/utf8 (str addr))) + +(defn- clj->bytes [data] + (.encode dart:convert/utf8 (pr-str data))) + +(defn- bytes->clj [bytes] + (reader/read-string (.decode dart:convert/utf8 bytes))) + +;; ---- Storage type ---- + +(deftype LibDBMStorage [^libdbm/HashDBM db] + storage/IStorage + + (-store [_ addr+data-seq] + (doseq [[addr data] addr+data-seq] + (.put db (int->bytes addr) (clj->bytes data))) + (.flush db)) + + (-restore [_ addr] + (some-> (.get db (int->bytes addr)) bytes->clj)) + + (-list-addresses [_] + (let [iter (.entries db)] + (loop [acc (transient [])] + (if (.moveNext iter) + (recur (conj! acc + (int/parse (.decode dart:convert/utf8 (.-key (.-current iter)))))) + (persistent! acc))))) + + (-delete [_ addrs-seq] + (doseq [addr addrs-seq] + (.remove db (int->bytes addr))) + (.flush db))) + +;; ---- Public API ---- + +(defn open-storage + "Open (or create) a libdbm-backed IStorage at `path`. + Pass `#(open-storage path)` as the `make-storage` arg to `storage/open-conn!`." + [^String path] + (let [file (dart:io/File. path) + mode (if (.existsSync file) + (.-append dart:io/FileMode) + (.-write dart:io/FileMode))] + (->LibDBMStorage (libdbm/HashDBM. (.openSync file .mode mode))))) + +(defn storage + "Return the LibDBMStorage from an AsyncConn, for passing to close!." + [^storage/AsyncConn conn] + (:storage @(.-state-atom conn))) + +(defn close! + "Close the underlying HashDBM file handle. + Call this before app shutdown when using open-conn! directly." + [^LibDBMStorage s] + (.close (.-db s))) diff --git a/src/datascript/util.cljc b/src/datascript/util.cljc index 6add1a23..57bdcf66 100644 --- a/src/datascript/util.cljc +++ b/src/datascript/util.cljc @@ -1,6 +1,7 @@ (ns datascript.util (:refer-clojure :exclude [find]) - #?(:clj + #?(:cljd nil + :clj (:import [java.util UUID]))) @@ -19,10 +20,10 @@ data (last fragments)] `(throw (ex-info (str ~@(map (fn [m#] (if (string? m#) m# (list 'pr-str m#))) msgs)) ~data))))) -#?(:clj +#?(:cljd nil :clj (def ^:private ^:dynamic *if+-syms)) -#?(:clj +#?(:cljd nil :clj (defn- if+-rewrite-cond-impl [cond] (clojure.core/cond (empty? cond) @@ -49,12 +50,12 @@ (first cond) (if+-rewrite-cond-impl (next cond)))))) -#?(:clj +#?(:cljd nil :clj (defn- if+-rewrite-cond [cond] (binding [*if+-syms (volatile! [])] [(if+-rewrite-cond-impl cond) @*if+-syms]))) -#?(:clj +#?(:cljd nil :clj (defn- flatten-1 [xs] (vec (mapcat identity xs)))) @@ -80,22 +81,41 @@ ;; else: no x or y 6)" [cond then else] - (if (and - (seq? cond) - (or - (= 'and (first cond)) - (= 'clojure.core/and (first cond)))) - (let [[cond' syms] (if+-rewrite-cond (next cond))] - `(let ~(flatten-1 - (for [[_ sym] syms] - [sym '(volatile! nil)])) - (if ~cond' - (let ~(flatten-1 - (for [[binding sym] syms] - [binding (list 'deref sym)])) - ~then) - ~else))) - (list 'if cond then else)))) + #?(:cljd + (if (and + (seq? cond) + (or + (= 'and (first cond)) + (= 'clojure.core/and (first cond)))) + ((fn rewrite [clauses] + (clojure.core/cond + (empty? clauses) + then + + (= :let (first clauses)) + (list 'let (second clauses) (rewrite (nnext clauses))) + + :else + (list 'if (first clauses) (rewrite (next clauses)) else))) + (next cond)) + (list 'if cond then else)) + :default + (if (and + (seq? cond) + (or + (= 'and (first cond)) + (= 'clojure.core/and (first cond)))) + (let [[cond' syms] (if+-rewrite-cond (next cond))] + `(let ~(flatten-1 + (for [[_ sym] syms] + [sym '(volatile! nil)])) + (if ~cond' + (let ~(flatten-1 + (for [[binding sym] syms] + [binding (list 'deref sym)])) + ~then) + ~else))) + (list 'if cond then else))))) #?(:clj (defmacro cond+ [& clauses] @@ -116,7 +136,12 @@ (defn- rand-bits [pow] (rand-int (bit-shift-left 1 pow))) -#?(:cljs +#?(:cljd + (defn- to-hex-string [^int n l] + (-> n (.toRadixString 16) + (.padLeft l "0") + (subs 0 l))) + :cljs (defn- to-hex-string [n l] (let [s (.toString n 16) c (count s)] @@ -127,10 +152,22 @@ (defn squuid ([] - (squuid #?(:clj (System/currentTimeMillis) + (squuid #?(:cljd (.-millisecondsSinceEpoch (DateTime/now)) + :clj (System/currentTimeMillis) :cljs (.getTime (js/Date.))))) ([msec] - #?(:clj + #?(:cljd + (uuid + (str + (-> (int (/ msec 1000)) + (to-hex-string 8)) + "-" (-> (rand-bits 16) (to-hex-string 4)) + "-" (-> (rand-bits 16) (bit-and 0x0FFF) (bit-or 0x4000) (to-hex-string 4)) + "-" (-> (rand-bits 16) (bit-and 0x3FFF) (bit-or 0x8000) (to-hex-string 4)) + "-" (-> (rand-bits 16) (to-hex-string 4)) + (-> (rand-bits 16) (to-hex-string 4)) + (-> (rand-bits 16) (to-hex-string 4)))) + :clj (let [uuid (UUID/randomUUID) time (int (/ msec 1000)) high (.getMostSignificantBits uuid) @@ -153,7 +190,10 @@ (defn squuid-time-millis "Returns time that was used in [[squuid]] call, in milliseconds, rounded to the closest second." [uuid] - #?(:clj (-> (.getMostSignificantBits ^UUID uuid) + #?(:cljd (-> (subs (str uuid) 0 8) + (int/parse .radix 16) + (* 1000)) + :clj (-> (.getMostSignificantBits ^UUID uuid) (bit-shift-right 32) (* 1000)) :cljs (-> (subs (str uuid) 0 8) diff --git a/test/datascript/test/components.cljc b/test/datascript/test/components.cljc index 310385b5..83b7e2a3 100644 --- a/test/datascript/test/components.cljc +++ b/test/datascript/test/components.cljc @@ -1,10 +1,13 @@ (ns datascript.test.components (:require - [clojure.edn :as edn] - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.db :as db] - [datascript.test.core :as tdc])) + [#?(:cljd cljd.reader :cljs cljs.reader :clj clojure.edn) :as edn] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + [datascript.core :as d] + [datascript.db :as db] + #?(:cljd [cljd.core :refer [ExceptionInfo]]) + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]])) (t/use-fixtures :once tdc/no-namespace-maps) @@ -13,47 +16,47 @@ (deftest test-components (is (thrown-msg? "Bad attribute specification for :profile: {:db/isComponent true} should also have {:db/valueType :db.type/ref}" - (d/empty-db {:profile {:db/isComponent true}}))) + (d/empty-db {:profile {:db/isComponent true}}))) (is (thrown-msg? "Bad attribute specification for {:profile {:db/isComponent \"aaa\"}}, expected one of #{true false}" - (d/empty-db {:profile {:db/isComponent "aaa" :db/valueType :db.type/ref}}))) - + (d/empty-db {:profile {:db/isComponent "aaa" :db/valueType :db.type/ref}}))) + (let [db (d/db-with - (d/empty-db {:profile {:db/valueType :db.type/ref - :db/isComponent true}}) - [{:db/id 1 :name "Ivan" :profile 3} - {:db/id 3 :email "@3"} - {:db/id 4 :email "@4"}]) + (d/empty-db {:profile {:db/valueType :db.type/ref + :db/isComponent true}}) + [{:db/id 1 :name "Ivan" :profile 3} + {:db/id 3 :email "@3"} + {:db/id 4 :email "@4"}]) visible #(edn/read-string (pr-str %)) touched #(visible (d/touch %))] - + (testing "touch" (is (= (touched (d/entity db 1)) - {:db/id 1 - :name "Ivan" - :profile {:db/id 3 - :email "@3"}})) + {:db/id 1 + :name "Ivan" + :profile {:db/id 3 + :email "@3"}})) (is (= (touched (d/entity (d/db-with db [[:db/add 3 :profile 4]]) 1)) - {:db/id 1 - :name "Ivan" - :profile {:db/id 3 - :email "@3" - :profile {:db/id 4 - :email "@4"}}}))) + {:db/id 1 + :name "Ivan" + :profile {:db/id 3 + :email "@3" + :profile {:db/id 4 + :email "@4"}}}))) (testing "retractEntity" (let [db (d/db-with db [[:db.fn/retractEntity 1]])] (is (= (d/q '[:find ?a ?v :where [1 ?a ?v]] db) - #{})) + #{})) (is (= (d/q '[:find ?a ?v :where [3 ?a ?v]] db) - #{})))) - + #{})))) + (testing "retractAttribute" (let [db (d/db-with db [[:db.fn/retractAttribute 1 :profile]])] (is (= (d/q '[:find ?a ?v :where [3 ?a ?v]] db) - #{})))) - + #{})))) + (testing "reverse navigation" (is (= (visible (:_profile (d/entity db 3))) - {:db/id 1}))))) + {:db/id 1}))))) (deftest test-components-multival (let [db (d/db-with @@ -65,24 +68,24 @@ {:db/id 4 :email "@4"}]) visible #(edn/read-string (pr-str %)) touched #(visible (d/touch %))] - + (testing "touch" (is (= (touched (d/entity db 1)) - {:db/id 1 - :name "Ivan" - :profile #{{:db/id 3 :email "@3"} - {:db/id 4 :email "@4"}}}))) - + {:db/id 1 + :name "Ivan" + :profile #{{:db/id 3 :email "@3"} + {:db/id 4 :email "@4"}}}))) + (testing "retractEntity" (let [db (d/db-with db [[:db.fn/retractEntity 1]])] (is (= (d/q '[:find ?a ?v :in $ [?e ...] :where [?e ?a ?v]] db [1 3 4]) - #{})))) - + #{})))) + (testing "retractAttribute" (let [db (d/db-with db [[:db.fn/retractAttribute 1 :profile]])] (is (= (d/q '[:find ?a ?v :in $ [?e ...] :where [?e ?a ?v]] db [3 4]) - #{})))) - + #{})))) + (testing "reverse navigation" (is (= (visible (:_profile (d/entity db 3))) - {:db/id 1}))))) + {:db/id 1}))))) diff --git a/test/datascript/test/conn.cljc b/test/datascript/test/conn.cljc index 26e8bea2..026e4290 100644 --- a/test/datascript/test/conn.cljc +++ b/test/datascript/test/conn.cljc @@ -1,38 +1,37 @@ (ns datascript.test.conn (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] [datascript.test.core :as tdc])) -(def schema - {:aka {:db/cardinality :db.cardinality/many}}) - -(def datoms - #{(d/datom 1 :age 17) - (d/datom 1 :name "Ivan")}) +(def schema { :aka { :db/cardinality :db.cardinality/many }}) +(def datoms #{(d/datom 1 :age 17) + (d/datom 1 :name "Ivan")}) (deftest test-ways-to-create-conn (let [conn (d/create-conn)] (is (= #{} (set (d/datoms @conn :eavt)))) (is (= nil (:schema @conn)))) - + (let [conn (d/create-conn schema)] (is (= #{} (set (d/datoms @conn :eavt)))) (is (= schema (:schema @conn)))) - + (let [conn (d/conn-from-datoms datoms)] (is (= datoms (set (d/datoms @conn :eavt)))) (is (= nil (:schema @conn)))) - + (let [conn (d/conn-from-datoms datoms schema)] (is (= datoms (set (d/datoms @conn :eavt)))) (is (= schema (:schema @conn)))) - + (let [conn (d/conn-from-db (d/init-db datoms))] (is (= datoms (set (d/datoms @conn :eavt)))) (is (= nil (:schema @conn)))) - + (let [conn (d/conn-from-db (d/init-db datoms schema))] (is (= datoms (set (d/datoms @conn :eavt)))) (is (= schema (:schema @conn))))) @@ -43,12 +42,12 @@ _ (d/listen! conn #(reset! report %)) datoms' #{(d/datom 1 :age 20) (d/datom 1 :sex :male)} - schema' {:email {:db/unique :db.unique/identity}} + schema' { :email { :db/unique :db.unique/identity }} db' (d/init-db datoms' schema')] (d/reset-conn! conn db' :meta) (is (= datoms' (set (d/datoms @conn :eavt)))) (is (= schema' (:schema @conn))) - + (let [{:keys [db-before db-after tx-data tx-meta]} @report] (is (= datoms (set (d/datoms db-before :eavt)))) (is (= schema (:schema db-before))) @@ -59,4 +58,4 @@ [1 :name "Ivan" false] [1 :age 20 true] [1 :sex :male true]] - (map (juxt :e :a :v :added) tx-data)))))) + (map (juxt :e :a :v :added) tx-data)))))) diff --git a/test/datascript/test/core.cljc b/test/datascript/test/core.cljc index 73a5ec48..cd28c92d 100644 --- a/test/datascript/test/core.cljc +++ b/test/datascript/test/core.cljc @@ -1,17 +1,31 @@ (ns datascript.test.core (:require - [clojure.edn :as edn] - [clojure.test :as t :refer [is are deftest testing]] - [clojure.string :as str] - [cognitect.transit :as transit] - [datascript.core :as d] - [datascript.impl.entity :as de] - [datascript.db :as db :refer [defrecord-updatable]] - #?(:cljs [datascript.test.cljs]))) + [#?(:cljs cljs.reader :cljd cljd.reader :clj clojure.edn) :as edn] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + [clojure.string :as str] + #?(:cljd [wevre.transit-cljd :as transit] + :default [cognitect.transit :as transit]) + [datascript.core :as d] + [datascript.impl.entity :as de] + [datascript.db :as db #?@(:cljs [:refer-macros [defrecord-updatable]] + :clj [:refer [defrecord-updatable]])] + #?(:cljs [datascript.test.cljs]))) #?(:cljs (enable-console-print!)) +#?(:cljd + (defmacro thrown-msg? [expected-msg & body] + `(try + ~@body + false + (catch dynamic ^ExceptionInfo e# + (or (.contains ^String (or (.-message ^ExceptionInfo e#) (.toString e#)) ~expected-msg) + ;; rethrow for now to have a telling exception + (throw e#)))))) + ;; Added special case for printing ex-data of ExceptionInfo #?(:cljs (defmethod t/report [::t/default :error] [m] @@ -36,16 +50,18 @@ (reset! test-summary (dissoc m :type)))) (defn wrap-res [f] - #?(:cljs (do (f) (clj->js @test-summary)) + #?(:cljd :TOOD? + :cljs (do (f) (clj->js @test-summary)) :clj (let [res (f)] (when (pos? (+ (:fail res) (:error res))) (System/exit 1))))) ;; utils -#?(:clj - (defmethod t/assert-expr 'thrown-msg? [msg form] - (let [[_ match & body] form] - `(try ~@body +#?(:cljd nil + :clj +(defmethod t/assert-expr 'thrown-msg? [msg form] + (let [[_ match & body] form] + `(try ~@body (t/do-report {:type :fail, :message ~msg, :expected '~form, :actual nil}) (catch Throwable e# (let [m# (.getMessage e#)] @@ -64,15 +80,28 @@ (defn all-datoms [db] (into #{} (map (juxt :e :a :v)) (d/datoms db :eavt))) -#?(:clj - (defn no-namespace-maps [t] - (binding [*print-namespace-maps* false] - (t))) - :cljs - (def no-namespace-maps {:before #(set! *print-namespace-maps* false)})) +#?(:cljd + (defn no-namespace-maps + ([]) + ([_])) + :clj +(defn no-namespace-maps [t] + (binding [*print-namespace-maps* false] + (t))) +:cljs +(def no-namespace-maps {:before #(set! *print-namespace-maps* false)})) (defn transit-write [o type] - #?(:clj + #?(:cljd + (let [json-enc (.-encoder (transit/json)) + jsonv-enc (.-encoder (transit/json-verbose)) + msgpack-enc (.-encoder (transit/msgpack))] + (condp = type + :json (.convert json-enc o) + :json-verbose (.convert jsonv-enc o) + :msgpack (.convert msgpack-enc o) + (.convert json-enc o))) + :clj (with-open [os (java.io.ByteArrayOutputStream.)] (let [writer (transit/writer os type)] (transit/write writer o) @@ -80,19 +109,31 @@ :cljs (transit/write (transit/writer type) o))) + (defn transit-write-str [o] - #?(:clj (String. ^bytes (transit-write o :json) "UTF-8") + #?(:cljd (transit-write o :json) + :clj (String. ^bytes (transit-write o :json) "UTF-8") :cljs (transit-write o :json))) (defn transit-read [s type] - #?(:clj + #?(:cljd + (let [json-dec (.-decoder (transit/json)) + jsonv-dec (.-decoder (transit/json-verbose)) + msgpack-dec (.-decoder (transit/msgpack))] + (condp = type + :json (.convert json-dec s) + :json-verbose (.convert jsonv-dec s) + :msgpack (.convert msgpack-dec s) + (.convert json-dec s))) + :clj (with-open [is (java.io.ByteArrayInputStream. s)] (transit/read (transit/reader is type))) :cljs (transit/read (transit/reader type) s))) (defn transit-read-str [s] - #?(:clj (transit-read (.getBytes ^String s "UTF-8") :json) + #?(:cljd (transit-read s :json) + :clj (transit-read (.getBytes ^String s "UTF-8") :json) :cljs (transit-read s :json))) ;; Core tests @@ -100,10 +141,10 @@ (deftest test-protocols (let [schema {:aka {:db/cardinality :db.cardinality/many}} db (d/db-with (d/empty-db schema) - [{:db/id 1 :name "Ivan" :aka ["IV" "Terrible"]} - {:db/id 2 :name "Petr" :age 37 :huh? false}])] + [{:db/id 1 :name "Ivan" :aka ["IV" "Terrible"]} + {:db/id 2 :name "Petr" :age 37 :huh? false}])] (is (= (d/empty-db schema) - (empty db))) + (empty db))) (is (= 6 (count db))) (is (= #{:schema :eavt :aevt :avet :max-eid :max-tx :rschema :pull-patterns :pull-attrs :hash} (set (keys db)))) diff --git a/test/datascript/test/db.cljc b/test/datascript/test/db.cljc index 625ee331..c0c37c27 100644 --- a/test/datascript/test/db.cljc +++ b/test/datascript/test/db.cljc @@ -1,9 +1,13 @@ (ns datascript.test.db (:require [clojure.data] - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [clojure.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] - [datascript.db :as db :refer [defrecord-updatable]])) + [datascript.db :as db #?@(:cljd [:refer [defrecord-updatable]] + :cljs [:refer-macros [defrecord-updatable]] + :clj [:refer [defrecord-updatable]])])) ;; ;; verify that defrecord-updatable works with compiler/core macro configuration @@ -12,12 +16,14 @@ ;; (defrecord-updatable HashBeef [x] #?@(:cljs [IHash (-hash [hb] 0xBEEF)] + :cljd [cljd.core/IHash (-hash [hb] 0xBEEF)] :clj [clojure.lang.IHashEq (hasheq [hb] 0xBEEF)])) (deftest test-defrecord-updatable (is (= 0xBEEF (-> (map->HashBeef {:x :ignored}) hash)))) + ;; whitebox test to confirm that hash cache caches (deftest test-db-hash-cache (let [db (d/empty-db)] @@ -26,7 +32,8 @@ (is (= h @(.-hash db)))))) (defn- now [] - #?(:clj (System/currentTimeMillis) + #?(:cljd (.-millisecondsSinceEpoch (DateTime/now)) + :clj (System/currentTimeMillis) :cljs (.getTime (js/Date.)))) (deftest test-uuid @@ -39,12 +46,12 @@ (is (= (* 1000 now) (d/squuid-time-millis (d/squuid)))) (is (not= (d/squuid) (d/squuid))) (is (= (subs (str (d/squuid)) 0 8) - (subs (str (d/squuid)) 0 8))))) + (subs (str (d/squuid)) 0 8))))) (deftest test-diff (is (= [[(d/datom 1 :b 2) (d/datom 1 :c 4) (d/datom 2 :a 1)] [(d/datom 1 :b 3) (d/datom 1 :d 5)] [(d/datom 1 :a 1)]] - (clojure.data/diff - (-> (d/empty-db) (d/db-with [{:a 1 :b 2 :c 4} {:a 1}])) - (-> (d/empty-db) (d/db-with [{:b 3 :d 5}]) (d/db-with [{:db/id 1 :a 1}])))))) + (clojure.data/diff + (-> (d/empty-db) (d/db-with [{:a 1 :b 2 :c 4} {:a 1}])) + (-> (d/empty-db) (d/db-with [{:b 3 :d 5}]) (d/db-with [{:db/id 1 :a 1}])))))) diff --git a/test/datascript/test/entity.cljc b/test/datascript/test/entity.cljc index b851e614..7d943d3e 100644 --- a/test/datascript/test/entity.cljc +++ b/test/datascript/test/entity.cljc @@ -1,21 +1,23 @@ (ns datascript.test.entity (:require - [clojure.edn :as edn] - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.db :as db] - [datascript.test.core :as tdc]) - #?(:clj - (:import - [clojure.lang ExceptionInfo]))) + [#?(:cljd cljd.reader :cljs cljs.reader :clj clojure.edn) :as edn] + #?(:cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + [datascript.core :as d] + [datascript.db :as db] + #?(:cljd [cljd.core :refer [ExceptionInfo]]) + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]]) + #?(:cljd nil + :clj + (:import [clojure.lang ExceptionInfo]))) (t/use-fixtures :once tdc/no-namespace-maps) (deftest test-entity (let [db (-> (d/empty-db {:aka {:db/cardinality :db.cardinality/many}}) - (d/db-with [{:db/id 1, :name "Ivan", :age 19, :aka ["X" "Y"]} - {:db/id 2, :name "Ivan", :sex "male", :aka ["Z"]} - [:db/add 3 :huh? false]])) + (d/db-with [{:db/id 1, :name "Ivan", :age 19, :aka ["X" "Y"]} + {:db/id 2, :name "Ivan", :sex "male", :aka ["Z"]} + [:db/add 3 :huh? false]])) e (d/entity db 1)] (is (= (:db/id e) 1)) (is (identical? (d/entity-db e) db)) @@ -26,11 +28,11 @@ (is (= true (contains? e :age))) (is (= false (contains? e :not-found))) (is (= (into {} e) - {:name "Ivan", :age 19, :aka #{"X" "Y"}})) + {:name "Ivan", :age 19, :aka #{"X" "Y"}})) (is (= (into {} (d/entity db 1)) - {:name "Ivan", :age 19, :aka #{"X" "Y"}})) + {:name "Ivan", :age 19, :aka #{"X" "Y"}})) (is (= (into {} (d/entity db 2)) - {:name "Ivan", :sex "male", :aka #{"Z"}})) + {:name "Ivan", :sex "male", :aka #{"Z"}})) (let [e3 (d/entity db 3)] (is (= (into {} e3) {:huh? false})) ; Force caching. (is (false? (:huh? e3)))) @@ -39,17 +41,17 @@ (is (= (pr-str (let [e (d/entity db 1)] (:unknown e) e)) "{:db/id 1}")) ;; read back in to account for unordered-ness (is (= (edn/read-string (pr-str (let [e (d/entity db 1)] (:name e) e))) - (edn/read-string "{:name \"Ivan\", :db/id 1}"))))) + (edn/read-string "{:name \"Ivan\", :db/id 1}"))))) (deftest test-entity-refs (let [db (-> (d/empty-db {:father {:db/valueType :db.type/ref} :children {:db/valueType :db.type/ref :db/cardinality :db.cardinality/many}}) - (d/db-with - [{:db/id 1, :children [10]} - {:db/id 10, :father 1, :children [100 101]} - {:db/id 100, :father 10} - {:db/id 101, :father 10}])) + (d/db-with + [{:db/id 1, :children [10]} + {:db/id 10, :father 1, :children [100 101]} + {:db/id 100, :father 10} + {:db/id 101, :father 10}])) e #(d/entity db %)] (is (= (:children (e 1)) #{(e 10)})) @@ -77,7 +79,8 @@ (is (= (:_father (e 1)) #{(e 10)})) (is (= (:_children (e 10)) #{(e 1)})) (is (= (:_father (e 10)) #{(e 100) (e 101)})) - (is (= (-> (e 100) :_children first :_children) #{(e 1)}))))) + (is (= (-> (e 100) :_children first :_children) #{(e 1)})) + ))) (deftest test-missing-refs (let [schema {:ref {:db/valueType :db.type/ref} @@ -101,7 +104,7 @@ (is (= nil (:comp (d/entity db 1)))) (is (= nil (:multiref (d/entity db 1)))) (is (= nil (:multicomp (d/entity db 1)))))) - + (deftest test-entity-misses (let [db (-> (d/empty-db {:name {:db/unique :db.unique/identity}}) (d/db-with [{:db/id 1, :name "Ivan"} diff --git a/test/datascript/test/explode.cljc b/test/datascript/test/explode.cljc index 028ba962..82486833 100644 --- a/test/datascript/test/explode.cljc +++ b/test/datascript/test/explode.cljc @@ -1,13 +1,15 @@ (ns datascript.test.explode (:require - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.db :as db] - [datascript.test.core :as tdc])) + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + [datascript.core :as d] + [datascript.db :as db] + #?(:cljd [cljd.core :refer [ExceptionInfo]]) + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]])) #?(:cljs - (def Throwable - js/Error)) + (def Throwable js/Error)) (deftest test-explode (doseq [coll [["Devil" "Tupen"] @@ -25,131 +27,110 @@ (is (= (d/q '[:find ?n ?a :where [1 :name ?n] [1 :age ?a]] @conn) - #{["Ivan" 16]})) + #{["Ivan" 16]})) (is (= (d/q '[:find ?v :where [1 :also ?v]] @conn) - #{["ok"]})) + #{["ok"]})) (is (= (d/q '[:find ?v :where [1 :aka ?v]] @conn) - #{["Devil"] ["Tupen"]})))))) + #{["Devil"] ["Tupen"]})))))) (deftest test-explode-ref - (let [db0 (d/empty-db {:children {:db/valueType :db.type/ref - :db/cardinality :db.cardinality/many}})] - (doseq [children [[-2 -3] - #{-2 -3} - (list -2 -3)]] - (testing (str "ref + many + " children) - (let [db (d/db-with db0 [{:db/id -1, :name "Ivan", :children children} - {:db/id -2, :name "Petr"} - {:db/id -3, :name "Evgeny"}])] - (is (= #{["Petr"] ["Evgeny"]} - (d/q '[:find ?n - :where - [_ :children ?e] - [?e :name ?n]] db)))))) - + (let [db0 (d/empty-db { :children { :db/valueType :db.type/ref + :db/cardinality :db.cardinality/many } })] + (let [db (d/db-with db0 [{:db/id -1, :name "Ivan", :children [-2 -3]} + {:db/id -2, :name "Petr"} + {:db/id -3, :name "Evgeny"}])] + (is (= (d/q '[:find ?n + :where [_ :children ?e] + [?e :name ?n]] db) + #{["Petr"] ["Evgeny"]}))) + (let [db (d/db-with db0 [{:db/id -1, :name "Ivan"} - {:db/id -2, :name "Petr", :_children -1} + {:db/id -2, :name "Petr", :_children -1} {:db/id -3, :name "Evgeny", :_children -1}])] - (is (= #{["Petr"] ["Evgeny"]} - (d/q '[:find ?n - :where - [_ :children ?e] - [?e :name ?n]] db)))) - + (is (= (d/q '[:find ?n + :where [_ :children ?e] + [?e :name ?n]] db) + #{["Petr"] ["Evgeny"]}))) + (is (thrown-msg? "Bad attribute :_parent: reverse attribute name requires {:db/valueType :db.type/ref} in schema" - (d/db-with db0 [{:name "Sergey" :_parent 1}]))))) + (d/db-with db0 [{:name "Sergey" :_parent 1}]))))) (deftest test-explode-nested-maps - (let [schema {:profile {:db/valueType :db.type/ref}} + (let [schema { :profile { :db/valueType :db.type/ref }} db (d/empty-db schema)] - (are [tx res] (= res (d/q '[:find ?e ?a ?v - :where [?e ?a ?v]] - (d/db-with db tx))) - [{:db/id 5 :name "Ivan" :profile {:db/id 7 :email "@2"}}] - #{[5 :name "Ivan"] [5 :profile 7] [7 :email "@2"]} - - [{:name "Ivan" :profile {:email "@2"}}] - #{[1 :name "Ivan"] [1 :profile 2] [2 :email "@2"]} - - ;; issue-59 - [{:profile {:email "@2"}}] - #{[2 :profile 1] [1 :email "@2"]} - - [{:email "@2" :_profile {:name "Ivan"}}] - #{[1 :email "@2"] [2 :name "Ivan"] [2 :profile 1]})) - + (are [tx res] (= (d/q '[:find ?e ?a ?v + :where [?e ?a ?v]] + (d/db-with db tx)) res) + [ {:db/id 5 :name "Ivan" :profile {:db/id 7 :email "@2"}} ] + #{ [5 :name "Ivan"] [5 :profile 7] [7 :email "@2"] } + + [ {:name "Ivan" :profile {:email "@2"}} ] + #{ [1 :name "Ivan"] [1 :profile 2] [2 :email "@2"] } + + [ {:profile {:email "@2"}} ] ;; issue #59 + #{ [1 :profile 2] [2 :email "@2"] } + + [ {:email "@2" :_profile {:name "Ivan"}} ] + #{ [1 :email "@2"] [2 :name "Ivan"] [2 :profile 1] } + )) + (testing "multi-valued" - (let [schema {:profile {:db/valueType :db.type/ref - :db/cardinality :db.cardinality/many}} + (let [schema { :profile { :db/valueType :db.type/ref + :db/cardinality :db.cardinality/many }} db (d/empty-db schema)] - (are [tx res] (= res (d/q '[:find ?e ?a ?v - :where [?e ?a ?v]] - (d/db-with db tx))) - [{:db/id 5 :name "Ivan" :profile {:db/id 7 :email "@2"}}] - #{[5 :name "Ivan"] [5 :profile 7] [7 :email "@2"]} - - [{:db/id 5 :name "Ivan" :profile [{:db/id 7 :email "@2"} {:db/id 8 :email "@3"}]}] - #{[5 :name "Ivan"] [5 :profile 7] [7 :email "@2"] [5 :profile 8] [8 :email "@3"]} - - [{:name "Ivan" :profile {:email "@2"}}] - #{[1 :name "Ivan"] [1 :profile 2] [2 :email "@2"]} - - [{:name "Ivan" :profile [{:email "@2"} {:email "@3"}]}] - #{[1 :name "Ivan"] [1 :profile 2] [2 :email "@2"] [1 :profile 3] [3 :email "@3"]} - - ;; issue-467 - [{:name "Ivan" :profile #{{:email "@2"} {:email "@3"}}}] - #{[1 :name "Ivan"] [1 :profile 2] [2 :email "@3"] [1 :profile 3] [3 :email "@2"]} - - [{:name "Ivan" :profile (list {:email "@2"} {:email "@3"})}] - #{[1 :name "Ivan"] [1 :profile 2] [2 :email "@2"] [1 :profile 3] [3 :email "@3"]} - - [{:email "@2" :_profile {:name "Ivan"}}] - #{[1 :email "@2"] [2 :name "Ivan"] [2 :profile 1]} - - [{:email "@2" :_profile [{:name "Ivan"} {:name "Petr"}]}] - #{[1 :email "@2"] [2 :name "Ivan"] [2 :profile 1] [3 :name "Petr"] [3 :profile 1]})))) + (are [tx res] (= (d/q '[:find ?e ?a ?v + :where [?e ?a ?v]] + (d/db-with db tx)) res) + [ {:db/id 5 :name "Ivan" :profile {:db/id 7 :email "@2"}} ] + #{ [5 :name "Ivan"] [5 :profile 7] [7 :email "@2"] } + + [ {:db/id 5 :name "Ivan" :profile [{:db/id 7 :email "@2"} {:db/id 8 :email "@3"}]} ] + #{ [5 :name "Ivan"] [5 :profile 7] [7 :email "@2"] [5 :profile 8] [8 :email "@3"] } + + [ {:name "Ivan" :profile {:email "@2"}} ] + #{ [1 :name "Ivan"] [1 :profile 2] [2 :email "@2"] } + + [ {:name "Ivan" :profile [{:email "@2"} {:email "@3"}]} ] + #{ [1 :name "Ivan"] [1 :profile 2] [2 :email "@2"] [1 :profile 3] [3 :email "@3"] } + + [ {:email "@2" :_profile {:name "Ivan"}} ] + #{ [1 :email "@2"] [2 :name "Ivan"] [2 :profile 1] } + + [ {:email "@2" :_profile [{:name "Ivan"} {:name "Petr"} ]} ] + #{ [1 :email "@2"] [2 :name "Ivan"] [2 :profile 1] [3 :name "Petr"] [3 :profile 1] } + )))) (deftest test-circular-refs (let [schema {:comp {:db/valueType :db.type/ref :db/cardinality :db.cardinality/many :db/isComponent true}} - db (-> (d/empty-db schema) - (d/db-with [{:db/id -1 :name "Name"}]) - (d/db-with [{:db/id 1, :comp [{:name "C"}]}]))] - (is (= [[1 :comp 2] - [1 :name "Name"] - [2 :name "C"]] - (mapv (juxt :e :a :v) (d/datoms db :eavt))))) - + db (d/db-with (d/empty-db schema) + [{:db/id 1, :comp [{:name "C"}]}])] + (is (= (mapv (juxt :e :a :v) (d/datoms db :eavt)) + [ [ 1 :comp 2 ] + [ 2 :name "C"] ]))) + (let [schema {:comp {:db/valueType :db.type/ref :db/cardinality :db.cardinality/many}} - db (-> (d/empty-db schema) - (d/db-with [{:db/id -1 :name "Name"}]) - (d/db-with [{:db/id 1, :comp [{:name "C"}]}]))] - (is (= [[1 :comp 2] - [1 :name "Name"] - [2 :name "C"]] - (mapv (juxt :e :a :v) (d/datoms db :eavt))))) - + db (d/db-with (d/empty-db schema) + [{:db/id 1, :comp [{:name "C"}]}])] + (is (= (mapv (juxt :e :a :v) (d/datoms db :eavt)) + [ [ 1 :comp 2 ] + [ 2 :name "C"] ]))) + (let [schema {:comp {:db/valueType :db.type/ref :db/isComponent true}} - db (-> (d/empty-db schema) - (d/db-with [{:db/id -1 :name "Name"}]) - (d/db-with [{:db/id 1, :comp {:name "C"}}]))] - (is (= [[1 :comp 2] - [1 :name "Name"] - [2 :name "C"]] - (mapv (juxt :e :a :v) (d/datoms db :eavt))))) - + db (d/db-with (d/empty-db schema) + [{:db/id 1, :comp {:name "C"}}])] + (is (= (mapv (juxt :e :a :v) (d/datoms db :eavt)) + [ [ 1 :comp 2 ] + [ 2 :name "C"] ]))) + (let [schema {:comp {:db/valueType :db.type/ref}} - db (-> (d/empty-db schema) - (d/db-with [{:db/id -1 :name "Name"}]) - (d/db-with [{:db/id 1, :comp {:name "C"}}]))] - (is (= [[1 :comp 2] - [1 :name "Name"] - [2 :name "C"]] - (mapv (juxt :e :a :v) (d/datoms db :eavt)))))) - + db (d/db-with (d/empty-db schema) + [{:db/id 1, :comp {:name "C"}}])] + (is (= (mapv (juxt :e :a :v) (d/datoms db :eavt)) + [ [ 1 :comp 2 ] + [ 2 :name "C"] ])))) diff --git a/test/datascript/test/index.cljc b/test/datascript/test/index.cljc index 094c30f4..514f9e38 100644 --- a/test/datascript/test/index.cljc +++ b/test/datascript/test/index.cljc @@ -1,53 +1,56 @@ (ns datascript.test.index (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] - [datascript.test.core :as tdc])) + #?(:cljd [cljd.core :refer [ExceptionInfo]]) + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]])) (deftest test-datoms (let [dvec #(vector (:e %) (:a %) (:v %)) db (-> (d/empty-db {:age {:db/index true}}) - (d/db-with [[:db/add 1 :name "Petr"] - [:db/add 1 :age 44] - [:db/add 2 :name "Ivan"] - [:db/add 2 :age 25] - [:db/add 3 :name "Sergey"] - [:db/add 3 :age 11]]))] + (d/db-with [ [:db/add 1 :name "Petr"] + [:db/add 1 :age 44] + [:db/add 2 :name "Ivan"] + [:db/add 2 :age 25] + [:db/add 3 :name "Sergey"] + [:db/add 3 :age 11] ]))] (testing "Main indexes, sort order" - (is (= [[1 :age 44] - [2 :age 25] - [3 :age 11] - [1 :name "Petr"] - [2 :name "Ivan"] - [3 :name "Sergey"]] - (map dvec (d/datoms db :aevt)))) - - (is (= [[1 :age 44] - [1 :name "Petr"] - [2 :age 25] - [2 :name "Ivan"] - [3 :age 11] - [3 :name "Sergey"]] - (map dvec (d/datoms db :eavt)))) - - (is (= [[3 :age 11] - [2 :age 25] - [1 :age 44]] - (map dvec (d/datoms db :avet))))) ;; name non-indexed, excluded from avet + (is (= [ [1 :age 44] + [2 :age 25] + [3 :age 11] + [1 :name "Petr"] + [2 :name "Ivan"] + [3 :name "Sergey"] ] + (map dvec (d/datoms db :aevt)))) + + (is (= [ [1 :age 44] + [1 :name "Petr"] + [2 :age 25] + [2 :name "Ivan"] + [3 :age 11] + [3 :name "Sergey"] ] + (map dvec (d/datoms db :eavt)))) + + (is (= [ [3 :age 11] + [2 :age 25] + [1 :age 44] ] + (map dvec (d/datoms db :avet))))) ;; name non-indexed, excluded from avet (testing "Components filtration" - (is (= [[1 :age 44] - [1 :name "Petr"]] - (map dvec (d/datoms db :eavt 1)))) + (is (= [ [1 :age 44] + [1 :name "Petr"] ] + (map dvec (d/datoms db :eavt 1)))) - (is (= [[1 :age 44]] - (map dvec (d/datoms db :eavt 1 :age)))) + (is (= [ [1 :age 44] ] + (map dvec (d/datoms db :eavt 1 :age)))) - (is (= [[3 :age 11] - [2 :age 25] - [1 :age 44]] - (map dvec (d/datoms db :avet :age))))) + (is (= [ [3 :age 11] + [2 :age 25] + [1 :age 44] ] + (map dvec (d/datoms db :avet :age))))) (testing "Error reporting" (d/datoms db :avet) ;; no error @@ -62,113 +65,91 @@ (d/datoms db :avet :name "Ivan"))) (is (thrown-msg? "Attribute :name should be marked as :db/index true" - (d/datoms db :avet :name "Ivan" 1)))) - - (testing "Sequence compare issue-470" - (let [db (-> (d/empty-db {:path {:db/index true}}) - (d/db-with [{:db/id 1 :path [1 2]} - {:db/id 2 :path [1 2 3]}]))] - (are [value result] (= result (mapv :e (d/datoms db :avet :path value))) - [1] [] - [1 1] [] - [1 2] [1] - (list 1 2) [1] - (butlast [1 2 3]) [1] - [1 3] [] - [1 2 2] [] - [1 2 3] [2] - (list 1 2 3) [2] - (butlast [1 2 3 4]) [2] - [1 2 4] [] - [1 2 3 4] []))))) + (d/datoms db :avet :name "Ivan" 1)))))) (deftest test-datom (let [dvec #(when % (vector (:e %) (:a %) (:v %))) db (-> (d/empty-db {:age {:db/index true}}) - (d/db-with [[:db/add 1 :name "Petr"] - [:db/add 1 :age 44] - [:db/add 2 :name "Ivan"] - [:db/add 2 :age 25] - [:db/add 3 :name "Sergey"] - [:db/add 3 :age 11]]))] + (d/db-with [ [:db/add 1 :name "Petr"] + [:db/add 1 :age 44] + [:db/add 2 :name "Ivan"] + [:db/add 2 :age 25] + [:db/add 3 :name "Sergey"] + [:db/add 3 :age 11] ]))] (is (= [1 :age 44] (dvec (d/find-datom db :eavt)))) (is (= [1 :age 44] (dvec (d/find-datom db :eavt 1)))) (is (= [1 :age 44] (dvec (d/find-datom db :eavt 1 :age)))) (is (= [1 :name "Petr"] (dvec (d/find-datom db :eavt 1 :name)))) (is (= [1 :name "Petr"] (dvec (d/find-datom db :eavt 1 :name "Petr")))) - + (is (= [2 :age 25] (dvec (d/find-datom db :eavt 2)))) (is (= [2 :age 25] (dvec (d/find-datom db :eavt 2 :age)))) (is (= [2 :name "Ivan"] (dvec (d/find-datom db :eavt 2 :name)))) - + (is (= nil (dvec (d/find-datom db :eavt 1 :name "Ivan")))) - (is (= nil (dvec (d/find-datom db :eavt 4)))) - - ;; issue-477 - (is (= nil (d/find-datom (d/empty-db) :eavt))) - (is (= nil (d/find-datom (d/empty-db {:age {:db/index true}}) :eavt))))) + (is (= nil (dvec (d/find-datom db :eavt 4)))))) (deftest test-seek-datoms (let [dvec #(vector (:e %) (:a %) (:v %)) - db (-> (d/empty-db {:name {:db/index true} - :age {:db/index true}}) - (d/db-with [[:db/add 1 :name "Petr"] - [:db/add 1 :age 44] - [:db/add 2 :name "Ivan"] - [:db/add 2 :age 25] - [:db/add 3 :name "Sergey"] - [:db/add 3 :age 11]]))] + db (-> (d/empty-db { :name { :db/index true } + :age { :db/index true } }) + (d/db-with [[:db/add 1 :name "Petr"] + [:db/add 1 :age 44] + [:db/add 2 :name "Ivan"] + [:db/add 2 :age 25] + [:db/add 3 :name "Sergey"] + [:db/add 3 :age 11]]))] (testing "Non-termination" (is (= (map dvec (d/seek-datoms db :avet :age 10)) - [[3 :age 11] - [2 :age 25] - [1 :age 44] - [2 :name "Ivan"] - [1 :name "Petr"] - [3 :name "Sergey"]]))) + [ [3 :age 11] + [2 :age 25] + [1 :age 44] + [2 :name "Ivan"] + [1 :name "Petr"] + [3 :name "Sergey"] ]))) (testing "Closest value lookup" (is (= (map dvec (d/seek-datoms db :avet :name "P")) - [[1 :name "Petr"] - [3 :name "Sergey"]]))) + [ [1 :name "Petr"] + [3 :name "Sergey"] ]))) (testing "Exact value lookup" (is (= (map dvec (d/seek-datoms db :avet :name "Petr")) - [[1 :name "Petr"] - [3 :name "Sergey"]]))) + [ [1 :name "Petr"] + [3 :name "Sergey"] ]))) (is (thrown-msg? "Attribute :alias should be marked as :db/index true" (d/seek-datoms db :avet :alias))))) (deftest test-rseek-datoms (let [dvec #(vector (:e %) (:a %) (:v %)) - db (-> (d/empty-db {:name {:db/index true} - :age {:db/index true}}) - (d/db-with [[:db/add 1 :name "Petr"] - [:db/add 1 :age 44] - [:db/add 2 :name "Ivan"] - [:db/add 2 :age 25] - [:db/add 3 :name "Sergey"] - [:db/add 3 :age 11]]))] + db (-> (d/empty-db { :name { :db/index true } + :age { :db/index true } }) + (d/db-with [[:db/add 1 :name "Petr"] + [:db/add 1 :age 44] + [:db/add 2 :name "Ivan"] + [:db/add 2 :age 25] + [:db/add 3 :name "Sergey"] + [:db/add 3 :age 11]]))] (testing "Non-termination" (is (= (map dvec (d/rseek-datoms db :avet :name "Petr")) - [[1 :name "Petr"] - [2 :name "Ivan"] - [1 :age 44] - [2 :age 25] - [3 :age 11]]))) + [ [1 :name "Petr"] + [2 :name "Ivan"] + [1 :age 44] + [2 :age 25] + [3 :age 11]]))) (testing "Closest value lookup" (is (= (map dvec (d/rseek-datoms db :avet :age 26)) - [[2 :age 25] - [3 :age 11]]))) + [ [2 :age 25] + [3 :age 11]]))) (testing "Exact value lookup" (is (= (map dvec (d/rseek-datoms db :avet :age 25)) - [[2 :age 25] - [3 :age 11]]))) + [ [2 :age 25] + [3 :age 11]]))) (is (thrown-msg? "Attribute :alias should be marked as :db/index true" (d/rseek-datoms db :avet :alias))))) @@ -176,49 +157,49 @@ (deftest test-index-range (let [dvec #(vector (:e %) (:a %) (:v %)) db (d/db-with - (d/empty-db {:name {:db/index true} - :age {:db/index true}}) - [{:db/id 1 :name "Ivan" :age 15} - {:db/id 2 :name "Oleg" :age 20} - {:db/id 3 :name "Sergey" :age 7} - {:db/id 4 :name "Pavel" :age 45} - {:db/id 5 :name "Petr" :age 20}])] + (d/empty-db { :name { :db/index true} + :age { :db/index true} }) + [ { :db/id 1 :name "Ivan" :age 15 } + { :db/id 2 :name "Oleg" :age 20 } + { :db/id 3 :name "Sergey" :age 7 } + { :db/id 4 :name "Pavel" :age 45 } + { :db/id 5 :name "Petr" :age 20 } ])] (is (= (map dvec (d/index-range db :name "Pe" "S")) - [[5 :name "Petr"]])) + [ [5 :name "Petr"] ])) (is (= (map dvec (d/index-range db :name "O" "Sergey")) - [[2 :name "Oleg"] - [4 :name "Pavel"] - [5 :name "Petr"] - [3 :name "Sergey"]])) + [ [2 :name "Oleg"] + [4 :name "Pavel"] + [5 :name "Petr"] + [3 :name "Sergey"] ])) (is (= (map dvec (d/index-range db :name nil "P")) - [[1 :name "Ivan"] - [2 :name "Oleg"]])) + [ [1 :name "Ivan"] + [2 :name "Oleg"] ])) (is (= (map dvec (d/index-range db :name "R" nil)) - [[3 :name "Sergey"]])) + [ [3 :name "Sergey"] ])) (is (= (map dvec (d/index-range db :name nil nil)) - [[1 :name "Ivan"] - [2 :name "Oleg"] - [4 :name "Pavel"] - [5 :name "Petr"] - [3 :name "Sergey"]])) + [ [1 :name "Ivan"] + [2 :name "Oleg"] + [4 :name "Pavel"] + [5 :name "Petr"] + [3 :name "Sergey"] ])) (is (= (map dvec (d/index-range db :age 15 20)) - [[1 :age 15] - [2 :age 20] - [5 :age 20]])) + [ [1 :age 15] + [2 :age 20] + [5 :age 20]])) (is (= (map dvec (d/index-range db :age 7 45)) - [[3 :age 7] - [1 :age 15] - [2 :age 20] - [5 :age 20] - [4 :age 45]])) + [ [3 :age 7] + [1 :age 15] + [2 :age 20] + [5 :age 20] + [4 :age 45] ])) (is (= (map dvec (d/index-range db :age 0 100)) - [[3 :age 7] - [1 :age 15] - [2 :age 20] - [5 :age 20] - [4 :age 45]])) + [ [3 :age 7] + [1 :age 15] + [2 :age 20] + [5 :age 20] + [4 :age 45] ])) (is (thrown-msg? "Attribute :alias should be marked as :db/index true" (d/index-range db :alias "e" "u"))))) diff --git a/test/datascript/test/issues.cljc b/test/datascript/test/issues.cljc index 04c11be0..bf32e879 100644 --- a/test/datascript/test/issues.cljc +++ b/test/datascript/test/issues.cljc @@ -1,15 +1,18 @@ (ns datascript.test.issues (:require - [datascript.core :as ds] - [clojure.test :as t :refer [is are deftest testing]])) + [datascript.core :as ds] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]))) + (deftest ^{:doc "CLJS `apply` + `vector` will hold onto mutable array of arguments directly"} issue-262 (let [db (ds/db-with (ds/empty-db) [{:attr "A"} {:attr "B"}])] (is (= (ds/q '[:find ?a ?b - :where [_ :attr ?a] - [(vector ?a) ?b]] + :where [_ :attr ?a] + [(vector ?a) ?b]] db) #{["A" ["A"]] ["B" ["B"]]})))) @@ -17,30 +20,31 @@ issue-331 (let [m {:foo :bar} db (-> (ds/empty-db) - (with-meta m) - (empty))] + (with-meta m) + (empty))] (t/is (= m (meta db))))) -#?(:clj +#?(:cljd nil + :clj (deftest ^{:doc "Can't pprint filtered db"} issue-330 (let [base (-> (ds/empty-db {:aka {:db/cardinality :db.cardinality/many}}) - (ds/db-with [{:db/id -1 - :name "Maksim" - :age 45 - :aka ["Max Otto von Stierlitz", "Jack Ryan"]}])) + (ds/db-with [{:db/id -1 + :name "Maksim" + :age 45 + :aka ["Max Otto von Stierlitz", "Jack Ryan"]}])) filtered (ds/filter base (constantly true))] (t/is (= (with-out-str (clojure.pprint/pprint base)) - (with-out-str (clojure.pprint/pprint filtered))))))) + (with-out-str (clojure.pprint/pprint filtered))))))) (deftest ^{:doc "Can't diff databases with different types of the same attribute"} issue-369 (let [db1 (-> (ds/empty-db) - (ds/db-with [[:db/add 1 :attr :aa]])) + (ds/db-with [[:db/add 1 :attr :aa]])) db2 (-> (ds/empty-db) - (ds/db-with [[:db/add 1 :attr "aa"]]))] + (ds/db-with [[:db/add 1 :attr "aa"]]))] (t/is (= [[(ds/datom 1 :attr :aa)] [(ds/datom 1 :attr "aa")] nil] - (clojure.data/diff db1 db2))))) + (clojure.data/diff db1 db2))))) (deftest ^{:doc "Expose a schema as a part of the public API."} issue-381 diff --git a/test/datascript/test/listen.cljc b/test/datascript/test/listen.cljc index 807a7a29..f203d103 100644 --- a/test/datascript/test/listen.cljc +++ b/test/datascript/test/listen.cljc @@ -1,6 +1,8 @@ (ns datascript.test.listen (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] [datascript.test.core :as tdc])) @@ -20,17 +22,18 @@ [:db/retract 4 :name "Evgeny"]]) (d/unlisten! conn :test) (d/transact! conn [[:db/add -1 :name "Geogry"]]) - + (is (= (:tx-data (first @reports)) - [(db/datom 3 :name "Dima" (+ d/tx0 2) true) - (db/datom 3 :age 19 (+ d/tx0 2) true) - (db/datom 4 :name "Evgeny" (+ d/tx0 2) true)])) + [(db/datom 3 :name "Dima" (+ d/tx0 2) true) + (db/datom 3 :age 19 (+ d/tx0 2) true) + (db/datom 4 :name "Evgeny" (+ d/tx0 2) true)])) (is (= (:tx-meta (first @reports)) - {:some-metadata 1})) + {:some-metadata 1})) (is (= (:tx-data (second @reports)) - [(db/datom 5 :name "Fedor" (+ d/tx0 3) true) - (db/datom 1 :name "Alex" (+ d/tx0 3) false) ;; update -> retract - (db/datom 1 :name "Alex2" (+ d/tx0 3) true) ;; + add - (db/datom 4 :name "Evgeny" (+ d/tx0 3) false)])) + [(db/datom 5 :name "Fedor" (+ d/tx0 3) true) + (db/datom 1 :name "Alex" (+ d/tx0 3) false) ;; update -> retract + (db/datom 1 :name "Alex2" (+ d/tx0 3) true) ;; + add + (db/datom 4 :name "Evgeny" (+ d/tx0 3) false)])) (is (= (:tx-meta (second @reports)) - nil)))) + nil)) + )) diff --git a/test/datascript/test/lookup_refs.cljc b/test/datascript/test/lookup_refs.cljc index 29480c88..b2f02455 100644 --- a/test/datascript/test/lookup_refs.cljc +++ b/test/datascript/test/lookup_refs.cljc @@ -1,103 +1,107 @@ (ns datascript.test.lookup-refs (:require - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.db :as db] - [datascript.test.core :as tdc]) - #?(:clj - (:import - [clojure.lang ExceptionInfo]))) + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + [datascript.core :as d] + [datascript.db :as db] + #?(:cljd [cljd.core :refer [ExceptionInfo]]) + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]]) + #?(:cljd nil + :clj + (:import [clojure.lang ExceptionInfo]))) (deftest test-lookup-refs - (let [db (d/db-with (d/empty-db {:name {:db/unique :db.unique/identity} - :email {:db/unique :db.unique/value}}) - [{:db/id 1 :name "Ivan" :email "@1" :age 35} - {:db/id 2 :name "Petr" :email "@2" :age 22}])] - + (let [db (d/db-with (d/empty-db {:name { :db/unique :db.unique/identity } + :email { :db/unique :db.unique/value }}) + [{:db/id 1 :name "Ivan" :email "@1" :age 35} + {:db/id 2 :name "Petr" :email "@2" :age 22}])] + (are [eid res] (= (tdc/entity-map db eid) res) [:name "Ivan"] {:db/id 1 :name "Ivan" :email "@1" :age 35} [:email "@1"] {:db/id 1 :name "Ivan" :email "@1" :age 35} [:name "Sergey"] nil [:name nil] nil) - + (are [eid msg] (thrown-msg? msg (d/entity db eid)) [:name] "Lookup ref should contain 2 elements: [:name]" [:name 1 2] "Lookup ref should contain 2 elements: [:name 1 2]" [:age 10] "Lookup ref attribute should be marked as :db/unique: [:age 10]"))) (deftest test-lookup-refs-transact - (let [db (d/db-with (d/empty-db {:name {:db/unique :db.unique/identity} - :friend {:db/valueType :db.type/ref}}) - [{:db/id 1 :name "Ivan"} - {:db/id 2 :name "Petr"}])] + (let [db (d/db-with (d/empty-db {:name { :db/unique :db.unique/identity } + :friend { :db/valueType :db.type/ref }}) + [{:db/id 1 :name "Ivan"} + {:db/id 2 :name "Petr"}])] (are [tx res] (= res (tdc/entity-map (d/db-with db tx) 1)) ;; Additions [[:db/add [:name "Ivan"] :age 35]] {:db/id 1 :name "Ivan" :age 35} - + [{:db/id [:name "Ivan"] :age 35}] {:db/id 1 :name "Ivan" :age 35} - + [[:db/add 1 :friend [:name "Petr"]]] {:db/id 1 :name "Ivan" :friend {:db/id 2}} [[:db/add 1 :friend [:name "Petr"]]] {:db/id 1 :name "Ivan" :friend {:db/id 2}} - + [{:db/id 1 :friend [:name "Petr"]}] {:db/id 1 :name "Ivan" :friend {:db/id 2}} - + [{:db/id 2 :_friend [:name "Ivan"]}] {:db/id 1 :name "Ivan" :friend {:db/id 2}} - + ;; lookup refs are resolved at intermediate DB value [[:db/add 3 :name "Oleg"] [:db/add 1 :friend [:name "Oleg"]]] {:db/id 1 :name "Ivan" :friend {:db/id 3}} - + ;; CAS [[:db.fn/cas [:name "Ivan"] :name "Ivan" "Oleg"]] {:db/id 1 :name "Oleg"} - + [[:db/add 1 :friend 1] [:db.fn/cas 1 :friend [:name "Ivan"] 2]] {:db/id 1 :name "Ivan" :friend {:db/id 2}} - + [[:db/add 1 :friend 1] [:db.fn/cas 1 :friend 1 [:name "Petr"]]] {:db/id 1 :name "Ivan" :friend {:db/id 2}} - + ;; Retractions [[:db/add 1 :age 35] [:db/retract [:name "Ivan"] :age 35]] {:db/id 1 :name "Ivan"} - + [[:db/add 1 :friend 2] [:db/retract 1 :friend [:name "Petr"]]] {:db/id 1 :name "Ivan"} - + [[:db/add 1 :age 35] [:db.fn/retractAttribute [:name "Ivan"] :age]] {:db/id 1 :name "Ivan"} - + [[:db.fn/retractEntity [:name "Ivan"]]] nil) - + (are [tx msg] (thrown-msg? msg (d/db-with db tx)) [{:db/id [:name "Oleg"], :age 10}] "Nothing found for entity id [:name \"Oleg\"]" - + [[:db/add [:name "Oleg"] :age 10]] - "Nothing found for entity id [:name \"Oleg\"]"))) + "Nothing found for entity id [:name \"Oleg\"]") + )) (deftest test-lookup-refs-transact-multi - (let [db (d/db-with (d/empty-db {:name {:db/unique :db.unique/identity} - :friends {:db/valueType :db.type/ref - :db/cardinality :db.cardinality/many}}) - [{:db/id 1 :name "Ivan"} - {:db/id 2 :name "Petr"} - {:db/id 3 :name "Oleg"} - {:db/id 4 :name "Sergey"}])] + (let [db (d/db-with (d/empty-db {:name { :db/unique :db.unique/identity } + :friends { :db/valueType :db.type/ref + :db/cardinality :db.cardinality/many }}) + [{:db/id 1 :name "Ivan"} + {:db/id 2 :name "Petr"} + {:db/id 3 :name "Oleg"} + {:db/id 4 :name "Sergey"}])] (are [tx res] (= (tdc/entity-map (d/db-with db tx) 1) res) ;; Additions [[:db/add 1 :friends [:name "Petr"]]] @@ -106,13 +110,13 @@ [[:db/add 1 :friends [:name "Petr"]] [:db/add 1 :friends [:name "Oleg"]]] {:db/id 1 :name "Ivan" :friends #{{:db/id 2} {:db/id 3}}} - + [{:db/id 1 :friends [:name "Petr"]}] {:db/id 1 :name "Ivan" :friends #{{:db/id 2}}} [{:db/id 1 :friends [[:name "Petr"]]}] {:db/id 1 :name "Ivan" :friends #{{:db/id 2}}} - + [{:db/id 1 :friends [[:name "Petr"] [:name "Oleg"]]}] {:db/id 1 :name "Ivan" :friends #{{:db/id 2} {:db/id 3}}} @@ -121,7 +125,7 @@ [{:db/id 1 :friends [[:name "Petr"] 3]}] {:db/id 1 :name "Ivan" :friends #{{:db/id 2} {:db/id 3}}} - + ;; reverse refs [{:db/id 2 :_friends [:name "Ivan"]}] {:db/id 1 :name "Ivan" :friends #{{:db/id 2}}} @@ -130,137 +134,142 @@ {:db/id 1 :name "Ivan" :friends #{{:db/id 2}}} [{:db/id 2 :_friends [[:name "Ivan"] [:name "Oleg"]]}] - {:db/id 1 :name "Ivan" :friends #{{:db/id 2}}}))) + {:db/id 1 :name "Ivan" :friends #{{:db/id 2}}} + ))) (deftest lookup-refs-index-access - (let [db (d/db-with (d/empty-db {:name {:db/unique :db.unique/identity} - :friends {:db/valueType :db.type/ref - :db/cardinality :db.cardinality/many}}) - [{:db/id 1 :name "Ivan" :friends [2 3]} - {:db/id 2 :name "Petr" :friends 3} - {:db/id 3 :name "Oleg"}])] - (are [index attrs datoms] (= (map (juxt :e :a :v) (apply d/datoms db index attrs)) datoms) - :eavt [[:name "Ivan"]] - [[1 :friends 2] [1 :friends 3] [1 :name "Ivan"]] - - :eavt [[:name "Ivan"] :friends] - [[1 :friends 2] [1 :friends 3]] - - :eavt [[:name "Ivan"] :friends [:name "Petr"]] - [[1 :friends 2]] - - :aevt [:friends [:name "Ivan"]] - [[1 :friends 2] [1 :friends 3]] - - :aevt [:friends [:name "Ivan"] [:name "Petr"]] - [[1 :friends 2]] - - :avet [:friends [:name "Oleg"]] - [[1 :friends 3] [2 :friends 3]] - - :avet [:friends [:name "Oleg"] [:name "Ivan"]] - [[1 :friends 3]]) - - (are [index attrs resolved-attrs] (= (vec (apply d/seek-datoms db index attrs)) - (vec (apply d/seek-datoms db index resolved-attrs))) - :eavt [[:name "Ivan"]] [1] - :eavt [[:name "Ivan"] :name] [1 :name] - :eavt [[:name "Ivan"] :friends [:name "Oleg"]] [1 :friends 3] - - :aevt [:friends [:name "Petr"]] [:friends 2] - :aevt [:friends [:name "Ivan"] [:name "Oleg"]] [:friends 1 3] - - :avet [:friends [:name "Oleg"]] [:friends 3] - :avet [:friends [:name "Oleg"] [:name "Petr"]] [:friends 3 2]) - + (let [db (d/db-with (d/empty-db {:name { :db/unique :db.unique/identity } + :friends { :db/valueType :db.type/ref + :db/cardinality :db.cardinality/many}}) + [{:db/id 1 :name "Ivan" :friends [2 3]} + {:db/id 2 :name "Petr" :friends 3} + {:db/id 3 :name "Oleg"}])] + (are [index attrs datoms] (= (map (juxt :e :a :v) (apply d/datoms db index attrs)) datoms) + :eavt [[:name "Ivan"]] + [[1 :friends 2] [1 :friends 3] [1 :name "Ivan"]] + + :eavt [[:name "Ivan"] :friends] + [[1 :friends 2] [1 :friends 3]] + + :eavt [[:name "Ivan"] :friends [:name "Petr"]] + [[1 :friends 2]] + + :aevt [:friends [:name "Ivan"]] + [[1 :friends 2] [1 :friends 3]] + + :aevt [:friends [:name "Ivan"] [:name "Petr"]] + [[1 :friends 2]] + + :avet [:friends [:name "Oleg"]] + [[1 :friends 3] [2 :friends 3]] + + :avet [:friends [:name "Oleg"] [:name "Ivan"]] + [[1 :friends 3]]) + + (are [index attrs resolved-attrs] (= (vec (apply d/seek-datoms db index attrs)) + (vec (apply d/seek-datoms db index resolved-attrs))) + :eavt [[:name "Ivan"]] [1] + :eavt [[:name "Ivan"] :name] [1 :name] + :eavt [[:name "Ivan"] :friends [:name "Oleg"]] [1 :friends 3] + + :aevt [:friends [:name "Petr"]] [:friends 2] + :aevt [:friends [:name "Ivan"] [:name "Oleg"]] [:friends 1 3] + + :avet [:friends [:name "Oleg"]] [:friends 3] + :avet [:friends [:name "Oleg"] [:name "Petr"]] [:friends 3 2] + ) + (are [attr start end datoms] (= (map (juxt :e :a :v) (d/index-range db attr start end)) datoms) - :friends [:name "Oleg"] [:name "Oleg"] - [[1 :friends 3] [2 :friends 3]] - - :friends [:name "Petr"] [:name "Petr"] - [[1 :friends 2]] - - :friends [:name "Petr"] [:name "Oleg"] - [[1 :friends 2] [1 :friends 3] [2 :friends 3]]))) + :friends [:name "Oleg"] [:name "Oleg"] + [[1 :friends 3] [2 :friends 3]] + + :friends [:name "Petr"] [:name "Petr"] + [[1 :friends 2]] + + :friends [:name "Petr"] [:name "Oleg"] + [[1 :friends 2] [1 :friends 3] [2 :friends 3]]) +)) (deftest test-lookup-refs-query - (let [schema {:name {:db/unique :db.unique/identity} - :friend {:db/valueType :db.type/ref}} + (let [schema {:name { :db/unique :db.unique/identity } + :friend { :db/valueType :db.type/ref }} db (d/db-with (d/empty-db schema) - [{:db/id 1 :id 1 :name "Ivan" :age 11 :friend 2} - {:db/id 2 :id 2 :name "Petr" :age 22 :friend 3} - {:db/id 3 :id 3 :name "Oleg" :age 33}])] + [{:db/id 1 :id 1 :name "Ivan" :age 11 :friend 2} + {:db/id 2 :id 2 :name "Petr" :age 22 :friend 3} + {:db/id 3 :id 3 :name "Oleg" :age 33 }])] (is (= (set (d/q '[:find ?e ?v :in $ ?e :where [?e :age ?v]] - db [:name "Ivan"])) - #{[[:name "Ivan"] 11]})) - + db [:name "Ivan"])) + #{[[:name "Ivan"] 11]})) + (is (= (set (d/q '[:find [?v ...] :in $ [?e ...] :where [?e :age ?v]] - db [[:name "Ivan"] [:name "Petr"]])) - #{11 22})) - + db [[:name "Ivan"] [:name "Petr"]])) + #{11 22})) + (is (= (set (d/q '[:find [?e ...] :in $ ?v :where [?e :friend ?v]] - db [:name "Petr"])) - #{1})) - + db [:name "Petr"])) + #{1})) + (is (= (set (d/q '[:find [?e ...] :in $ [?v ...] :where [?e :friend ?v]] - db [[:name "Petr"] [:name "Oleg"]])) - #{1 2})) - + db [[:name "Petr"] [:name "Oleg"]])) + #{1 2})) + (is (= (d/q '[:find ?e ?v :in $ ?e ?v :where [?e :friend ?v]] - db [:name "Ivan"] [:name "Petr"]) - #{[[:name "Ivan"] [:name "Petr"]]})) - + db [:name "Ivan"] [:name "Petr"]) + #{[[:name "Ivan"] [:name "Petr"]]})) + (is (= (d/q '[:find ?e ?v :in $ [?e ...] [?v ...] :where [?e :friend ?v]] - db [[:name "Ivan"] [:name "Petr"] [:name "Oleg"]] - [[:name "Ivan"] [:name "Petr"] [:name "Oleg"]]) - #{[[:name "Ivan"] [:name "Petr"]] - [[:name "Petr"] [:name "Oleg"]]})) + db [[:name "Ivan"] [:name "Petr"] [:name "Oleg"]] + [[:name "Ivan"] [:name "Petr"] [:name "Oleg"]]) + #{[[:name "Ivan"] [:name "Petr"]] + [[:name "Petr"] [:name "Oleg"]]})) - ;; issue-214 + ;; https://github.com/tonsky/datascript/issues/214 (is (= (d/q '[:find ?e :in $ [?e ...] :where [?e :friend 3]] - db [1 2 3 "A"]) - #{[2]})) - + db [1 2 3 "A"]) + #{[2]})) + (let [db2 (d/db-with (d/empty-db schema) [{:db/id 3 :name "Ivan" :id 3} {:db/id 1 :name "Petr" :id 1} {:db/id 2 :name "Oleg" :id 2}])] (is (= (d/q '[:find ?e ?e1 ?e2 :in $1 $2 [?e ...] - :where - [$1 ?e :id ?e1] - [$2 ?e :id ?e2]] - db db2 [[:name "Ivan"] [:name "Petr"] [:name "Oleg"]]) - #{[[:name "Ivan"] 1 3] - [[:name "Petr"] 2 1] - [[:name "Oleg"] 3 2]}))) - + :where [$1 ?e :id ?e1] + [$2 ?e :id ?e2]] + db db2 [[:name "Ivan"] [:name "Petr"] [:name "Oleg"]]) + #{[[:name "Ivan"] 1 3] + [[:name "Petr"] 2 1] + [[:name "Oleg"] 3 2]}))) + (testing "inline refs" (is (= (d/q '[:find ?v :where [[:name "Ivan"] :friend ?v]] - db) - #{[2]})) - + db) + #{[2]})) + (is (= (d/q '[:find ?e :where [?e :friend [:name "Petr"]]] - db) - #{[1]})) - + db) + #{[1]})) + (is (thrown-msg? "Nothing found for entity id [:name \"Valery\"]" (d/q '[:find ?e :where [[:name "Valery"] :friend ?e]] - db)))))) + db))) + + ) +)) diff --git a/test/datascript/test/lru.cljc b/test/datascript/test/lru.cljc index 6f4e0163..416fb7d5 100644 --- a/test/datascript/test/lru.cljc +++ b/test/datascript/test/lru.cljc @@ -1,6 +1,8 @@ (ns datascript.test.lru (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.lru :as lru])) (deftest test-lru diff --git a/test/datascript/test/parser.cljc b/test/datascript/test/parser.cljc index d7455edf..26868808 100644 --- a/test/datascript/test/parser.cljc +++ b/test/datascript/test/parser.cljc @@ -1,54 +1,58 @@ (ns datascript.test.parser (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] [datascript.parser :as dp] [datascript.test.core :as tdc]) - #?(:clj - (:import - [clojure.lang ExceptionInfo]))) + #?(:cljd (:require [cljd.core :refer [ExceptionInfo]]) + :clj + (:import [clojure.lang ExceptionInfo]))) + + (deftest bindings (are [form res] (= (dp/parse-binding form) res) '?x (dp/->BindScalar (dp/->Variable '?x)) - + '_ (dp/->BindIgnore) - + '[?x ...] (dp/->BindColl (dp/->BindScalar (dp/->Variable '?x))) - + '[?x] (dp/->BindTuple [(dp/->BindScalar (dp/->Variable '?x))]) - + '[?x ?y] (dp/->BindTuple [(dp/->BindScalar (dp/->Variable '?x)) (dp/->BindScalar (dp/->Variable '?y))]) - + '[_ ?y] (dp/->BindTuple [(dp/->BindIgnore) (dp/->BindScalar (dp/->Variable '?y))]) - + '[[_ [?x ...]] ...] (dp/->BindColl (dp/->BindTuple [(dp/->BindIgnore) - (dp/->BindColl - (dp/->BindScalar (dp/->Variable '?x)))])) - + (dp/->BindColl + (dp/->BindScalar (dp/->Variable '?x)))])) + '[[?a ?b ?c]] (dp/->BindColl (dp/->BindTuple [(dp/->BindScalar (dp/->Variable '?a)) - (dp/->BindScalar (dp/->Variable '?b)) - (dp/->BindScalar (dp/->Variable '?c))]))) - - (is (thrown-with-msg? ExceptionInfo #"Cannot parse binding" - (dp/parse-binding :key)))) + (dp/->BindScalar (dp/->Variable '?b)) + (dp/->BindScalar (dp/->Variable '?c))]))) + + (is (thrown-with-msg? ExceptionInfo #"Cannot parse binding" + (dp/parse-binding :key)))) (deftest in (are [form res] (= (dp/parse-in form) res) '[?x] [(dp/->BindScalar (dp/->Variable '?x))] - + '[$ $1 % _ ?x] [(dp/->BindScalar (dp/->SrcVar '$)) (dp/->BindScalar (dp/->SrcVar '$1)) @@ -60,15 +64,15 @@ [(dp/->BindScalar (dp/->SrcVar '$)) (dp/->BindColl (dp/->BindTuple [(dp/->BindIgnore) - (dp/->BindColl - (dp/->BindScalar (dp/->Variable '?x)))]))]) - + (dp/->BindColl + (dp/->BindScalar (dp/->Variable '?x)))]))]) + (is (thrown-with-msg? ExceptionInfo #"Cannot parse binding" (dp/parse-in ['?x :key])))) (deftest with (is (= (dp/parse-with '[?x ?y]) - [(dp/->Variable '?x) (dp/->Variable '?y)])) - + [(dp/->Variable '?x) (dp/->Variable '?y)])) + (is (thrown-with-msg? ExceptionInfo #"Cannot parse :with clause" (dp/parse-with '[?x _])))) diff --git a/test/datascript/test/parser_find.cljc b/test/datascript/test/parser_find.cljc index bce2989d..fb93f9a5 100644 --- a/test/datascript/test/parser_find.cljc +++ b/test/datascript/test/parser_find.cljc @@ -1,50 +1,53 @@ (ns datascript.test.parser-find (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] [datascript.parser :as dp] [datascript.test.core :as tdc])) #?(:cljs - (def Throwable - js/Error)) + (def Throwable js/Error)) (deftest test-parse-find (is (= (dp/parse-find '[?a ?b]) - (dp/->FindRel [(dp/->Variable '?a) (dp/->Variable '?b)]))) + (dp/->FindRel [(dp/->Variable '?a) (dp/->Variable '?b)]))) (is (= (dp/parse-find '[[?a ...]]) - (dp/->FindColl (dp/->Variable '?a)))) + (dp/->FindColl (dp/->Variable '?a)))) (is (= (dp/parse-find '[?a .]) - (dp/->FindScalar (dp/->Variable '?a)))) + (dp/->FindScalar (dp/->Variable '?a)))) (is (= (dp/parse-find '[[?a ?b]]) - (dp/->FindTuple [(dp/->Variable '?a) (dp/->Variable '?b)])))) + (dp/->FindTuple [(dp/->Variable '?a) (dp/->Variable '?b)])))) (deftest test-parse-aggregate (is (= (dp/parse-find '[?a (count ?b)]) - (dp/->FindRel [(dp/->Variable '?a) (dp/->Aggregate (dp/->PlainSymbol 'count) [(dp/->Variable '?b)])]))) + (dp/->FindRel [(dp/->Variable '?a) (dp/->Aggregate (dp/->PlainSymbol 'count) [(dp/->Variable '?b)])]))) (is (= (dp/parse-find '[[(count ?a) ...]]) - (dp/->FindColl (dp/->Aggregate (dp/->PlainSymbol 'count) [(dp/->Variable '?a)])))) + (dp/->FindColl (dp/->Aggregate (dp/->PlainSymbol 'count) [(dp/->Variable '?a)])))) (is (= (dp/parse-find '[(count ?a) .]) - (dp/->FindScalar (dp/->Aggregate (dp/->PlainSymbol 'count) [(dp/->Variable '?a)])))) + (dp/->FindScalar (dp/->Aggregate (dp/->PlainSymbol 'count) [(dp/->Variable '?a)])))) (is (= (dp/parse-find '[[(count ?a) ?b]]) - (dp/->FindTuple [(dp/->Aggregate (dp/->PlainSymbol 'count) [(dp/->Variable '?a)]) (dp/->Variable '?b)])))) + (dp/->FindTuple [(dp/->Aggregate (dp/->PlainSymbol 'count) [(dp/->Variable '?a)]) (dp/->Variable '?b)])))) (deftest test-parse-custom-aggregates (is (= (dp/parse-find '[(aggregate ?f ?a)]) - (dp/->FindRel [(dp/->Aggregate (dp/->Variable '?f) [(dp/->Variable '?a)])]))) + (dp/->FindRel [(dp/->Aggregate (dp/->Variable '?f) [(dp/->Variable '?a)])]))) (is (= (dp/parse-find '[?a (aggregate ?f ?b)]) - (dp/->FindRel [(dp/->Variable '?a) (dp/->Aggregate (dp/->Variable '?f) [(dp/->Variable '?b)])]))) + (dp/->FindRel [(dp/->Variable '?a) (dp/->Aggregate (dp/->Variable '?f) [(dp/->Variable '?b)])]))) (is (= (dp/parse-find '[[(aggregate ?f ?a) ...]]) - (dp/->FindColl (dp/->Aggregate (dp/->Variable '?f) [(dp/->Variable '?a)])))) + (dp/->FindColl (dp/->Aggregate (dp/->Variable '?f) [(dp/->Variable '?a)])))) (is (= (dp/parse-find '[(aggregate ?f ?a) .]) - (dp/->FindScalar (dp/->Aggregate (dp/->Variable '?f) [(dp/->Variable '?a)])))) + (dp/->FindScalar (dp/->Aggregate (dp/->Variable '?f) [(dp/->Variable '?a)])))) (is (= (dp/parse-find '[[(aggregate ?f ?a) ?b]]) - (dp/->FindTuple [(dp/->Aggregate (dp/->Variable '?f) [(dp/->Variable '?a)]) (dp/->Variable '?b)])))) + (dp/->FindTuple [(dp/->Aggregate (dp/->Variable '?f) [(dp/->Variable '?a)]) (dp/->Variable '?b)])))) (deftest test-parse-find-elements (is (= (dp/parse-find '[(count ?b 1 $x) .]) - (dp/->FindScalar (dp/->Aggregate (dp/->PlainSymbol 'count) - [(dp/->Variable '?b) - (dp/->Constant 1) - (dp/->SrcVar '$x)]))))) + (dp/->FindScalar (dp/->Aggregate (dp/->PlainSymbol 'count) + [(dp/->Variable '?b) + (dp/->Constant 1) + (dp/->SrcVar '$x)]))))) + +#_(t/test-ns 'datascript.test.find-parser) diff --git a/test/datascript/test/parser_query.cljc b/test/datascript/test/parser_query.cljc index 168d3a92..01403798 100644 --- a/test/datascript/test/parser_query.cljc +++ b/test/datascript/test/parser_query.cljc @@ -1,13 +1,17 @@ (ns datascript.test.parser-query (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] [datascript.parser :as dp] - [datascript.test.core :as tdc]) - #?(:clj - (:import - [clojure.lang ExceptionInfo]))) + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]]) + #?(:cljd (:require [cljd.core :refer [ExceptionInfo]]) + :clj + (:import [clojure.lang ExceptionInfo]))) + + (deftest validation (are [q msg] (thrown-msg? msg (dp/parse-query q)) @@ -16,30 +20,31 @@ '[:find ?e :with ?f :where [?e]] "Query for unknown vars: [?f]" - + '[:find ?e ?x ?t :in ?x :where [?e]] "Query for unknown vars: [?t]" - + '[:find ?x ?e :with ?y ?e :where [?x ?e ?y]] ":find and :with should not use same variables: [?e]" - + '[:find ?e :in $ $ ?x :where [?e]] "Vars used in :in should be distinct" - + '[:find ?e :in ?x $ ?x :where [?e]] "Vars used in :in should be distinct" '[:find ?e :in $ % ?x % :where [?e]] "Vars used in :in should be distinct" - + '[:find ?n :with ?e ?f ?e :where [?e ?f ?n]] "Vars used in :with should be distinct" - + '[:find ?x :where [$1 ?x]] "Where uses unknown source vars: [$1]" - + '[:find ?x :in $1 :where [$2 ?x]] "Where uses unknown source vars: [$2]" - + '[:find ?e :where (rule ?e)] - "Missing rules var '%' in :in")) + "Missing rules var '%' in :in" + )) diff --git a/test/datascript/test/parser_return_map.cljc b/test/datascript/test/parser_return_map.cljc index 0e3ad285..815f43d9 100644 --- a/test/datascript/test/parser_return_map.cljc +++ b/test/datascript/test/parser_return_map.cljc @@ -1,14 +1,15 @@ (ns datascript.test.parser-return-map (:require - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.parser :as dp] - [datascript.db :as db] - [datascript.test.core :as tdc])) + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] + [datascript.parser :as dp] + [datascript.db :as db] + #?(:cljd [cljd.core :refer [ExceptionInfo]]) + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]])) #?(:cljs - (def Throwable - js/Error)) + (def Throwable js/Error)) (deftest test-parse-return-map (is (= (:qreturn-map (dp/parse-query '[:find ?a ?b :keys x y :where [?a ?b]])) @@ -20,6 +21,7 @@ (is (= (:qreturn-map (dp/parse-query '[:find ?a ?b ?c :strs x y z :where [?a ?b ?c]])) (dp/->ReturnMap :strs ["x" "y" "z"]))) + (testing "with find specs" (is (= (:qreturn-map (dp/parse-query '[:find [?a ?b] :keys x y :where [?a ?b]])) (dp/->ReturnMap :keys [:x :y]))) @@ -30,6 +32,7 @@ (is (thrown-msg? ":keys does not work with single-scalar :find" (dp/parse-query '[:find ?a . :keys x y :where [?a]])))) + (testing "errors" (is (thrown-msg? "Only one of :keys/:syms/:strs must be present" (dp/parse-query '[:find ?a ?b :keys x y :strs zt :where [?a ?b]]))) @@ -44,4 +47,5 @@ (dp/parse-query '[:find ?a ?b :strs x :where [?a ?b]]))) (is (thrown-msg? "Count of :keys must match count of :find" - (dp/parse-query '[:find [?a ?b] :keys x :where [?a ?b]]))))) + (dp/parse-query '[:find [?a ?b] :keys x :where [?a ?b]])))) +) diff --git a/test/datascript/test/parser_rules.cljc b/test/datascript/test/parser_rules.cljc index a6c40a1f..e2efb10f 100644 --- a/test/datascript/test/parser_rules.cljc +++ b/test/datascript/test/parser_rules.cljc @@ -1,13 +1,15 @@ (ns datascript.test.parser-rules (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] [datascript.parser :as dp] [datascript.test.core :as tdc]) - #?(:clj - (:import - [clojure.lang ExceptionInfo]))) + #?(:cljd (:require [cljd.core :refer [ExceptionInfo]]) + :clj + (:import [clojure.lang ExceptionInfo]))) (deftest clauses (are [form res] (= (set (dp/parse-rules form)) res) @@ -15,51 +17,52 @@ [?x :name _]]] #{(dp/->Rule (dp/->PlainSymbol 'rule) - [(dp/->RuleBranch - (dp/->RuleVars nil [(dp/->Variable '?x)]) - [(dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?x) (dp/->Constant :name) (dp/->Placeholder)])])])})) + [ (dp/->RuleBranch + (dp/->RuleVars nil [(dp/->Variable '?x)]) + [(dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?x) (dp/->Constant :name) (dp/->Placeholder)])]) ])})) (deftest rule-vars - (are [form res] (= (set (dp/parse-rules form)) res) + (are [form res] (= (set (dp/parse-rules form)) res) '[[(rule [?x] ?y) [_]]] #{(dp/->Rule (dp/->PlainSymbol 'rule) - [(dp/->RuleBranch - (dp/->RuleVars [(dp/->Variable '?x)] [(dp/->Variable '?y)]) - [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Placeholder)])])])} - + [ (dp/->RuleBranch + (dp/->RuleVars [(dp/->Variable '?x)] [(dp/->Variable '?y)]) + [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Placeholder)])]) ])} + '[[(rule [?x ?y] ?a ?b) [_]]] #{(dp/->Rule (dp/->PlainSymbol 'rule) - - [(dp/->RuleBranch + + [ (dp/->RuleBranch (dp/->RuleVars [(dp/->Variable '?x) (dp/->Variable '?y)] - [(dp/->Variable '?a) (dp/->Variable '?b)]) - [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Placeholder)])])])} - + [(dp/->Variable '?a) (dp/->Variable '?b)]) + [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Placeholder)])]) ])} + '[[(rule [?x]) [_]]] #{(dp/->Rule (dp/->PlainSymbol 'rule) - [(dp/->RuleBranch - (dp/->RuleVars [(dp/->Variable '?x)] nil) - [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Placeholder)])])])}) + [ (dp/->RuleBranch + (dp/->RuleVars [(dp/->Variable '?x)] nil) + [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Placeholder)])]) ])}) (is (thrown-with-msg? ExceptionInfo #"Cannot parse rule-vars" (dp/parse-rules '[[(rule) [_]]]))) (is (thrown-with-msg? ExceptionInfo #"Cannot parse rule-vars" - (dp/parse-rules '[[(rule []) [_]]]))) + (dp/parse-rules '[[(rule []) [_]]]))) (is (thrown-with-msg? ExceptionInfo #"Rule variables should be distinct" (dp/parse-rules '[[(rule ?x ?y ?x) [_]]]))) - + (is (thrown-with-msg? ExceptionInfo #"Rule variables should be distinct" - (dp/parse-rules '[[(rule [?x ?y] ?z ?x) [_]]])))) + (dp/parse-rules '[[(rule [?x ?y] ?z ?x) [_]]]))) +) (deftest branches (are [form res] (= (set (dp/parse-rules form)) res) @@ -70,14 +73,14 @@ [:c]]] #{(dp/->Rule (dp/->PlainSymbol 'rule) - [(dp/->RuleBranch - (dp/->RuleVars nil [(dp/->Variable '?x)]) - [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Constant :a)]) - (dp/->Pattern (dp/->DefaultSrc) [(dp/->Constant :b)])]) - (dp/->RuleBranch - (dp/->RuleVars nil [(dp/->Variable '?x)]) - [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Constant :c)])])])} - + [ (dp/->RuleBranch + (dp/->RuleVars nil [(dp/->Variable '?x)]) + [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Constant :a)]) + (dp/->Pattern (dp/->DefaultSrc) [(dp/->Constant :b)])]) + (dp/->RuleBranch + (dp/->RuleVars nil [(dp/->Variable '?x)]) + [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Constant :c)])]) ])} + '[[(rule ?x) [:a] [:b]] @@ -85,23 +88,25 @@ [:c]]] #{(dp/->Rule (dp/->PlainSymbol 'rule) - [(dp/->RuleBranch - (dp/->RuleVars nil [(dp/->Variable '?x)]) - [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Constant :a)]) - (dp/->Pattern (dp/->DefaultSrc) [(dp/->Constant :b)])])]) + [ (dp/->RuleBranch + (dp/->RuleVars nil [(dp/->Variable '?x)]) + [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Constant :a)]) + (dp/->Pattern (dp/->DefaultSrc) [(dp/->Constant :b)])]) ]) (dp/->Rule (dp/->PlainSymbol 'other) - [(dp/->RuleBranch - (dp/->RuleVars nil [(dp/->Variable '?x)]) - [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Constant :c)])])])}) - + [ (dp/->RuleBranch + (dp/->RuleVars nil [(dp/->Variable '?x)]) + [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Constant :c)])]) ])} + ) + (is (thrown-with-msg? ExceptionInfo #"Rule branch should have clauses" (dp/parse-rules '[[(rule ?x)]]))) - + (is (thrown-with-msg? ExceptionInfo #"Arity mismatch" (dp/parse-rules '[[(rule ?x) [_]] - [(rule ?x ?y) [_]]]))) - + [(rule ?x ?y) [_]]]))) + (is (thrown-with-msg? ExceptionInfo #"Arity mismatch" (dp/parse-rules '[[(rule ?x) [_]] - [(rule [?x]) [_]]])))) + [(rule [?x]) [_]]]))) +) diff --git a/test/datascript/test/parser_where.cljc b/test/datascript/test/parser_where.cljc index 3e64723c..f6e6a3c5 100644 --- a/test/datascript/test/parser_where.cljc +++ b/test/datascript/test/parser_where.cljc @@ -1,25 +1,27 @@ (ns datascript.test.parser-where (:require - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.db :as db] - [datascript.parser :as dp] - [datascript.test.core :as tdc]) - #?(:clj - (:import - [clojure.lang ExceptionInfo]))) + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + [datascript.core :as d] + [datascript.db :as db] + [datascript.parser :as dp] + [datascript.test.core :as tdc]) + #?(:cljd (:require [cljd.core :refer [ExceptionInfo]]) + :clj + (:import [clojure.lang ExceptionInfo]))) (deftest pattern (are [clause pattern] (= (dp/parse-clause clause) pattern) '[?e ?a ?v] (dp/->Pattern (dp/->DefaultSrc) [(dp/->Variable '?e) (dp/->Variable '?a) (dp/->Variable '?v)]) - + '[_ ?a _ _] (dp/->Pattern (dp/->DefaultSrc) [(dp/->Placeholder) (dp/->Variable '?a) (dp/->Placeholder) (dp/->Placeholder)]) - + '[$x _ ?a _ _] (dp/->Pattern (dp/->SrcVar '$x) [(dp/->Placeholder) (dp/->Variable '?a) (dp/->Placeholder) (dp/->Placeholder)]) - + '[$x _ :name ?v] (dp/->Pattern (dp/->SrcVar '$x) [(dp/->Placeholder) (dp/->Constant :name) (dp/->Variable '?v)]) @@ -29,45 +31,50 @@ '[$x _ $src-sym ?v] (dp/->Pattern (dp/->SrcVar '$x) [(dp/->Placeholder) (dp/->Constant '$src-sym) (dp/->Variable '?v)])) - (is (thrown-with-msg? ExceptionInfo #"Pattern could not be empty" - (dp/parse-clause '[])))) + (is (thrown-with-msg? ExceptionInfo #"Pattern could not be empty" + (dp/parse-clause '[]))) +) (deftest test-pred (are [clause res] (= (dp/parse-clause clause) res) '[(pred ?a 1)] (dp/->Predicate (dp/->PlainSymbol 'pred) [(dp/->Variable '?a) (dp/->Constant 1)]) - + '[(pred)] (dp/->Predicate (dp/->PlainSymbol 'pred) []) - + '[(?custom-pred ?a)] - (dp/->Predicate (dp/->Variable '?custom-pred) [(dp/->Variable '?a)]))) + (dp/->Predicate (dp/->Variable '?custom-pred) [(dp/->Variable '?a)]) +)) + +(def ->Fn + #?(:cljd dp/->FunctionCall :default dp/->FunctionCall)) (deftest test-fn (are [clause res] (= (dp/parse-clause clause) res) '[(fn ?a 1) ?x] - (dp/->Function (dp/->PlainSymbol 'fn) [(dp/->Variable '?a) (dp/->Constant 1)] (dp/->BindScalar (dp/->Variable '?x))) - + (->Fn (dp/->PlainSymbol 'fn) [(dp/->Variable '?a) (dp/->Constant 1)] (dp/->BindScalar (dp/->Variable '?x))) + '[(fn) ?x] - (dp/->Function (dp/->PlainSymbol 'fn) [] (dp/->BindScalar (dp/->Variable '?x))) - + (->Fn (dp/->PlainSymbol 'fn) [] (dp/->BindScalar (dp/->Variable '?x))) + '[(?custom-fn) ?x] - (dp/->Function (dp/->Variable '?custom-fn) [] (dp/->BindScalar (dp/->Variable '?x))) + (->Fn (dp/->Variable '?custom-fn) [] (dp/->BindScalar (dp/->Variable '?x))) '[(?custom-fn ?arg) ?x] - (dp/->Function (dp/->Variable '?custom-fn) [(dp/->Variable '?arg)] (dp/->BindScalar (dp/->Variable '?x))))) + (->Fn (dp/->Variable '?custom-fn) [(dp/->Variable '?arg)] (dp/->BindScalar (dp/->Variable '?x))))) (deftest rule-expr (are [clause res] (= (dp/parse-clause clause) res) '(friends ?x ?y) (dp/->RuleExpr (dp/->DefaultSrc) (dp/->PlainSymbol 'friends) [(dp/->Variable '?x) (dp/->Variable '?y)]) - + '(friends "Ivan" _) (dp/->RuleExpr (dp/->DefaultSrc) (dp/->PlainSymbol 'friends) [(dp/->Constant "Ivan") (dp/->Placeholder)]) '($1 friends ?x ?y) (dp/->RuleExpr (dp/->SrcVar '$1) (dp/->PlainSymbol 'friends) [(dp/->Variable '?x) (dp/->Variable '?y)]) - + '(friends something) (dp/->RuleExpr (dp/->DefaultSrc) (dp/->PlainSymbol 'friends) [(dp/->Constant 'something)])) @@ -80,9 +87,9 @@ (dp/->Not (dp/->DefaultSrc) [(dp/->Variable '?e) (dp/->Variable '?x)] - [(dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)])]) + [ (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) ]) '(not [?e :follows ?x] @@ -90,51 +97,53 @@ (dp/->Not (dp/->DefaultSrc) [(dp/->Variable '?e) (dp/->Variable '?x) (dp/->Variable '?y)] - [(dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) - (dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?x) (dp/->Placeholder) (dp/->Variable '?y)])]) - + [ (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) + (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?x) (dp/->Placeholder) (dp/->Variable '?y)])]) + '($1 not [?x]) (dp/->Not (dp/->SrcVar '$1) [(dp/->Variable '?x)] - [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Variable '?x)])]) - + [ (dp/->Pattern (dp/->DefaultSrc) [(dp/->Variable '?x)]) ]) + '(not-join [?e ?y] [?e :follows ?x] [?x _ ?y]) (dp/->Not (dp/->DefaultSrc) [(dp/->Variable '?e) (dp/->Variable '?y)] - [(dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) - (dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?x) (dp/->Placeholder) (dp/->Variable '?y)])]) - + [ (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) + (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?x) (dp/->Placeholder) (dp/->Variable '?y)])]) + '($1 not-join [?e] [?e :follows ?x]) (dp/->Not (dp/->SrcVar '$1) [(dp/->Variable '?e)] - [(dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)])])) - + [ (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) ]) + ) + (is (thrown-with-msg? ExceptionInfo #"Join variables should not be empty" (dp/parse-clause '(not-join [] [?y])))) - + (is (thrown-with-msg? ExceptionInfo #"Join variables should not be empty" (dp/parse-clause '(not [_])))) - + (is (thrown-with-msg? ExceptionInfo #"Cannot parse 'not-join' clause" (dp/parse-clause '(not-join [?x])))) - + (is (thrown-with-msg? ExceptionInfo #"Cannot parse 'not' clause" - (dp/parse-clause '(not))))) + (dp/parse-clause '(not)))) +) (deftest or-clause (are [clause res] (= (dp/parse-clause clause) res) @@ -142,9 +151,9 @@ (dp/->Or (dp/->DefaultSrc) (dp/->RuleVars nil [(dp/->Variable '?e) (dp/->Variable '?x)]) - [(dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)])]) + [ (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) ]) '(or [?e :follows ?x] @@ -152,13 +161,13 @@ (dp/->Or (dp/->DefaultSrc) (dp/->RuleVars nil [(dp/->Variable '?e) (dp/->Variable '?x)]) - [(dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) - (dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :friend) (dp/->Variable '?x)])]) - + [ (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) + (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :friend) (dp/->Variable '?x)])]) + '(or [?e :follows ?x] (and @@ -167,67 +176,69 @@ (dp/->Or (dp/->DefaultSrc) (dp/->RuleVars nil [(dp/->Variable '?e) (dp/->Variable '?x)]) - [(dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) - (dp/->And - [(dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :friend) (dp/->Variable '?x)]) - (dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?x) (dp/->Constant :friend) (dp/->Variable '?e)])])]) - + [ (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) + (dp/->And + [(dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :friend) (dp/->Variable '?x)]) + (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?x) (dp/->Constant :friend) (dp/->Variable '?e)])]) ]) + '($1 or [?x]) (dp/->Or (dp/->SrcVar '$1) (dp/->RuleVars nil [(dp/->Variable '?x)]) - [(dp/->Pattern (dp/->DefaultSrc) [(dp/->Variable '?x)])]) - + [ (dp/->Pattern (dp/->DefaultSrc) [(dp/->Variable '?x)]) ]) + '(or-join [?e] [?e :follows ?x] [?e :friend ?y]) (dp/->Or (dp/->DefaultSrc) (dp/->RuleVars nil [(dp/->Variable '?e)]) - [(dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) - (dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :friend) (dp/->Variable '?y)])]) - + [ (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) + (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :friend) (dp/->Variable '?y)])]) + '(or-join [[?e]] (and [?e :follows ?x] - [?e :friend ?y])) + [?e :friend ?y])) (dp/->Or (dp/->DefaultSrc) (dp/->RuleVars [(dp/->Variable '?e)] nil) - [(dp/->And - [(dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) - (dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :friend) (dp/->Variable '?y)])])]) - + [ (dp/->And + [(dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) + (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :friend) (dp/->Variable '?y)])]) ]) + '($1 or-join [[?e] ?x] - [?e :follows ?x]) + [?e :follows ?x]) (dp/->Or (dp/->SrcVar '$1) (dp/->RuleVars [(dp/->Variable '?e)] [(dp/->Variable '?x)]) - [(dp/->Pattern - (dp/->DefaultSrc) - [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)])])) - + [ (dp/->Pattern + (dp/->DefaultSrc) + [(dp/->Variable '?e) (dp/->Constant :follows) (dp/->Variable '?x)]) ]) + ) + (is (thrown-with-msg? ExceptionInfo #"Cannot parse rule-vars" (dp/parse-clause '(or-join [] [?y])))) - + (is (thrown-with-msg? ExceptionInfo #"Join variables should not be empty" (dp/parse-clause '(or [_])))) - + (is (thrown-with-msg? ExceptionInfo #"Cannot parse 'or-join' clause" (dp/parse-clause '(or-join [?x])))) - + (is (thrown-with-msg? ExceptionInfo #"Cannot parse 'or' clause" - (dp/parse-clause '(or))))) + (dp/parse-clause '(or)))) +) diff --git a/test/datascript/test/pull_api.cljc b/test/datascript/test/pull_api.cljc index cac581d4..7a0b4e1b 100644 --- a/test/datascript/test/pull_api.cljc +++ b/test/datascript/test/pull_api.cljc @@ -1,27 +1,29 @@ (ns datascript.test.pull-api (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] [datascript.test.core :as tdc])) (def ^:private test-schema - {:name {:db/unique :db.unique/identity} - :aka {:db/cardinality :db.cardinality/many} - :child {:db/cardinality :db.cardinality/many - :db/valueType :db.type/ref} - :friend {:db/cardinality :db.cardinality/many - :db/valueType :db.type/ref} - :enemy {:db/cardinality :db.cardinality/many - :db/valueType :db.type/ref} - :father {:db/valueType :db.type/ref} - - :part {:db/valueType :db.type/ref - :db/isComponent true - :db/cardinality :db.cardinality/many} - :spec {:db/valueType :db.type/ref - :db/isComponent true - :db/cardinality :db.cardinality/one}}) + {:name { :db/unique :db.unique/identity } + :aka { :db/cardinality :db.cardinality/many } + :child { :db/cardinality :db.cardinality/many + :db/valueType :db.type/ref } + :friend { :db/cardinality :db.cardinality/many + :db/valueType :db.type/ref } + :enemy { :db/cardinality :db.cardinality/many + :db/valueType :db.type/ref } + :father { :db/valueType :db.type/ref } + + :part { :db/valueType :db.type/ref + :db/isComponent true + :db/cardinality :db.cardinality/many } + :spec { :db/valueType :db.type/ref + :db/isComponent true + :db/cardinality :db.cardinality/one }}) (def test-datoms (->> @@ -58,46 +60,44 @@ [16 :part 17] [18 :name "Part A.B.A.B"] [16 :part 18]] - (map #(apply d/datom %)))) + (map #(apply d/datom %)))) -(def ^:private *test-db - (delay - (d/init-db test-datoms test-schema))) +(def ^:private test-db (d/init-db test-datoms test-schema)) (deftest test-pull-attr-spec (is (= {:name "Petr" :aka ["Devil" "Tupen"]} - (d/pull @*test-db '[:name :aka] 1))) + (d/pull test-db '[:name :aka] 1))) (is (= {:name "Matthew" :father {:db/id 3} :db/id 6} - (d/pull @*test-db '[:name :father :db/id] 6))) + (d/pull test-db '[:name :father :db/id] 6))) (is (= [{:name "Petr"} {:name "Elizabeth"} {:name "Eunan"} {:name "Rebecca"}] - (d/pull-many @*test-db '[:name] [1 5 7 9])))) + (d/pull-many test-db '[:name] [1 5 7 9])))) (deftest test-pull-reverse-attr-spec (is (= {:name "David" :_child [{:db/id 1}]} - (d/pull @*test-db '[:name :_child] 2))) + (d/pull test-db '[:name :_child] 2))) (is (= {:name "David" :_child [{:name "Petr"}]} - (d/pull @*test-db '[:name {:_child [:name]}] 2))) + (d/pull test-db '[:name {:_child [:name]}] 2))) (testing "Reverse non-component references yield collections" (is (= {:name "Thomas" :_father [{:db/id 6}]} - (d/pull @*test-db '[:name :_father] 3))) + (d/pull test-db '[:name :_father] 3))) (is (= {:name "Petr" :_father [{:db/id 2} {:db/id 3}]} - (d/pull @*test-db '[:name :_father] 1))) + (d/pull test-db '[:name :_father] 1))) (is (= {:name "Thomas" :_father [{:name "Matthew"}]} - (d/pull @*test-db '[:name {:_father [:name]}] 3))) + (d/pull test-db '[:name {:_father [:name]}] 3))) (is (= {:name "Petr" :_father [{:name "David"} {:name "Thomas"}]} - (d/pull @*test-db '[:name {:_father [:name]}] 1)))) + (d/pull test-db '[:name {:_father [:name]}] 1)))) - (testing "Multiple reverse refs issue-412" + (testing "Multiple reverse refs #412" (is (= {:name "Petr" :_father [{:db/id 2} {:db/id 3}]} - (d/pull @*test-db '[:name :_father :_child] 1))))) + (d/pull test-db '[:name :_father :_child] 1))))) (deftest test-pull-component-attr (let [parts {:name "Part A", @@ -131,47 +131,47 @@ recdb (d/init-db (concat test-datoms [(d/datom 12 :part 10)]) test-schema)] - + (testing "Component entities are expanded recursively" - (is (= parts (d/pull @*test-db '[:name :part] 10)))) + (is (= parts (d/pull test-db '[:name :part] 10)))) (testing "Reverse component references yield a single result" (is (= {:name "Part A.A" :_part {:db/id 10}} - (d/pull @*test-db [:name :_part] 11))) + (d/pull test-db [:name :_part] 11))) (is (= {:name "Part A.A" :_part {:name "Part A"}} - (d/pull @*test-db [:name {:_part [:name]}] 11)))) + (d/pull test-db [:name {:_part [:name]}] 11)))) (testing "Like explicit recursion, expansion will not allow loops" (is (= rpart (d/pull recdb '[:name :part] 10)))) - (testing "Reverse recursive component issue-411" + (testing "Reverse recursive component #411" (is (= {:name "Part A.A.A.B" :_part {:name "Part A.A.A" :_part {:name "Part A.A" :_part {:name "Part A"}}}} - (d/pull @*test-db '[:name {:_part ...}] 14))) + (d/pull test-db '[:name {:_part ...}] 14))) (is (= {:name "Part A.A.A.B" :_part {:name "Part A.A.A" :_part {:name "Part A.A"}}} - (d/pull @*test-db '[:name {:_part 2}] 14)))))) + (d/pull test-db '[:name {:_part 2}] 14)))))) (deftest test-pull-wildcard (is (= {:db/id 1 :name "Petr" :aka ["Devil" "Tupen"] :child [{:db/id 2} {:db/id 3}]} - (d/pull @*test-db '[*] 1))) + (d/pull test-db '[*] 1))) (is (= {:db/id 2 :name "David" :_child [{:db/id 1}] :father {:db/id 1}} - (d/pull @*test-db '[* :_child] 2))) + (d/pull test-db '[* :_child] 2))) (is (= {:aka ["Devil" "Tupen"], :child [{:db/id 2} {:db/id 3}], :name "Petr", :db/id 1} - (d/pull @*test-db '[:name *] 1))) + (d/pull test-db '[:name *] 1))) (is (= {:aka ["Devil" "Tupen"], :child [{:db/id 2} {:db/id 3}], :name "Petr", :db/id 1} - (d/pull @*test-db '[:aka :name *] 1))) + (d/pull test-db '[:aka :name *] 1))) (is (= {:aka ["Devil" "Tupen"], :child [{:db/id 2} {:db/id 3}], :name "Petr", :db/id 1} - (d/pull @*test-db '[:aka :child :name *] 1))) + (d/pull test-db '[:aka :child :name *] 1))) (is (= {:alias ["Devil" "Tupen"], :child [{:db/id 2} {:db/id 3}], :first-name "Petr", :db/id 1} - (d/pull @*test-db '[[:aka :as :alias] [:name :as :first-name] *] 1))) + (d/pull test-db '[[:aka :as :alias] [:name :as :first-name] *] 1))) (is (= {:db/id 1 :name "Petr" @@ -182,19 +182,67 @@ {:db/id 3 :father {:db/id 1} :name "Thomas"}]} - (d/pull @*test-db '[* {:child ...}] 1)))) + (d/pull test-db '[* {:child ...}] 1)))) (deftest test-pull-limit (let [db (d/init-db - (concat - test-datoms - [(d/datom 4 :friend 5) - (d/datom 4 :friend 6) - (d/datom 4 :friend 7) - (d/datom 4 :friend 8)] - (for [idx (range 2000)] - (d/datom 8 :aka (str "aka-" idx)))) - test-schema)] + (concat + test-datoms + [(d/datom 4 :friend 5) + (d/datom 4 :friend 6) + (d/datom 4 :friend 7) + (d/datom 4 :friend 8)] + (for [idx (range 2000)] + (d/datom 8 :aka (str "aka-" idx)))) + test-schema)] + + #?(:cljd + (testing "cljd datoms count" + (is (= (+ 4 2000 (count test-datoms)) (count db))) + (let [MIN ^:unique (Object.) + MAX ^:unique (Object.) + cmp (fn [a b] + (cond + (identical? a b) 0 + (identical? a MIN) -1 + (identical? a MAX) 1 + (identical? b MIN) 1 + (identical? b MAX) -1 + :else (compare a b))) + cmp-eavt (fn [^db/Datom a ^db/Datom b] + (let [r (cmp (.-e a) (.-e b))] + (if-not (zero? r) + r + (let [r (cmp (.-a a) (.-a b))] + (if-not (zero? r) + r + (cmp (.-v a) (.-v b))))))) + datoms (into (sorted-set-by cmp-eavt) (.-eavt db)) + from (d/datom 8 :aka MIN) + to (d/datom 8 :aka MAX)] + (is (= 2000 + (count (subseq datoms >= from <= to))))) + (let [cmp (fn [a b] ; fishy cmp behaving like Datascript + (cond + (nil? a) 0 + (nil? b) 0 + :else (compare a b))) + cmp-eavt (fn [^db/Datom a ^db/Datom b] + (let [r (cmp (.-e a) (.-e b))] + (if-not (zero? r) + r + (let [r (cmp (.-a a) (.-a b))] + (if-not (zero? r) + r + (let [r (cmp (.-v a) (.-v b))] + (if-not (zero? r) + r + (cmp (.-tx a) (.-tx b))))))))) + datoms (into (sorted-set-by cmp-eavt) (.-eavt db)) + from (d/datom 8 :aka nil db/tx0) + to (d/datom 8 :aka nil db/txmax)] + (is (= 1097 + (count (subseq datoms >= from <= to))))))) (testing "Without an explicit limit, the default is 1000" (is (= 1000 (->> (d/pull db '[:aka] 8) :aka count)))) @@ -212,87 +260,87 @@ (testing "Limits can be used as map specification keys" (is (= {:name "Lucy" :friend [{:name "Elizabeth"} {:name "Matthew"}]} - (d/pull db '[:name {(limit :friend 2) [:name]}] 4)))))) + (d/pull db '[:name {(limit :friend 2) [:name]}] 4)))))) (deftest test-pull-default (testing "Empty results return nil" - (is (nil? (d/pull @*test-db '[:foo] 1)))) + (is (nil? (d/pull test-db '[:foo] 1)))) (testing "A default can be used to replace nil results" (is (= {:foo "bar"} - (d/pull @*test-db '[(default :foo "bar")] 1))) + (d/pull test-db '[(default :foo "bar")] 1))) (is (= {:foo "bar"} - (d/pull @*test-db '[[:foo :default "bar"]] 1))) + (d/pull test-db '[[:foo :default "bar"]] 1))) (is (= {:foo false} - (d/pull @*test-db '[[:foo :default false]] 1))) + (d/pull test-db '[[:foo :default false]] 1))) (is (= {:bar false} - (d/pull @*test-db '[[:foo :as :bar :default false]] 1)))) + (d/pull test-db '[[:foo :as :bar :default false]] 1)))) (testing "default does not override results" (is (= {:name "Petr", :aka ["Devil" "Tupen"] :child [{:name "David", :aka "[aka]", :child "[child]"} {:name "Thomas", :aka "[aka]", :child "[child]"}]} - (d/pull @*test-db - '[[:name :default "[name]"] - [:aka :default "[aka]"] - {[:child :default "[child]"] ...}] - 1))) + (d/pull test-db + '[[:name :default "[name]"] + [:aka :default "[aka]"] + {[:child :default "[child]"] ...}] + 1))) (is (= {:name "David", :aka "[aka]", :child "[child]"} - (d/pull @*test-db - '[[:name :default "[name]"] - [:aka :default "[aka]"] - {[:child :default "[child]"] ...}] - 2)))) + (d/pull test-db + '[[:name :default "[name]"] + [:aka :default "[aka]"] + {[:child :default "[child]"] ...}] + 2)))) (testing "Ref default" (is (= {:child 1 :db/id 2} - (d/pull @*test-db '[:db/id [:child :default 1]] 2))) + (d/pull test-db '[:db/id [:child :default 1]] 2))) (is (= {:_child 2 :db/id 1} - (d/pull @*test-db '[:db/id [:_child :default 2]] 1))))) + (d/pull test-db '[:db/id [:_child :default 2]] 1))))) (deftest test-pull-as (is (= {"Name" "Petr", :alias ["Devil" "Tupen"]} - (d/pull @*test-db '[[:name :as "Name"] [:aka :as :alias]] 1)))) + (d/pull test-db '[[:name :as "Name"] [:aka :as :alias]] 1)))) (deftest test-pull-attr-with-opts (is (= {"Name" "Nothing"} - (d/pull @*test-db '[[:x :as "Name" :default "Nothing"]] 1)))) + (d/pull test-db '[[:x :as "Name" :default "Nothing"]] 1)))) (deftest test-pull-map (testing "Single attrs yield a map" (is (= {:name "Matthew" :father {:name "Thomas"}} - (d/pull @*test-db '[:name {:father [:name]}] 6)))) + (d/pull test-db '[:name {:father [:name]}] 6)))) (testing "Multi attrs yield a collection of maps" (is (= {:name "Petr" :child [{:name "David"} {:name "Thomas"}]} - (d/pull @*test-db '[:name {:child [:name]}] 1)))) + (d/pull test-db '[:name {:child [:name]}] 1)))) (testing "Missing attrs are dropped" (is (= {:name "Petr"} - (d/pull @*test-db '[:name {:father [:name]}] 1)))) + (d/pull test-db '[:name {:father [:name]}] 1)))) (testing "Non matching results are removed from collections" (is (= {:name "Petr"} - (d/pull @*test-db '[:name {:child [:foo]}] 1)))) + (d/pull test-db '[:name {:child [:foo]}] 1)))) (testing "Map specs can override component expansion" (is (= {:name "Part A" :part [{:name "Part A.A"} {:name "Part A.B"}]} - (d/pull @*test-db '[:name {:part [:name]}] 10))) + (d/pull test-db '[:name {:part [:name]}] 10))) (is (= {:name "Part A" :part [{:name "Part A.A"} {:name "Part A.B"}]} - (d/pull @*test-db '[:name {:part 1}] 10))))) + (d/pull test-db '[:name {:part 1}] 10))))) (deftest test-pull-recursion - (let [db (-> @*test-db - (d/db-with [[:db/add 4 :friend 5] - [:db/add 5 :friend 6] - [:db/add 6 :friend 7] - [:db/add 7 :friend 8] - [:db/add 4 :enemy 6] - [:db/add 5 :enemy 7] - [:db/add 6 :enemy 8] - [:db/add 7 :enemy 4]])) + (let [db (-> test-db + (d/db-with [[:db/add 4 :friend 5] + [:db/add 5 :friend 6] + [:db/add 6 :friend 7] + [:db/add 7 :friend 8] + [:db/add 4 :enemy 6] + [:db/add 5 :enemy 7] + [:db/add 6 :enemy 8] + [:db/add 7 :enemy 4]])) friends {:db/id 4 :name "Lucy" :friend @@ -361,8 +409,8 @@ (testing "Cycles are handled by returning only the :db/id of entities which have been seen before" (let [db (d/db-with db [[:db/add 8 :friend 4]])] (is (= (update-in friends (take 8 (cycle [:friend 0])) - assoc :friend [{:db/id 4 :name "Lucy" :friend [{:db/id 5}]}]) - (d/pull db '[:db/id :name {:friend ...}] 4))))) + assoc :friend [{:db/id 4 :name "Lucy" :friend [{:db/id 5}]}]) + (d/pull db '[:db/id :name {:friend ...}] 4))))) (testing "Seen ids are tracked independently for different branches" (let [db (-> (d/empty-db {:friend {:db/valueType :db.type/ref} @@ -399,42 +447,42 @@ [:db/add 1 :spec 2] [:db/add 2 :spec 1]])] (is (= (d/pull db '[:db/id {:part ...} {:spec ...}] 1) - {:db/id 1, - :spec {:db/id 2 - :spec {:db/id 1, - :spec {:db/id 2}, :part {:db/id 2}} - :part {:db/id 3, - :part {:db/id 1, - :spec {:db/id 2}, - :part {:db/id 2}}}} - :part {:db/id 2 - :spec {:db/id 1, :spec {:db/id 2}, :part {:db/id 2}} - :part {:db/id 3, - :part {:db/id 1, - :spec {:db/id 2}, - :part {:db/id 2}}}}}))))) + {:db/id 1, + :spec {:db/id 2 + :spec {:db/id 1, + :spec {:db/id 2}, :part {:db/id 2}} + :part {:db/id 3, + :part {:db/id 1, + :spec {:db/id 2}, + :part {:db/id 2}}}} + :part {:db/id 2 + :spec {:db/id 1, :spec {:db/id 2}, :part {:db/id 2}} + :part {:db/id 3, + :part {:db/id 1, + :spec {:db/id 2}, + :part {:db/id 2}}}}}))))) (deftest test-deep-recursion (let [start 100 depth 3000 txd (mapcat - (fn [idx] - [(d/datom idx :name (str "Person-" idx)) - (d/datom (dec idx) :friend idx)]) - (range (inc start) depth)) + (fn [idx] + [(d/datom idx :name (str "Person-" idx)) + (d/datom (dec idx) :friend idx)]) + (range (inc start) depth)) db (d/init-db (concat test-datoms [(d/datom start :name (str "Person-" start))] txd) - test-schema) + test-schema) pulled (d/pull db '[:name {:friend ...}] start) path (->> [:friend 0] - (repeat (dec (- depth start))) - (into [] cat))] + (repeat (dec (- depth start))) + (into [] cat))] (is (= (str "Person-" (dec depth)) - (:name (get-in pulled path)))))) + (:name (get-in pulled path)))))) -; issue-430 +; https://github.com/tonsky/datascript/issues/430 (deftest test-component-reverse (let [schema {:ref {:db/valueType :db.type/ref :db/isComponent true}} @@ -449,18 +497,18 @@ (deftest test-lookup-ref-pull (is (= {:name "Petr" :aka ["Devil" "Tupen"]} - (d/pull @*test-db '[:name :aka] [:name "Petr"]))) + (d/pull test-db '[:name :aka] [:name "Petr"]))) (is (= nil - (d/pull @*test-db '[:name :aka] [:name "NotInDatabase"]))) + (d/pull test-db '[:name :aka] [:name "NotInDatabase"]))) (is (= [nil {:aka ["Devil" "Tupen"]} nil nil nil] - (d/pull-many @*test-db - '[:aka] - [[:name "Elizabeth"] - [:name "Petr"] - [:name "Eunan"] - [:name "Rebecca"] - [:name "Unknown"]]))) - (is (nil? (d/pull @*test-db '[*] [:name "No such name"])))) + (d/pull-many test-db + '[:aka] + [[:name "Elizabeth"] + [:name "Petr"] + [:name "Eunan"] + [:name "Rebecca"] + [:name "Unknown"]]))) + (is (nil? (d/pull test-db '[*] [:name "No such name"])))) (deftest test-xform (is (= {:db/id [1] @@ -468,53 +516,41 @@ :aka [["Devil" "Tupen"]] :child [[{:db/id [2], :name ["David"], :aka [nil], :child [nil]} {:db/id [3], :name ["Thomas"], :aka [nil], :child [nil]}]]} - (d/pull @*test-db - [[:db/id :xform vector] + (d/pull test-db + '[[:db/id :xform vector] [:name :xform vector] [:aka :xform vector] - {[:child :xform vector] '...}] - 1))) - - (testing ":xform on cardinality/one ref issue-455" - (is (= {:name "David" :father "Petr"} - (d/pull @*test-db [:name {[:father :xform #(:name %)] ['*]}] 2)))) - - (testing ":xform on reverse ref" - (is (= {:name "Petr" :_father ["David" "Thomas"]} - (d/pull @*test-db [:name {[:_father :xform #(mapv :name %)] [:name]}] 1)))) - - (testing ":xform on reverse component ref" - (is (= {:name "Part A.A" :_part "Part A"} - (d/pull @*test-db [:name {[:_part :xform #(:name %)] [:name]}] 11)))) - + {[:child :xform vector] ...}] + 1))) + (testing "missing attrs are processed by xform" (is (= {:normal [nil] :aka [nil] :child [nil]} - (d/pull @*test-db + (d/pull test-db '[[:normal :xform vector] [:aka :xform vector] {[:child :xform vector] ...}] 2)))) (testing "default takes precedence" (is (= {:unknown "[unknown]"} - (d/pull @*test-db '[[:unknown :default "[unknown]" :xform vector]] 1))))) + (d/pull test-db '[[:unknown :default "[unknown]" :xform vector]] 1))))) (deftest test-visitor (let [*trace (volatile! nil) opts {:visitor (fn [k e a v] (vswap! *trace conj [k e a v]))} test-fn (fn [pattern id] (vreset! *trace []) - (d/pull @*test-db pattern id opts) + (d/pull test-db pattern id opts) @*trace)] (is (= [[:db.pull/attr 1 :name nil]] (test-fn [:name] 1))) - + (testing "multival" (is (= [[:db.pull/attr 1 :aka nil] [:db.pull/attr 1 :name nil]] (test-fn [:name :aka] 1)))) - + (testing ":db/id is ignored" (is (= [] (test-fn [:db/id] 1))) (is (= [[:db.pull/attr 1 :name nil]] @@ -563,14 +599,14 @@ [:db.pull/reverse nil :child 2]] (test-fn [:name :_child] 2)))))) -(deftest test-pull-other-dbs - (let [db (-> @*test-db +#_(deftest test-pull-other-dbs + (let [db (-> test-db (d/filter (fn [_ datom] (not= "Tupen" (:v datom)))))] (is (= {:name "Petr" :aka ["Devil"]} (d/pull db '[:name :aka] 1)))) - (let [db (-> @*test-db d/serializable pr-str clojure.edn/read-string d/from-serializable)] + (let [db (-> test-db d/serializable pr-str #?(:cljd cljd.reader/read-string :default clojure.edn/read-string d/from-serializable))] (is (= {:name "Petr" :aka ["Devil" "Tupen"]} (d/pull db '[:name :aka] 1)))) - (let [db (d/init-db (d/datoms @*test-db :eavt) test-schema)] + (let [db (d/init-db (d/datoms test-db :eavt) test-schema)] (is (= {:name "Petr" :aka ["Devil" "Tupen"]} (d/pull db '[:name :aka] 1))))) diff --git a/test/datascript/test/pull_parser.cljc b/test/datascript/test/pull_parser.cljc index c19b0ff7..93431fb6 100644 --- a/test/datascript/test/pull_parser.cljc +++ b/test/datascript/test/pull_parser.cljc @@ -1,26 +1,27 @@ (ns datascript.test.pull-parser (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] [datascript.pull-parser :as dpp] - [datascript.test.core :as tdc])) - -(def *db - (delay - (d/empty-db - {:ref {:db/valueType :db.type/ref} - :ref2 {:db/valueType :db.type/ref} - :ref3 {:db/valueType :db.type/ref} - :ns/ref {:db/valueType :db.type/ref} - :multival {:db/cardinality :db.cardinality/many} - :multiref {:db/valueType :db.type/ref - :db/cardinality :db.cardinality/many} - :component {:db/valueType :db.type/ref - :db/isComponent true} - :multicomponent {:db/valueType :db.type/ref - :db/isComponent true - :db/cardinality :db.cardinality/many}}))) + #?(:cljd [cljd.core :refer [ExceptionInfo]]) + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]])) + +(def db (d/empty-db + {:ref {:db/valueType :db.type/ref} + :ref2 {:db/valueType :db.type/ref} + :ref3 {:db/valueType :db.type/ref} + :ns/ref {:db/valueType :db.type/ref} + :multival {:db/cardinality :db.cardinality/many} + :multiref {:db/valueType :db.type/ref + :db/cardinality :db.cardinality/many} + :component {:db/valueType :db.type/ref + :db/isComponent true} + :multicomponent {:db/valueType :db.type/ref + :db/isComponent true + :db/cardinality :db.cardinality/many}})) (defn pattern [& {:as args}] (let [attrs (filter #(not= :db/id (:name %)) (:attrs args))] @@ -30,11 +31,11 @@ (dpp/map->PullAttr (merge {:name name :xform identity :as name} - (when (db/ref? @*db name) {:pattern dpp/default-pattern-ref}) + (when (db/ref? db name) {:pattern dpp/default-pattern-ref}) args))) (deftest test-parse-pattern - (are [pattern expected] (= expected (dpp/parse-pattern @*db pattern)) + (are [pattern expected] (= expected (dpp/parse-pattern db pattern)) [:normal] (pattern :attrs [(attr :normal)]) ['(:normal)] (pattern :attrs [(attr :normal)]) [[:normal]] (pattern :attrs [(attr :normal)]) @@ -84,35 +85,35 @@ [['limit :multival 100]] (pattern :attrs [(attr :multival, :multival? true, :limit 100)]) ; default - ['(:multival :default :xyz)] (pattern :attrs [(attr :multival, :multival? true, :limit 1000, :default :xyz)]) - ['(default :multival :xyz)] (pattern :attrs [(attr :multival, :multival? true, :limit 1000, :default :xyz)]) - ['("default" :multival :xyz)] (pattern :attrs [(attr :multival, :multival? true, :limit 1000, :default :xyz)]) - [['default :multival :xyz]] (pattern :attrs [(attr :multival, :multival? true, :limit 1000, :default :xyz)]) + ['(:multival :default :xyz)] (pattern :attrs [(attr :multival, :multival? true, :limit 1000, :default-val :xyz)]) + ['(default :multival :xyz)] (pattern :attrs [(attr :multival, :multival? true, :limit 1000, :default-val :xyz)]) + ['("default" :multival :xyz)] (pattern :attrs [(attr :multival, :multival? true, :limit 1000, :default-val :xyz)]) + [['default :multival :xyz]] (pattern :attrs [(attr :multival, :multival? true, :limit 1000, :default-val :xyz)]) ; xform [[:normal :xform 'inc]] (pattern :attrs [(attr :normal :xform inc)]) [[:normal :xform inc]] (pattern :attrs [(attr :normal :xform inc)]) - #?@(:clj [[[:normal :xform 'datascript.db/datom?]] (pattern :attrs [(attr :normal :xform db/datom?)])]) + #?@(:cljd [] :clj [[[:normal :xform 'datascript.db/datom?]] (pattern :attrs [(attr :normal :xform db/datom?)])]) ; combined - ['(:multival :limit 100 :default :xyz :as :other :xform inc)] (pattern :attrs [(attr :multival, :multival? true, :default :xyz, :limit 100, :as :other, :xform inc)]) - ['(:multival :xform inc :as :other :default :xyz :limit 100)] (pattern :attrs [(attr :multival, :multival? true, :default :xyz, :limit 100, :as :other, :xform inc)]) - ['((:multival :limit 100) :default :xyz)] (pattern :attrs [(attr :multival, :multival? true, :default :xyz, :limit 100)]) - ['((:multival :default :xyz) :limit 100)] (pattern :attrs [(attr :multival, :multival? true, :default :xyz, :limit 100)]) + ['(:multival :limit 100 :default :xyz :as :other :xform inc)] (pattern :attrs [(attr :multival, :multival? true, :default-val :xyz, :limit 100, :as :other, :xform inc)]) + ['(:multival :xform inc :as :other :default :xyz :limit 100)] (pattern :attrs [(attr :multival, :multival? true, :default-val :xyz, :limit 100, :as :other, :xform inc)]) + ['((:multival :limit 100) :default :xyz)] (pattern :attrs [(attr :multival, :multival? true, :default-val :xyz, :limit 100)]) + ['((:multival :default :xyz) :limit 100)] (pattern :attrs [(attr :multival, :multival? true, :default-val :xyz, :limit 100)]) ; combined - ['(limit (default :multival :xyz) 100)] (pattern :attrs [(attr :multival, :multival? true, :default :xyz, :limit 100)]) - ['(default (limit :multival 100) :xyz)] (pattern :attrs [(attr :multival, :multival? true, :default :xyz, :limit 100)]) - ['(limit (:multival :default :xyz) 100)] (pattern :attrs [(attr :multival, :multival? true, :default :xyz, :limit 100)]) - ['(default (:multival :limit 100) :xyz)] (pattern :attrs [(attr :multival, :multival? true, :default :xyz, :limit 100)]) - ['(((limit :multival 100) :default :xyz))] (pattern :attrs [(attr :multival, :multival? true, :default :xyz, :limit 100)]) - ['(((default :multival :xyz) :limit 100))] (pattern :attrs [(attr :multival, :multival? true, :default :xyz, :limit 100)]) - + ['(limit (default :multival :xyz) 100)] (pattern :attrs [(attr :multival, :multival? true, :default-val :xyz, :limit 100)]) + ['(default (limit :multival 100) :xyz)] (pattern :attrs [(attr :multival, :multival? true, :default-val :xyz, :limit 100)]) + ['(limit (:multival :default :xyz) 100)] (pattern :attrs [(attr :multival, :multival? true, :default-val :xyz, :limit 100)]) + ['(default (:multival :limit 100) :xyz)] (pattern :attrs [(attr :multival, :multival? true, :default-val :xyz, :limit 100)]) + ['(((limit :multival 100) :default :xyz))] (pattern :attrs [(attr :multival, :multival? true, :default-val :xyz, :limit 100)]) + ['(((default :multival :xyz) :limit 100))] (pattern :attrs [(attr :multival, :multival? true, :default-val :xyz, :limit 100)]) + ; repeated [:multival [:multival :default :xyz] [:multival :limit 100]] (pattern :attrs [(attr :multival, :multival? true, :limit 100)]) [:ref {:ref '...}] (pattern :attrs [(attr :ref, :ref? true, :pattern nil, :recursive? true, :recursion-limit nil)]) [{:ref '...} :ref] (pattern :attrs [(attr :ref, :ref? true)]) - + ; map spec [{:ref [:normal]}] (pattern :attrs [(attr :ref, :ref? true, :pattern (pattern :attrs [(attr :normal)]))]) [{:_ref [:normal]}] (pattern :reverse-attrs [(attr :ref, :as :_ref, :ref? true, :reverse? true, :pattern (pattern :attrs [(attr :normal)]))]) @@ -126,22 +127,23 @@ ; map spec limits [{:ref 100}] (pattern :attrs [(attr :ref, :ref? true, :pattern nil, :recursive? true, :recursion-limit 100)]) - [{:ref '...}] (pattern :attrs [(attr :ref, :ref? true, :pattern nil, :recursive? true, :recursion-limit nil)]) + [{:ref '...}] (pattern :attrs [(attr :ref, :ref? true, :pattern nil, :recursive? true, :recursion-limit nil)]) [{:ref "..."}] (pattern :attrs [(attr :ref, :ref? true, :pattern nil, :recursive? true, :recursion-limit nil)]) [{:_ref 100}] (pattern :reverse-attrs [(attr :ref, :as :_ref, :ref? true, :reverse? true, :pattern nil, :recursive? true, :recursion-limit 100)]) - [{:_ref '...}] (pattern :reverse-attrs [(attr :ref, :as :_ref, :ref? true, :reverse? true, :pattern nil, :recursive? true, :recursion-limit nil)])) + [{:_ref '...}] (pattern :reverse-attrs [(attr :ref, :as :_ref, :ref? true, :reverse? true, :pattern nil, :recursive? true, :recursion-limit nil)]) + ) (testing "Error reporting" - (are [pattern msg] (thrown-msg? msg (dpp/parse-pattern @*db pattern)) + (are [pattern msg] (thrown-msg? msg (dpp/parse-pattern db pattern)) ; refs [:_normal] "Expected reverse attribute having :db.type/ref, got: :_normal" ; attr-expr ['(:multival :limit)] "Expected even number of opts, got: (:multival :limit)" - + ; limit ['(limit :multival)] "Expected ['limit attr-name (positive-number | nil)], got: (limit :multival)" - ['(:normal :limit 100)] "Expected limit attribute having :db.cardinality/many, got: :normal" + ['(:normal :limit 100)] "Expected limit attribute having :db.cardinality/many, got: :normal" ['(limit :normal 100)] "Expected limit attribute having :db.cardinality/many, got: :normal" ['(:multival :limit :abc)] "Expected (positive-number | nil), got: :abc" ['(limit :multival :abc)] "Expected (positive-number | nil), got: :abc" @@ -156,4 +158,11 @@ ; map spec [{:normal [:normal2]}] "Expected attribute having :db.type/ref, got: :normal" [{'(:ref :limit 100) [:normal]}] "Expected limit attribute having :db.cardinality/many, got: :ref" - [{:ref :normal}] "Expected pattern to be sequential?, got: :normal"))) + [{:ref :normal}] "Expected pattern to be sequential?, got: :normal" + ))) + + +(comment + (require 'datascript.test 'datascript.test.pull-parser :reload-all) + (dpp/parse-pattern db [:normal]) + (clojure.test/test-ns 'datascript.test.pull-parser)) diff --git a/test/datascript/test/query.cljc b/test/datascript/test/query.cljc index b5b9dc45..1774bc64 100644 --- a/test/datascript/test/query.cljc +++ b/test/datascript/test/query.cljc @@ -1,115 +1,121 @@ (ns datascript.test.query (:require - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.db :as db] - [datascript.test.core :as tdc]) - #?(:clj - (:import - [clojure.lang ExceptionInfo]))) + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + [datascript.core :as d] + [datascript.db :as db] + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]] + #?(:cljd [cljd.core :refer [ExceptionInfo]])) + #?(:cljd nil + :clj + (:import [clojure.lang ExceptionInfo]))) (deftest test-joins (let [db (-> (d/empty-db) - (d/db-with [{:db/id 1, :name "Ivan", :age 15} - {:db/id 2, :name "Petr", :age 37} - {:db/id 3, :name "Ivan", :age 37} - {:db/id 4, :age 15}]))] + (d/db-with [ { :db/id 1, :name "Ivan", :age 15 } + { :db/id 2, :name "Petr", :age 37 } + { :db/id 3, :name "Ivan", :age 37 } + { :db/id 4, :age 15 }]))] (is (= (d/q '[:find ?e :where [?e :name]] db) - #{[1] [2] [3]})) + #{[1] [2] [3]})) (is (= (d/q '[:find ?e ?v :where [?e :name "Ivan"] - [?e :age ?v]] db) - #{[1 15] [3 37]})) + [?e :age ?v]] db) + #{[1 15] [3 37]})) (is (= (d/q '[:find ?e1 ?e2 :where [?e1 :name ?n] - [?e2 :name ?n]] db) - #{[1 1] [2 2] [3 3] [1 3] [3 1]})) + [?e2 :name ?n]] db) + #{[1 1] [2 2] [3 3] [1 3] [3 1]})) (is (= (d/q '[:find ?e ?e2 ?n :where [?e :name "Ivan"] - [?e :age ?a] - [?e2 :age ?a] - [?e2 :name ?n]] db) - #{[1 1 "Ivan"] - [3 3 "Ivan"] - [3 2 "Petr"]})))) + [?e :age ?a] + [?e2 :age ?a] + [?e2 :name ?n]] db) + #{[1 1 "Ivan"] + [3 3 "Ivan"] + [3 2 "Petr"]})))) + (deftest test-q-many (let [db (-> (d/empty-db {:aka {:db/cardinality :db.cardinality/many}}) - (d/db-with [[:db/add 1 :name "Ivan"] - [:db/add 1 :aka "ivolga"] - [:db/add 1 :aka "pi"] - [:db/add 2 :name "Petr"] - [:db/add 2 :aka "porosenok"] - [:db/add 2 :aka "pi"]]))] + (d/db-with [ [:db/add 1 :name "Ivan"] + [:db/add 1 :aka "ivolga"] + [:db/add 1 :aka "pi"] + [:db/add 2 :name "Petr"] + [:db/add 2 :aka "porosenok"] + [:db/add 2 :aka "pi"] ]))] (is (= (d/q '[:find ?n1 ?n2 :where [?e1 :aka ?x] - [?e2 :aka ?x] - [?e1 :name ?n1] - [?e2 :name ?n2]] db) - #{["Ivan" "Ivan"] - ["Petr" "Petr"] - ["Ivan" "Petr"] - ["Petr" "Ivan"]})))) + [?e2 :aka ?x] + [?e1 :name ?n1] + [?e2 :name ?n2]] db) + #{["Ivan" "Ivan"] + ["Petr" "Petr"] + ["Ivan" "Petr"] + ["Petr" "Ivan"]})))) + (deftest test-q-coll - (let [db [[1 :name "Ivan"] - [1 :age 19] - [1 :aka "dragon_killer_94"] - [1 :aka "-=autobot=-"]]] - (is (= (d/q '[:find ?n ?a - :where [?e :aka "dragon_killer_94"] - [?e :name ?n] - [?e :age ?a]] db) - #{["Ivan" 19]}))) + (let [db [ [1 :name "Ivan"] + [1 :age 19] + [1 :aka "dragon_killer_94"] + [1 :aka "-=autobot=-"] ] ] + (is (= (d/q '[ :find ?n ?a + :where [?e :aka "dragon_killer_94"] + [?e :name ?n] + [?e :age ?a]] db) + #{["Ivan" 19]}))) (testing "Query over long tuples" - (let [db [[1 :name "Ivan" 945 :db/add] - [1 :age 39 999 :db/retract]]] - (is (= (d/q '[:find ?e ?v - :where [?e :name ?v]] db) - #{[1 "Ivan"]})) - (is (= (d/q '[:find ?e ?a ?v ?t - :where [?e ?a ?v ?t :db/retract]] db) - #{[1 :age 39 999]}))))) + (let [db [ [1 :name "Ivan" 945 :db/add] + [1 :age 39 999 :db/retract]] ] + (is (= (d/q '[ :find ?e ?v + :where [?e :name ?v]] db) + #{[1 "Ivan"]})) + (is (= (d/q '[ :find ?e ?a ?v ?t + :where [?e ?a ?v ?t :db/retract]] db) + #{[1 :age 39 999]}))))) + (deftest test-q-in (let [db (-> (d/empty-db) - (d/db-with [{:db/id 1, :name "Ivan", :age 15} - {:db/id 2, :name "Petr", :age 37} - {:db/id 3, :name "Ivan", :age 37}])) + (d/db-with [ { :db/id 1, :name "Ivan", :age 15 } + { :db/id 2, :name "Petr", :age 37 } + { :db/id 3, :name "Ivan", :age 37 }])) query '{:find [?e] :in [$ ?attr ?value] :where [[?e ?attr ?value]]}] (is (= (d/q query db :name "Ivan") - #{[1] [3]})) + #{[1] [3]})) (is (= (d/q query db :age 37) - #{[2] [3]})) + #{[2] [3]})) (testing "Named DB" (is (= (d/q '[:find ?a ?v :in $db ?e :where [$db ?e ?a ?v]] db 1) - #{[:name "Ivan"] - [:age 15]}))) + #{[:name "Ivan"] + [:age 15]}))) (testing "DB join with collection" (is (= (d/q '[:find ?e ?email :in $ $b :where [?e :name ?n] - [$b ?n ?email]] - db - [["Ivan" "ivan@mail.ru"] - ["Petr" "petr@gmail.com"]]) - #{[1 "ivan@mail.ru"] - [2 "petr@gmail.com"] - [3 "ivan@mail.ru"]}))) - + [$b ?n ?email]] + db + [["Ivan" "ivan@mail.ru"] + ["Petr" "petr@gmail.com"]]) + #{[1 "ivan@mail.ru"] + [2 "petr@gmail.com"] + [3 "ivan@mail.ru"]}))) + (testing "Query without DB" (is (= (d/q '[:find ?a ?b :in ?a ?b] - 10 20) - #{[10 20]}))) + 10 20) + #{[10 20]}))) (is (thrown-msg? "Extra inputs passed, expected: [], got: 1" (d/q '[:find ?e :where [(inc 1) ?e]] db))) @@ -125,34 +131,34 @@ (deftest test-bindings (let [db (-> (d/empty-db) - (d/db-with [{:db/id 1, :name "Ivan", :age 15} - {:db/id 2, :name "Petr", :age 37} - {:db/id 3, :name "Ivan", :age 37}]))] + (d/db-with [ { :db/id 1, :name "Ivan", :age 15 } + { :db/id 2, :name "Petr", :age 37 } + { :db/id 3, :name "Ivan", :age 37 }]))] (testing "Relation binding" (is (= (d/q '[:find ?e ?email :in $ [[?n ?email]] :where [?e :name ?n]] - db - [["Ivan" "ivan@mail.ru"] - ["Petr" "petr@gmail.com"]]) - #{[1 "ivan@mail.ru"] - [2 "petr@gmail.com"] - [3 "ivan@mail.ru"]}))) + db + [["Ivan" "ivan@mail.ru"] + ["Petr" "petr@gmail.com"]]) + #{[1 "ivan@mail.ru"] + [2 "petr@gmail.com"] + [3 "ivan@mail.ru"]}))) (testing "Tuple binding" (is (= (d/q '[:find ?e :in $ [?name ?age] :where [?e :name ?name] - [?e :age ?age]] - db ["Ivan" 37]) - #{[3]}))) + [?e :age ?age]] + db ["Ivan" 37]) + #{[3]}))) (testing "Collection binding" (is (= (d/q '[:find ?attr ?value :in $ ?e [?attr ...] :where [?e ?attr ?value]] - db 1 [:name :age]) - #{[:name "Ivan"] [:age 15]}))) + db 1 [:name :age]) + #{[:name "Ivan"] [:age 15]}))) (testing "Empty coll handling" (is (= (d/q '[:find ?id @@ -161,128 +167,105 @@ [[1 :name "Ivan"] [2 :name "Petr"]] []) - #{})) + #{})) (is (= (d/q '[:find ?id :in $ [[?id]] :where [?id :age _]] [[1 :name "Ivan"] [2 :name "Petr"]] []) - #{}))) - + #{}))) + (testing "Placeholders" (is (= (d/q '[:find ?x ?z :in [?x _ ?z]] - [:x :y :z]) - #{[:x :z]})) + [:x :y :z]) + #{[:x :z]})) (is (= (d/q '[:find ?x ?z :in [[?x _ ?z]]] - [[:x :y :z] [:a :b :c]]) - #{[:x :z] [:a :c]}))) - + [[:x :y :z] [:a :b :c]]) + #{[:x :z] [:a :c]}))) + (testing "Error reporting" (is (thrown-with-msg? ExceptionInfo #"Cannot bind value :a to tuple \[\?a \?b\]" (d/q '[:find ?a ?b :in [?a ?b]] :a))) (is (thrown-with-msg? ExceptionInfo #"Cannot bind value :a to collection \[\?a \.\.\.\]" (d/q '[:find ?a :in [?a ...]] :a))) (is (thrown-with-msg? ExceptionInfo #"Not enough elements in a collection \[:a\] to bind tuple \[\?a \?b\]" - (d/q '[:find ?a ?b :in [?a ?b]] [:a])))))) - + (d/q '[:find ?a ?b :in [?a ?b]] [:a])))) + +)) + (deftest test-nested-bindings (is (= (d/q '[:find ?k ?v :in [[?k ?v] ...] :where [(> ?v 1)]] - {:a 1, :b 2, :c 3}) - #{[:b 2] [:c 3]})) + {:a 1, :b 2, :c 3}) + #{[:b 2] [:c 3]})) (is (= (d/q '[:find ?k ?min ?max :in [[?k ?v] ...] ?minmax :where [(?minmax ?v) [?min ?max]] - [(> ?max ?min)]] - {:a [1 2 3 4] - :b [5 6 7] - :c [3]} - #(vector (reduce min %) (reduce max %))) - #{[:a 1 4] [:b 5 7]})) + [(> ?max ?min)]] + {:a [1 2 3 4] + :b [5 6 7] + :c [3]} + #(vector (reduce min %) (reduce max %))) + #{[:a 1 4] [:b 5 7]})) (is (= (d/q '[:find ?k ?x :in [[?k [?min ?max]] ...] ?range :where [(?range ?min ?max) [?x ...]] - [(even? ?x)]] - {:a [1 7] - :b [2 4]} - range) - #{[:a 2] [:a 4] [:a 6] - [:b 2]}))) + [(even? ?x)]] + {:a [1 7] + :b [2 4]} + range) + #{[:a 2] [:a 4] [:a 6] + [:b 2]}))) (deftest test-built-in-regex (is (= (d/q '[:find ?name :in [?name ...] ?key :where [(re-pattern ?key) ?pattern] - [(re-find ?pattern ?name)]] - #{"abc" "abcX" "aXb"} - "X") - #{["abcX"] ["aXb"]}))) + [(re-find ?pattern ?name)]] + #{"abc" "abcX" "aXb"} + "X") + #{["abcX"] ["aXb"]}))) (deftest test-built-in-get (is (= (d/q '[:find ?m ?m-value :in [[?k ?m] ...] ?m-key :where [(get ?m ?m-key) ?m-value]] - {:a {:b 1} - :c {:d 2}} - :d) - #{[{:d 2} 2]}))) + {:a {:b 1} + :c {:d 2}} + :d) + #{[{:d 2} 2]}))) (deftest ^{:doc "issue-385"} test-join-unrelated (is (= #{} (d/q '[:find ?name :in $ ?my-fn :where [?e :person/name ?name] - [(?my-fn) ?result] - [(< ?result 3)]] + [(?my-fn) ?result] + [(< ?result 3)]] (d/db-with (d/empty-db) [{:person/name "Joe"}]) (fn [] 5))))) (deftest ^{:doc "issue-425"} test-symbol-comparison (is (= [2] - (d/q + (d/q '[:find [?e ...] :where [?e :s b]] '[[1 :s a] [2 :s b]]))) (let [db (-> (d/empty-db) - (d/db-with '[{:db/id 1, :s a} - {:db/id 2, :s b}]))] + (d/db-with '[{:db/id 1, :s a} + {:db/id 2, :s b}]))] (is (= [2] - (d/q + (d/q '[:find [?e ...] :where [?e :s b]] db))))) -(deftest ^{:doc "issue-462"} test-constant-substitution - (let [cnt+q (fn [query db & sources] - (let [*cnt (volatile! 0) - db' (d/filter db - (fn [db datom] - (vswap! *cnt inc) - true)) - res (apply d/q query db' sources)] - [@*cnt res])) - schema {:a {:db/index true} - :b {:db/index true} - :c {:db/index true}} - db (-> (d/empty-db schema) - (d/db-with - (for [eid (range 1 11) - attr [:a :b :c]] - [:db/add eid attr (str eid (name attr))])))] - (is (= [1 #{["5b"]}] (cnt+q '[:find ?v :where [5 :b ?v]] db))) - (is (= [1 #{[:b]}] (cnt+q '[:find ?a :where [5 ?a "5b"]] db))) - (is (= [1 #{[5]}] (cnt+q '[:find ?e :where [?e :b "5b"]] db))) - (is (= [1 #{[5 :b "5b"]}] (cnt+q '[:find ?e ?a ?v :in $ ?e ?a :where [?e ?a ?v]] db 5 :b))) - (is (= [2 #{[5 :b "5b"]}] (cnt+q '[:find ?e2 ?a ?v :in $ ?a ?v :where [?e ?a ?v] [?e2 ?a ?v]] db :b "5b"))) - (is (= [3 #{[:a "5a"] [:b "5b"] [:c "5c"]}] (cnt+q '[:find ?a ?v :in $ ?e :where [?e ?a ?v]] db 5))) - (is (= [1 #{[5 :b]}] (cnt+q '[:find ?e ?a :where [?e ?a "5b"]] db))) - (is (= [1 #{[5 :b]}] (cnt+q '[:find ?e ?a :in $ ?v :where [?e ?a ?v]] db "5b"))) - (is (= [1 #{[5 :b]}] (cnt+q '[:find ?e ?a :in $ [?v ...] :where [?e ?a ?v]] db ["5b"]))) - (is (= [1 #{[5 :b]}] (cnt+q '[:find ?e ?a :where [(ground "5b") ?v] [?e ?a ?v]] db))))) +#_(require 'datascript.test.query :reload) +#_(clojure.test/test-ns 'datascript.test.query) diff --git a/test/datascript/test/query_aggregates.cljc b/test/datascript/test/query_aggregates.cljc index f2100fb0..b9f0f851 100644 --- a/test/datascript/test/query_aggregates.cljc +++ b/test/datascript/test/query_aggregates.cljc @@ -1,40 +1,44 @@ (ns datascript.test.query-aggregates (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] [datascript.test.core :as tdc])) + (defn sort-reverse [xs] (reverse (sort xs))) + (deftest test-aggregates - (let [monsters [["Cerberus" 3] - ["Medusa" 1] - ["Cyclops" 1] - ["Chimera" 1]]] + (let [monsters [ ["Cerberus" 3] + ["Medusa" 1] + ["Cyclops" 1] + ["Chimera" 1] ]] (testing "with" - (is (= (d/q '[:find ?heads - :with ?monster - :in [[?monster ?heads]]] - [["Medusa" 1] - ["Cyclops" 1] - ["Chimera" 1]]) - [[1] [1] [1]]))) + (is (= (d/q '[ :find ?heads + :with ?monster + :in [[?monster ?heads]] ] + [ ["Medusa" 1] + ["Cyclops" 1] + ["Chimera" 1] ]) + [[1] [1] [1]]))) (testing "Wrong grouping without :with" - (is (= (d/q '[:find (sum ?heads) - :in [[?monster ?heads]]] - monsters) - [[4]]))) + (is (= (d/q '[ :find (sum ?heads) + :in [[?monster ?heads]] ] + monsters) + [[4]]))) (testing "Multiple aggregates, correct grouping with :with" - (is (= (d/q '[:find (sum ?heads) (min ?heads) (max ?heads) (count ?heads) (count-distinct ?heads) - :with ?monster - :in [[?monster ?heads]]] - monsters) - [[6 1 3 4 2]]))) - + (is (= (d/q '[ :find (sum ?heads) (min ?heads) (max ?heads) (count ?heads) (count-distinct ?heads) + :with ?monster + :in [[?monster ?heads]] ] + monsters) + [[6 1 3 4 2]]))) + (testing "Min and max are using comparator instead of default compare" ;; Wrong: using js '<' operator ;; (apply min [:a/b :a-/b :a/c]) => :a-/b @@ -43,60 +47,62 @@ ;; (sort compare [:a/b :a-/b :a/c]) => (:a/b :a/c :a-/b) (is (= (d/q '[:find (min ?x) (max ?x) :in [?x ...]] - [:a-/b :a/b]) - [[:a/b :a-/b]])) + [:a-/b :a/b]) + [[:a/b :a-/b]])) (is (= (d/q '[:find (min 2 ?x) (max 2 ?x) :in [?x ...]] - [:a/b :a-/b :a/c]) - [[[:a/b :a/c] [:a/c :a-/b]]]))) + [:a/b :a-/b :a/c]) + [[[:a/b :a/c] [:a/c :a-/b]]]))) (testing "Grouping and parameter passing" - (is (= (set (d/q '[:find ?color (max ?amount ?x) (min ?amount ?x) - :in [[?color ?x]] ?amount] - [[:red 1] [:red 2] [:red 3] [:red 4] [:red 5] - [:blue 7] [:blue 8]] - 3)) - #{[:red [3 4 5] [1 2 3]] - [:blue [7 8] [7 8]]}))) - - (testing "avg aggregate" - (is (= (ffirst (d/q '[:find (avg ?x) + (is (= (set (d/q '[ :find ?color (max ?amount ?x) (min ?amount ?x) + :in [[?color ?x]] ?amount ] + [[:red 1] [:red 2] [:red 3] [:red 4] [:red 5] + [:blue 7] [:blue 8]] + 3)) + #{[:red [3 4 5] [1 2 3]] + [:blue [7 8] [7 8]]}))) + + (testing "avg aggregate" + (is (= (ffirst (d/q '[:find (avg ?x) :in [?x ...]] - [10 15 20 35 75])) - 31))) + [10 15 20 35 75])) + 31))) (testing "median aggregate" (is (= (ffirst (d/q '[:find (median ?x) :in [?x ...]] - [10 15 20 35 75])) - 20))) - + [10 15 20 35 75])) + 20))) + (testing "variance aggregate" (is (= (ffirst (d/q '[:find (variance ?x) :in [?x ...]] - [10 15 20 35 75])) - 554))) + [10 15 20 35 75])) + 554))) (testing "stddev aggregate" - (is (= (ffirst (d/q '[:find (stddev ?x) + (is (= (ffirst (d/q '[:find (stddev ?x) :in [?x ...]] - [10 15 20 35 75])) - 23.53720459187964))) + [10 15 20 35 75])) + 23.53720459187964))) (testing "Custom aggregates" (let [data [[:red 1] [:red 2] [:red 3] [:red 4] [:red 5] [:blue 7] [:blue 8]] result #{[:red [5 4 3 2 1]] [:blue [8 7]]}] - - (is (= (set (d/q '[:find ?color (aggregate ?agg ?x) - :in [[?color ?x]] ?agg] - data - sort-reverse)) - result)) - - #?(:clj - (is (= (set (d/q '[:find ?color (datascript.test.query-aggregates/sort-reverse ?x) - :in [[?color ?x]]] - data)) - result))))))) + + (is (= (set (d/q '[ :find ?color (aggregate ?agg ?x) + :in [[?color ?x]] ?agg ] + data + sort-reverse)) + result)) + + #?@(:cljd [] + :clj + [(is (= (set (d/q '[ :find ?color (datascript.test.query-aggregates/sort-reverse ?x) + :in [[?color ?x]]] + data)) + result))]) + )))) diff --git a/test/datascript/test/query_find_specs.cljc b/test/datascript/test/query_find_specs.cljc index de064368..533d7956 100644 --- a/test/datascript/test/query_find_specs.cljc +++ b/test/datascript/test/query_find_specs.cljc @@ -1,51 +1,54 @@ (ns datascript.test.query-find-specs (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] [datascript.test.core :as tdc])) -(def *test-db - (delay - (d/db-with - (d/empty-db) - [[:db/add 1 :name "Petr"] - [:db/add 1 :age 44] - [:db/add 2 :name "Ivan"] - [:db/add 2 :age 25] - [:db/add 3 :name "Sergey"] - [:db/add 3 :age 11]]))) +(def test-db (d/db-with + (d/empty-db) + [[:db/add 1 :name "Petr"] + [:db/add 1 :age 44] + [:db/add 2 :name "Ivan"] + [:db/add 2 :age 25] + [:db/add 3 :name "Sergey"] + [:db/add 3 :age 11]])) (deftest test-find-specs (is (= (set (d/q '[:find [?name ...] - :where [_ :name ?name]] @*test-db)) - #{"Ivan" "Petr" "Sergey"})) + :where [_ :name ?name]] test-db)) + #{"Ivan" "Petr" "Sergey"})) (is (= (d/q '[:find [?name ?age] :where [1 :name ?name] - [1 :age ?age]] @*test-db) - ["Petr" 44])) + [1 :age ?age]] test-db) + ["Petr" 44])) (is (= (d/q '[:find ?name . - :where [1 :name ?name]] @*test-db) - "Petr")) + :where [1 :name ?name]] test-db) + "Petr")) (testing "Multiple results get cut" (is (contains? #{["Petr" 44] ["Ivan" 25] ["Sergey" 11]} (d/q '[:find [?name ?age] :where [?e :name ?name] - [?e :age ?age]] @*test-db))) + [?e :age ?age]] test-db))) (is (contains? #{"Ivan" "Petr" "Sergey"} (d/q '[:find ?name . - :where [_ :name ?name]] @*test-db)))) + :where [_ :name ?name]] test-db)))) (testing "Aggregates work with find specs" (is (= (d/q '[:find [(count ?name) ...] - :where [_ :name ?name]] @*test-db) - [3])) + :where [_ :name ?name]] test-db) + [3])) (is (= (d/q '[:find [(count ?name)] - :where [_ :name ?name]] @*test-db) - [3])) + :where [_ :name ?name]] test-db) + [3])) (is (= (d/q '[:find (count ?name) . - :where [_ :name ?name]] @*test-db) - 3)))) + :where [_ :name ?name]] test-db) + 3))) +) + +#_(t/test-ns 'datascript.test.query-find-specs) diff --git a/test/datascript/test/query_fns.cljc b/test/datascript/test/query_fns.cljc index 5561ae6b..9215624f 100644 --- a/test/datascript/test/query_fns.cljc +++ b/test/datascript/test/query_fns.cljc @@ -1,251 +1,241 @@ (ns datascript.test.query-fns (:require - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.db :as db] - [datascript.test.core :as tdc]) - #?(:clj - (:import - [clojure.lang ExceptionInfo]))) + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + [datascript.core :as d] + [datascript.db :as db] + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]]) + #?(:cljd (:require [cljd.core :refer [ExceptionInfo]]) + :clj + (:import [clojure.lang ExceptionInfo]))) (deftest test-query-fns (testing "predicate without free variables" (is (= (d/q '[:find ?x :in [?x ...] :where [(> 2 1)]] [:a :b :c]) - #{[:a] [:b] [:c]}))) + #{[:a] [:b] [:c]}))) (let [db (-> (d/empty-db {:parent {:db/valueType :db.type/ref}}) - (d/db-with [{:db/id 1, :name "Ivan", :age 15} - {:db/id 2, :name "Petr", :age 22, :height 240, :parent 1} - {:db/id 3, :name "Slava", :age 37, :parent 2}]))] + (d/db-with [ { :db/id 1, :name "Ivan", :age 15 } + { :db/id 2, :name "Petr", :age 22, :height 240, :parent 1} + { :db/id 3, :name "Slava", :age 37, :parent 2}]))] (testing "ground" (is (= (d/q '[:find ?vowel :where [(ground [:a :e :i :o :u]) [?vowel ...]]]) - #{[:a] [:e] [:i] [:o] [:u]}))) + #{[:a] [:e] [:i] [:o] [:u]}))) (testing "get-else" (is (= (d/q '[:find ?e ?age ?height :where [?e :age ?age] - [(get-else $ ?e :height 300) ?height]] db) - #{[1 15 300] [2 22 240] [3 37 300]})) - + [(get-else $ ?e :height 300) ?height]] db) + #{[1 15 300] [2 22 240] [3 37 300]})) + (is (thrown-with-msg? ExceptionInfo #"get-else: nil default value is not supported" (d/q '[:find ?e ?height - :where [?e :age] - [(get-else $ ?e :height nil) ?height]] db)))) + :where [?e :age] + [(get-else $ ?e :height nil) ?height]] db)))) (testing "get-some" (is (= (d/q '[:find ?e ?a ?v :where [?e :name _] - [(get-some $ ?e :height :age) [?a ?v]]] db) - #{[1 :age 15] - [2 :height 240] - [3 :age 37]}))) + [(get-some $ ?e :height :age) [?a ?v]]] db) + #{[1 :age 15] + [2 :height 240] + [3 :age 37]}))) (testing "missing?" (is (= (d/q '[:find ?e ?age :in $ :where [?e :age ?age] - [(missing? $ ?e :height)]] db) - #{[1 15] [3 37]}))) + [(missing? $ ?e :height)]] db) + #{[1 15] [3 37]}))) (testing "missing? back-ref" (is (= (d/q '[:find ?e :in $ :where [?e :age ?age] [(missing? $ ?e :_parent)]] db) - #{[3]}))) + #{[3]}))) (testing "Built-ins" (is (= (d/q '[:find ?e1 ?e2 :where [?e1 :age ?a1] - [?e2 :age ?a2] - [(< ?a1 18 ?a2)]] db) - #{[1 2] [1 3]})) - (is (= (d/q '[:find ?a1 - :where [_ :age ?a1] - [(< ?a1 22)]] db) - #{[15]})) - (is (= (d/q '[:find ?a1 - :where [_ :age ?a1] - [(<= ?a1 22)]] db) - #{[15] [22]})) - (is (= (d/q '[:find ?a1 - :where [_ :age ?a1] - [(> ?a1 22)]] db) - #{[37]})) - (is (= (d/q '[:find ?a1 - :where [_ :age ?a1] - [(>= ?a1 22)]] db) - #{[22] [37]})) - - (testing "compare values of different types" - (is (= (d/q '[:find ?e - :where [?e] - [(< ?e 1)]] [[0] [1] [""]]) - #{[0]})) - (is (= (d/q '[:find ?e - :where [?e] - [(<= ?e 1)]] [[0] [1] [""]]) - #{[0] [1]})) - (is (= (d/q '[:find ?e - :where [?e] - [(> ?e 1)]] [[0] [1] [""]]) - #{[""]})) - (is (= (d/q '[:find ?e - :where [?e] - [(>= ?e 1)]] [[0] [1] [""]]) - #{[1] [""]}))) - + [?e2 :age ?a2] + [(< ?a1 18 ?a2)]] db) + #{[1 2] [1 3]})) + (is (= (d/q '[:find ?a1 + :where [_ :age ?a1] + [(< ?a1 22)]] db) + #{[15]})) + (is (= (d/q '[:find ?a1 + :where [_ :age ?a1] + [(<= ?a1 22)]] db) + #{[15] [22]})) + (is (= (d/q '[:find ?a1 + :where [_ :age ?a1] + [(> ?a1 22)]] db) + #{[37]})) + (is (= (d/q '[:find ?a1 + :where [_ :age ?a1] + [(>= ?a1 22)]] db) + #{[22] [37]})) + (testing "compare values of different types" + (let [inputs [[0] [1] [""]] + expect (fn [op v] + (set (filter (fn [[x]] (op (db/value-compare x v) 0)) inputs)))] + (is (= (d/q '[:find ?e + :where [?e] + [(< ?e 1)]] inputs) + (expect < 1))) + (is (= (d/q '[:find ?e + :where [?e] + [(<= ?e 1)]] inputs) + (expect <= 1))) + (is (= (d/q '[:find ?e + :where [?e] + [(> ?e 1)]] inputs) + (expect > 1))) + (is (= (d/q '[:find ?e + :where [?e] + [(>= ?e 1)]] inputs) + (expect >= 1))))) + (is (= (d/q '[:find ?x ?c :in [?x ...] :where [(count ?x) ?c]] - ["a" "abc"]) - #{["a" 1] ["abc" 3]}))) + ["a" "abc"]) + #{["a" 1] ["abc" 3]}))) (testing "Built-in vector, hashmap" (is (= (d/q '[:find [?tx-data ...] :where [(ground :db/add) ?op] [(vector ?op -1 :attr 12) ?tx-data]]) - [[:db/add -1 :attr 12]])) + [[:db/add -1 :attr 12]])) (is (= (d/q '[:find [?tx-data ...] :where [(hash-map :db/id -1 :age 92 :name "Aaron") ?tx-data]]) - [{:db/id -1 :age 92 :name "Aaron"}]))) + [{:db/id -1 :age 92 :name "Aaron"}]))) + (testing "Passing predicate as source" (is (= (d/q '[:find ?e :in $ ?adult :where [?e :age ?a] - [(?adult ?a)]] - db - #(> % 18)) - #{[2] [3]}))) + [(?adult ?a)]] + db + #(> % 18)) + #{[2] [3]}))) (testing "Calling a function" (is (= (d/q '[:find ?e1 ?e2 ?e3 :where [?e1 :age ?a1] - [?e2 :age ?a2] - [?e3 :age ?a3] - [(+ ?a1 ?a2) ?a12] - [(= ?a12 ?a3)]] - db) - #{[1 2 3] [2 1 3]}))) + [?e2 :age ?a2] + [?e3 :age ?a3] + [(+ ?a1 ?a2) ?a12] + [(= ?a12 ?a3)]] + db) + #{[1 2 3] [2 1 3]}))) (testing "Two conflicting function values for one binding." (is (= (d/q '[:find ?n - :where - [(identity 1) ?n] - [(identity 2) ?n]]) - #{}))) + :where [(identity 1) ?n] + [(identity 2) ?n]]) + #{}))) (testing "Destructured conflicting function values for two bindings." (is (= (d/q '[:find ?n ?x - :where - [(identity [3 4]) [?n ?x]] - [(identity [1 2]) [?n ?x]]]) - #{}))) + :where [(identity [3 4]) [?n ?x]] + [(identity [1 2]) [?n ?x]]]) + #{}))) (testing "Rule bindings interacting with function binding. (fn, rule)" (is (= (d/q '[:find ?n :in $ % - :where - [(identity 2) ?n] + :where [(identity 2) ?n] (my-vals ?n)] - db - '[[(my-vals ?x) - [(identity 1) ?x]] - [(my-vals ?x) - [(identity 2) ?x]] - [(my-vals ?x) - [(identity 3) ?x]]]) - #{[2]}))) + db + '[[(my-vals ?x) + [(identity 1) ?x]] + [(my-vals ?x) + [(identity 2) ?x]] + [(my-vals ?x) + [(identity 3) ?x]]]) + #{[2]}))) (testing "Rule bindings interacting with function binding. (rule, fn)" (is (= (d/q '[:find ?n :in $ % :where (my-vals ?n) [(identity 2) ?n]] - db - '[[(my-vals ?x) - [(identity 1) ?x]] - [(my-vals ?x) - [(identity 2) ?x]] - [(my-vals ?x) - [(identity 3) ?x]]]) - #{[2]}))) + db + '[[(my-vals ?x) + [(identity 1) ?x]] + [(my-vals ?x) + [(identity 2) ?x]] + [(my-vals ?x) + [(identity 3) ?x]]]) + #{[2]}))) (testing "Conflicting relational bindings with function binding. (rel, fn)" (is (= (d/q '[:find ?age :where [_ :age ?age] - [(identity 100) ?age]] - db) - #{}))) + [(identity 100) ?age]] + db) + #{}))) (testing "Conflicting relational bindings with function binding. (fn, rel)" (is (= (d/q '[:find ?age :where [(identity 100) ?age] - [_ :age ?age]] - db) - #{}))) + [_ :age ?age]] + db) + #{}))) (testing "Function on empty rel" (is (= (d/q '[:find ?e ?y :where [?e :salary ?x] - [(+ ?x 100) ?y]] - [[0 :age 15] [1 :age 35]]) - #{}))) - + [(+ ?x 100) ?y]] + [[0 :age 15] [1 :age 35]]) + #{}))) + (testing "Returning nil from function filters out tuple from result" (is (= (d/q '[:find ?x :in [?in ...] ?f :where [(?f ?in) ?x]] - [1 2 3 4] - #(when (even? %) %)) - #{[2] [4]}))) + [1 2 3 4] + #(when (even? %) %)) + #{[2] [4]}))) (testing "Result bindings" (is (= (d/q '[:find ?a ?c :in ?in :where [(ground ?in) [?a _ ?c]]] - [:a :b :c]) - #{[:a :c]})) + [:a :b :c]) + #{[:a :c]})) (is (= (d/q '[:find ?in :in ?in :where [(ground ?in) _]] - :a) - #{[:a]})) + :a) + #{[:a]})) (is (= (d/q '[:find ?x ?z :in ?in :where [(ground ?in) [[?x _ ?z]...]]] - [[:a :b :c] [:d :e :f]]) - #{[:a :c] [:d :f]})) - + [[:a :b :c] [:d :e :f]]) + #{[:a :c] [:d :f]})) + (is (= (d/q '[:find ?in :in [?in ...] :where [(ground ?in) _]] - []) - #{}))))) - -;; issue-490 -(deftest test-fn-call-results-unification - (is (= #{[[:a :a] :a]} - (d/q '[:find ?pair ?x - :in $ ?first ?second - :where - [_ _ ?pair] - [(?first ?pair) ?x] - [(?second ?pair) ?x]] - [[1 :pair [:a :a]] - [2 :pair [:b :c]]] - first - second)))) + []) + #{}))) +)) + (deftest test-predicates (let [entities [{:db/id 1 :name "Ivan" :age 10} @@ -257,64 +247,65 @@ ;; plain predicate [:find ?e ?a :where [?e :age ?a] - [(> ?a 10)]] + [(> ?a 10)]] #{[2 20] [4 20]} ;; join in predicate [:find ?e ?e2 :where [?e :name] - [?e2 :name] - [(< ?e ?e2)]] + [?e2 :name] + [(< ?e ?e2)]] #{[1 2] [1 3] [1 4] [2 3] [2 4] [3 4]} - + ;; join with extra symbols [:find ?e ?e2 :where [?e :age ?a] - [?e2 :age ?a2] - [(< ?e ?e2)]] + [?e2 :age ?a2] + [(< ?e ?e2)]] #{[1 2] [1 3] [1 4] [2 3] [2 4] [3 4]} ;; empty result [:find ?e ?e2 :where [?e :name "Ivan"] - [?e2 :name "Oleg"] - [(= ?e ?e2)]] + [?e2 :name "Oleg"] + [(= ?e ?e2)]] #{} ;; pred over const, true [:find ?e :where [?e :name "Ivan"] - [?e :age 20] - [(= ?e 2)]] + [?e :age 20] + [(= ?e 2)]] #{[2]} ;; pred over const, false [:find ?e :where [?e :name "Ivan"] - [?e :age 20] - [(= ?e 1)]] + [?e :age 20] + [(= ?e 1)]] #{}) (let [pred (fn [db e a] (= a (:age (d/entity db e))))] (is (= (d/q '[:find ?e :in $ ?pred :where [?e :age ?a] - [(?pred $ ?e 10)]] - db pred) - #{[1] [3]}))))) + [(?pred $ ?e 10)]] + db pred) + #{[1] [3]}))))) + (deftest test-exceptions (is (thrown-msg? "Unknown predicate 'fun in [(fun ?e)]" (d/q '[:find ?e :in [?e ...] :where [(fun ?e)]] - [1]))) - + [1]))) + (is (thrown-msg? "Unknown function 'fun in [(fun ?e) ?x]" (d/q '[:find ?e ?x :in [?e ...] :where [(fun ?e) ?x]] - [1]))) + [1]))) (is (thrown-msg? "Insufficient bindings: #{?x} not bound in [(zero? ?x)]" (d/q '[:find ?x @@ -330,41 +321,42 @@ (is (thrown-msg? "Where uses unknown source vars: [$]" (d/q '[:find ?x - :in $2 + :in $2 :where [$2 ?x] [(zero? $ ?x)]])))) (deftest test-issue-180 (is (= #{} - (d/q '[:find ?e ?a - :where [_ :pred ?pred] - [?e :age ?a] - [(?pred ?a)]] - (d/db-with (d/empty-db) [[:db/add 1 :age 20]]))))) + (d/q '[:find ?e ?a + :where [_ :pred ?pred] + [?e :age ?a] + [(?pred ?a)]] + (d/db-with (d/empty-db) [[:db/add 1 :age 20]]))))) + +(defn sample-query-fn [] 42) -(defn sample-query-fn [] - 42) +#?(:cljd nil + :clj +(deftest test-symbol-resolution + (is (= 42 (d/q '[:find ?x . + :where [(datascript.test.query-fns/sample-query-fn) ?x]]))))) -#?(:clj - (deftest test-symbol-resolution - (is (= 42 (d/q '[:find ?x . - :where [(datascript.test.query-fns/sample-query-fn) ?x]]))))) (deftest test-issue-445 (let [db (-> (d/empty-db {:name {:db/unique :db.unique/identity}}) - (d/db-with [{:db/id 1 :name "Ivan" :age 15} - {:db/id 2 :name "Petr" :age 22 :height 240}]))] + (d/db-with [{:db/id 1 :name "Ivan" :age 15} + {:db/id 2 :name "Petr" :age 22 :height 240}]))] (testing "get-else using lookup ref" (is (= "Unknown" - (d/q '[:find ?height . - :in $ ?e - :where [(get-else $ ?e :height "Unknown") ?height]] - db - [:name "Ivan"])))) + (d/q '[:find ?height . + :in $ ?e + :where [(get-else $ ?e :height "Unknown") ?height]] + db + [:name "Ivan"])))) (testing "get-some using lookup ref" (is (= #{[[:name "Petr"] :age 22]} - (d/q '[:find ?e ?a ?v - :in $ ?e - :where [(get-some $ ?e :weight :age :height) [?a ?v]]] - db - [:name "Petr"])))))) + (d/q '[:find ?e ?a ?v + :in $ ?e + :where [(get-some $ ?e :weight :age :height) [?a ?v]]] + db + [:name "Petr"])))))) diff --git a/test/datascript/test/query_not.cljc b/test/datascript/test/query_not.cljc index 9855f5a6..5faa82ec 100644 --- a/test/datascript/test/query_not.cljc +++ b/test/datascript/test/query_not.cljc @@ -1,127 +1,125 @@ (ns datascript.test.query-not (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] - [datascript.test.core :as tdc]) - #?(:clj - (:import - [clojure.lang ExceptionInfo]))) + #?(:cljd [cljd.core :refer [ExceptionInfo]]) + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]])) -(def *test-db + +(def test-db (delay (d/db-with (d/empty-db) - [{:db/id 1 :name "Ivan" :age 10} - {:db/id 2 :name "Ivan" :age 20} - {:db/id 3 :name "Oleg" :age 10} - {:db/id 4 :name "Oleg" :age 20} - {:db/id 5 :name "Ivan" :age 10} - {:db/id 6 :name "Ivan" :age 20}]))) + [ {:db/id 1 :name "Ivan" :age 10} + {:db/id 2 :name "Ivan" :age 20} + {:db/id 3 :name "Oleg" :age 10} + {:db/id 4 :name "Oleg" :age 20} + {:db/id 5 :name "Ivan" :age 10} + {:db/id 6 :name "Ivan" :age 20} ]))) + (deftest test-not - (are [q res] (= (set (d/q (concat '[:find [?e ...] :where] (quote q)) @*test-db)) - res) + (are [q res] (= (set (d/q (concat '[:find [?e ...] :where] (quote q)) @test-db)) + res) [[?e :name] (not [?e :name "Ivan"])] #{3 4} - + [[?e :name] (not [?e :name "Ivan"] [?e :age 10])] #{2 3 4 6} - + [[?e :name] (not [?e :name "Ivan"]) (not [?e :age 10])] #{4} - + ;; full exclude [[?e :name] (not [?e :age])] #{} - + ;; not-intersecting rels [[?e :name "Ivan"] (not [?e :name "Oleg"])] #{1 2 5 6} - + ;; exclude empty set [[?e :name] - (not - [?e :name "Ivan"] - [?e :name "Oleg"])] + (not [?e :name "Ivan"] + [?e :name "Oleg"])] #{1 2 3 4 5 6} - + ;; nested excludes [[?e :name] (not [?e :name "Ivan"] - (not [?e :age 10]))] + (not [?e :age 10]))] #{1 3 4 5} ;; extra binding in not [[?e :name ?a] (not [?e :age ?f] - [?e :age 10])] - #{2 4 6})) + [?e :age 10])] + #{2 4 6} +)) + (deftest test-not-join - (are [q res] (= res (d/q (concat '[:find ?e ?a :where] (quote q)) @*test-db)) + (are [q res] (= (d/q (concat '[:find ?e ?a :where] (quote q)) @test-db) + res) [[?e :name] [?e :age ?a] (not-join [?e] [?e :name "Oleg"] [?e :age ?a])] #{[1 10] [2 20] [5 10] [6 20]} - + [[?e :age ?a] [?e :age 10] (not-join [?e] [?e :name "Oleg"] [?e :age ?a] [?e :age 10])] - #{[1 10] [5 10]} - - ;; issue-481 - [[?e :age ?a] - (not-join [?a] - [?e :name "Petr"] - [?e :age ?a])] - #{[1 10] [2 20] [3 10] [4 20] [5 10] [6 20]})) - + #{[1 10] [5 10]})) + + (deftest test-default-source (let [db1 (d/db-with (d/empty-db) - [[:db/add 1 :name "Ivan"] - [:db/add 2 :name "Oleg"]]) + [ [:db/add 1 :name "Ivan" ] + [:db/add 2 :name "Oleg"] ]) db2 (d/db-with (d/empty-db) - [[:db/add 1 :age 10] - [:db/add 2 :age 20]])] + [ [:db/add 1 :age 10 ] + [:db/add 2 :age 20] ])] (are [q res] (= (set (d/q (concat '[:find [?e ...] :in $ $2 :where] - (quote q)) - db1 db2)) - res) + (quote q)) + db1 db2)) + res) ;; NOT inherits default source [[?e :name] (not [?e :name "Ivan"])] #{2} - + ;; NOT can reference any source [[?e :name] (not [$2 ?e :age 10])] #{2} - + ;; NOT can change default source [[?e :name] ($2 not [?e :age 10])] #{2} - + ;; even with another default source, it can reference any other source explicitly [[?e :name] ($2 not [$ ?e :name "Ivan"])] #{2} - + ;; nested NOT keeps the default source [[?e :name] ($2 not (not [?e :age 10]))] @@ -132,66 +130,70 @@ ($2 not ($ not [?e :name "Ivan"]))] #{1}))) + (deftest test-impl-edge-cases - (are [q res] (= (d/q (quote q) @*test-db) - res) + (are [q res] (= (d/q (quote q) @test-db) + res) ;; const \ empty [:find ?e :where [?e :name "Oleg"] - [?e :age 10] - (not [?e :age 20])] + [?e :age 10] + (not [?e :age 20])] #{[3]} - + ;; const \ const [:find ?e :where [?e :name "Oleg"] - [?e :age 10] - (not [?e :age 10])] + [?e :age 10] + (not [?e :age 10])] #{} - + ;; rel \ const [:find ?e :where [?e :name "Oleg"] - (not [?e :age 10])] + (not [?e :age 10])] #{[4]} ;; 2 rels \ 2 rels [:find ?e ?e2 :where [?e :name "Ivan"] - [?e2 :name "Ivan"] - (not [?e :age 10] - [?e2 :age 20])] + [?e2 :name "Ivan"] + (not [?e :age 10] + [?e2 :age 20])] #{[2 1] [6 5] [1 1] [2 2] [5 5] [6 6] [2 5] [1 5] [2 6] [6 1] [5 1] [6 2]} ;; 2 rels \ rel + const [:find ?e ?e2 :where [?e :name "Ivan"] - [?e2 :name "Oleg"] - (not [?e :age 10] - [?e2 :age 20])] + [?e2 :name "Oleg"] + (not [?e :age 10] + [?e2 :age 20])] #{[2 3] [1 3] [2 4] [6 3] [5 3] [6 4]} ;; 2 rels \ 2 consts [:find ?e ?e2 - :where [?e :name "Oleg"] - [?e2 :name "Oleg"] - (not [?e :age 10] - [?e2 :age 20])] - #{[4 3] [3 3] [4 4]})) + :where [?e :name "Oleg"] + [?e2 :name "Oleg"] + (not [?e :age 10] + [?e2 :age 20])] + #{[4 3] [3 3] [4 4]} +)) + (deftest test-insufficient-bindings (are [q msg] (thrown-msg? msg - (d/q (concat '[:find ?e :where] (quote q)) @*test-db)) + (d/q (concat '[:find ?e :where] (quote q)) @test-db)) [(not [?e :name "Ivan"]) [?e :name]] "Insufficient bindings: none of #{?e} is bound in (not [?e :name \"Ivan\"])" - + [[?e :name] (not-join [?e] (not [1 :age ?a]) [?e :age ?a])] "Insufficient bindings: none of #{?a} is bound in (not [1 :age ?a])" - + [[?e :name] (not [?a :name "Ivan"])] - "Insufficient bindings: none of #{?a} is bound in (not [?a :name \"Ivan\"])")) + "Insufficient bindings: none of #{?a} is bound in (not [?a :name \"Ivan\"])" +)) diff --git a/test/datascript/test/query_or.cljc b/test/datascript/test/query_or.cljc index 38e51da3..7ae9bbe0 100644 --- a/test/datascript/test/query_or.cljc +++ b/test/datascript/test/query_or.cljc @@ -1,146 +1,130 @@ (ns datascript.test.query-or (:require - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.db :as db] - [datascript.test.core :as tdc]) - #?(:clj - (:import - [clojure.lang ExceptionInfo]))) - -(def *test-db + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + [datascript.core :as d] + [datascript.db :as db] + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]]) + #?(:cljd (:require [cljd.core :refer [ExceptionInfo]]) + :clj + (:import [clojure.lang ExceptionInfo]))) + +(def test-db (delay (d/db-with (d/empty-db) - [{:db/id 1 :name "Ivan" :age 10} - {:db/id 2 :name "Ivan" :age 20} - {:db/id 3 :name "Oleg" :age 10} - {:db/id 4 :name "Oleg" :age 20} - {:db/id 5 :name "Ivan" :age 10} - {:db/id 6 :name "Ivan" :age 20}]))) + [ {:db/id 1 :name "Ivan" :age 10} + {:db/id 2 :name "Ivan" :age 20} + {:db/id 3 :name "Oleg" :age 10} + {:db/id 4 :name "Oleg" :age 20} + {:db/id 5 :name "Ivan" :age 10} + {:db/id 6 :name "Ivan" :age 20} ]))) (deftest test-or - (are [q res] (= (d/q (concat '[:find ?e :where] (quote q)) @*test-db) - (into #{} (map vector) res)) + (are [q res] (= (d/q (concat '[:find ?e :where] (quote q)) @test-db) + (into #{} (map vector) res)) ;; intersecting results [(or [?e :name "Oleg"] - [?e :age 10])] + [?e :age 10])] #{1 3 4 5} - + ;; one branch empty [(or [?e :name "Oleg"] - [?e :age 30])] + [?e :age 30])] #{3 4} - + ;; both empty [(or [?e :name "Petr"] - [?e :age 30])] + [?e :age 30])] #{} - + ;; join with 1 var [[?e :name "Ivan"] (or [?e :name "Oleg"] - [?e :age 10])] + [?e :age 10])] #{1 5} - + ;; join with 2 vars [[?e :age ?a] (or (and [?e :name "Ivan"] - [1 :age ?a]) - (and [?e :name "Oleg"] - [2 :age ?a]))] + [1 :age ?a]) + (and [?e :name "Oleg"] + [2 :age ?a]))] #{1 5 4} ;; OR introduces vars [(or (and [?e :name "Ivan"] - [1 :age ?a]) - (and [?e :name "Oleg"] - [2 :age ?a])) + [1 :age ?a]) + (and [?e :name "Oleg"] + [2 :age ?a])) [?e :age ?a]] #{1 5 4} ;; OR introduces vars in different order [(or (and [?e :name "Ivan"] - [1 :age ?a]) - (and [2 :age ?a] - [?e :name "Oleg"])) + [1 :age ?a]) + (and [2 :age ?a] + [?e :name "Oleg"])) [?e :age ?a]] - #{1 5 4} - - ;; One branch of or short-circuits resolution - [(or - (and [?e :age 30] ; no matches in db - [?e :name ?n]) - (and [?e :age 20] - [?e :name ?n])) - [(ground "Ivan") ?n]] - #{2 6})) + #{1 5 4})) (deftest test-or-join - (are [q res] (= (d/q (concat '[:find ?e :where] (quote q)) @*test-db) - (into #{} (map vector) res)) + (are [q res] (= (d/q (concat '[:find ?e :where] (quote q)) @test-db) + (into #{} (map vector) res)) [(or-join [?e] [?e :name ?n] (and [?e :age ?a] - [?e :name ?n]))] + [?e :name ?n]))] #{1 2 3 4 5 6} - + [[?e :name ?a] [?e2 :name ?a] (or-join [?e] (and [?e :age ?a] - [?e2 :age ?a]))] - #{1 2 3 4 5 6} - - ;; One branch of or-join short-circuits resolution - [(or-join [?e ?n] - (and [?e :age 30] ; no matches in db - [?e :name ?n]) - (and [?e :age 20] - [?e :name ?n])) - [(ground "Ivan") ?n]] - #{2 6}) + [?e2 :age ?a]))] + #{1 2 3 4 5 6}) - ;; issue-348 + ;; #348 (is (= #{[1] [3] [4] [5]} (d/q '[:find ?e :in $ ?a :where (or [?e :age ?a] [?e :name "Oleg"])] - @*test-db 10))) + @test-db 10))) - ;; issue-348 + ;; #348 (is (= #{[1] [3] [4] [5]} (d/q '[:find ?e :in $ ?a :where (or-join [?e ?a] [?e :age ?a] [?e :name "Oleg"])] - @*test-db 10))) + @test-db 10))) - ;; issue-348 + ;; #348 (is (= #{[1] [3] [4] [5]} (d/q '[:find ?e :in $ ?a :where (or-join [[?a] ?e] [?e :age ?a] [?e :name "Oleg"])] - @*test-db 10))) + @test-db 10))) (is (= #{[:a1 :b1 :c1] [:a2 :b2 :c2]} - (d/q '[:find ?a ?b ?c - :in $xs $ys - :where [$xs ?a ?b ?c] ;; check join by ?a, ignoring ?b, dropping ?c ?d - (or-join [?a] - [$ys ?a ?b ?d])] - [[:a1 :b1 :c1] - [:a2 :b2 :c2] - [:a3 :b3 :c3]] - [[:a1 :b1 :d1] ;; same ?a, same ?b - [:a2 :b2* :d2] ;; same ?a, different ?b. Should still be joined - [:a4 :b4 :c4]]))) ;; different ?a, should be dropped + (d/q '[:find ?a ?b ?c + :in $xs $ys + :where [$xs ?a ?b ?c] ;; check join by ?a, ignoring ?b, dropping ?c ?d + (or-join [?a] + [$ys ?a ?b ?d])] + [[:a1 :b1 :c1] + [:a2 :b2 :c2] + [:a3 :b3 :c3]] + [[:a1 :b1 :d1] ;; same ?a, same ?b + [:a2 :b2* :d2] ;; same ?a, different ?b. Should still be joined + [:a4 :b4 :c4]]))) ;; different ?a, should be dropped (is (= #{[:a1 :c1] [:a2 :c2]} (d/q '[:find ?a ?c @@ -148,38 +132,38 @@ :where (or-join [?a ?c] [$xs ?a ?b ?c] ; rel with hole (?b gets dropped, leaving {?a 0 ?c 2} and 3-element tuples) [$ys ?a ?c])] - [[:a1 :b1 :c1]] - [[:a2 :c2]])))) + [[:a1 :b1 :c1]] + [[:a2 :c2]])))) (deftest test-default-source (let [db1 (d/db-with (d/empty-db) - [[:db/add 1 :name "Ivan"] - [:db/add 2 :name "Oleg"]]) + [ [:db/add 1 :name "Ivan" ] + [:db/add 2 :name "Oleg"] ]) db2 (d/db-with (d/empty-db) - [[:db/add 1 :age 10] - [:db/add 2 :age 20]])] + [ [:db/add 1 :age 10 ] + [:db/add 2 :age 20] ])] (are [q res] (= (d/q (concat '[:find ?e :in $ $2 :where] (quote q)) db1 db2) - (into #{} (map vector) res)) + (into #{} (map vector) res)) ;; OR inherits default source [[?e :name] (or [?e :name "Ivan"])] #{1} - + ;; OR can reference any source [[?e :name] (or [$2 ?e :age 10])] #{1} - + ;; OR can change default source [[?e :name] ($2 or [?e :age 10])] #{1} - + ;; even with another default source, it can reference any other source explicitly [[?e :name] ($2 or [$ ?e :name "Ivan"])] #{1} - + ;; nested OR keeps the default source [[?e :name] ($2 or (or [?e :age 10]))] @@ -190,44 +174,16 @@ ($2 or ($ or [?e :name "Ivan"]))] #{1}))) -(deftest ^{:doc "issue-468, issue-469"} test-const-substitution - (let [db (-> (d/empty-db {:parent {:db/valueType :db.type/ref}}) - (d/db-with [{:db/id "Ivan" :name "Ivan"} - {:db/id "Oleg" :name "Oleg" :parent "Ivan"} - {:db/id "Petr" :name "Petr" :parent "Oleg"}]))] - (is (= #{["Ivan" 1 2]} - (d/q '[:find ?name ?x ?y - :in $ ?name - :where - [?x :name ?name] - (or-join [?x ?y] - (and - [?x :parent ?z] - [?z :parent ?y]) - [?y :parent ?x])] - db "Ivan"))) - - (is (= #{} - (d/q '[:find ?name ?x ?y - :in $ ?name - :where - [?x :name ?name] - (or-join [?x ?y] - (and - [?x :parent ?z] - [?z :parent ?y]) - [?x :parent ?y])] - db "Ivan"))))) (deftest test-errors (is (thrown-with-msg? ExceptionInfo #"All clauses in 'or' must use same set of free vars, had \[#\{\?e\} #\{(\?a \?e|\?e \?a)\}\] in \(or \[\?e :name _\] \[\?e :age \?a\]\)" (d/q '[:find ?e :where (or [?e :name _] - [?e :age ?a])] - @*test-db))) + [?e :age ?a])] + @test-db))) (is (thrown-msg? "Insufficient bindings: #{?e} not bound in (or-join [[?e]] [?e :name \"Ivan\"])" (d/q '[:find ?e :where (or-join [[?e]] [?e :name "Ivan"])] - @*test-db)))) + @test-db)))) diff --git a/test/datascript/test/query_pull.cljc b/test/datascript/test/query_pull.cljc index 7518221a..65ce75eb 100644 --- a/test/datascript/test/query_pull.cljc +++ b/test/datascript/test/query_pull.cljc @@ -1,23 +1,23 @@ (ns datascript.test.query-pull (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] [datascript.test.core :as tdc])) -(def *test-db - (delay - (d/db-with (d/empty-db) - [{:db/id 1 :name "Petr" :age 44} - {:db/id 2 :name "Ivan" :age 25} - {:db/id 3 :name "Oleg" :age 11}]))) +(def test-db (d/db-with (d/empty-db) + [{:db/id 1 :name "Petr" :age 44} + {:db/id 2 :name "Ivan" :age 25} + {:db/id 3 :name "Oleg" :age 11}])) (deftest test-basics (are [find res] (= (set (d/q {:find find :where '[[?e :age ?a] [(>= ?a 18)]]} - @*test-db)) - res) + test-db)) + res) '[(pull ?e [:name])] #{[{:name "Ivan"}] [{:name "Petr"}]} @@ -38,25 +38,25 @@ :in '[$ ?pattern] :where '[[?e :age ?a] [(>= ?a 18)]]} - @*test-db pattern)) - res) + test-db pattern)) + res) '[(pull ?e ?pattern)] [:name] #{[{:name "Ivan"}] [{:name "Petr"}]} - + '[?e ?a ?pattern (pull ?e ?pattern)] [:name] #{[2 25 [:name] {:name "Ivan"}] [1 44 [:name] {:name "Petr"}]})) ;; not supported #_(deftest test-multi-pattern - (is (= (set (d/q '[:find ?e ?p (pull ?e ?p) - :in $ [?p ...] - :where [?e :age ?a] - [>= ?a 18]] - @*test-db [[:name] [:age]])) - #{[2 [:name] {:name "Ivan"}] - [2 [:age] {:age 25}] - [1 [:name] {:name "Petr"}] - [1 [:age] {:age 44}]}))) + (is (= (set (d/q '[:find ?e ?p (pull ?e ?p) + :in $ [?p ...] + :where [?e :age ?a] + [>= ?a 18]] + test-db [[:name] [:age]])) + #{[2 [:name] {:name "Ivan"}] + [2 [:age] {:age 25}] + [1 [:name] {:name "Petr"}] + [1 [:age] {:age 44}]}))) (deftest test-multiple-sources (let [db1 (d/db-with (d/empty-db) [{:db/id 1 :name "Ivan" :age 25}]) @@ -64,49 +64,49 @@ (is (= (set (d/q '[:find ?e (pull $1 ?e [:name]) :in $1 $2 :where [$1 ?e :age 25]] - db1 db2)) - #{[1 {:name "Ivan"}]})) - + db1 db2)) + #{[1 {:name "Ivan"}]})) + (is (= (set (d/q '[:find ?e (pull $2 ?e [:name]) :in $1 $2 :where [$2 ?e :age 25]] - db1 db2)) - #{[1 {:name "Petr"}]})) - + db1 db2)) + #{[1 {:name "Petr"}]})) + (testing "$ is default source" (is (= (set (d/q '[:find ?e (pull ?e [:name]) :in $1 $ :where [$ ?e :age 25]] - db1 db2)) - #{[1 {:name "Petr"}]}))))) + db1 db2)) + #{[1 {:name "Petr"}]}))))) (deftest test-find-spec (is (= (d/q '[:find (pull ?e [:name]) . :where [?e :age 25]] - @*test-db) - {:name "Ivan"})) - + test-db) + {:name "Ivan"})) + (is (= (set (d/q '[:find [(pull ?e [:name]) ...] :where [?e :age ?a]] - @*test-db)) - #{{:name "Ivan"} {:name "Petr"} {:name "Oleg"}})) + test-db)) + #{{:name "Ivan"} {:name "Petr"} {:name "Oleg"}})) (is (= (d/q '[:find [?e (pull ?e [:name])] :where [?e :age 25]] - @*test-db) - [2 {:name "Ivan"}]))) + test-db) + [2 {:name "Ivan"}]))) (deftest test-find-spec-input (is (= (d/q '[:find (pull ?e ?p) . :in $ ?p :where [(ground 2) ?e]] - @*test-db [:name]) - {:name "Ivan"})) + test-db [:name]) + {:name "Ivan"})) (is (= (d/q '[:find (pull ?e p) . :in $ p :where [(ground 2) ?e]] - @*test-db [:name]) - {:name "Ivan"}))) + test-db [:name]) + {:name "Ivan"}))) (deftest test-aggregates (let [db (d/db-with (d/empty-db {:value {:db/cardinality :db.cardinality/many}}) @@ -115,20 +115,20 @@ {:db/id 3 :name "Oleg" :value 1}])] (is (= (set (d/q '[:find ?e (pull ?e [:name]) (min ?v) (max ?v) :where [?e :value ?v]] - db)) - #{[1 {:name "Petr"} 10 40] - [2 {:name "Ivan"} 14 16] - [3 {:name "Oleg"} 1 1]})))) + db)) + #{[1 {:name "Petr"} 10 40] + [2 {:name "Ivan"} 14 16] + [3 {:name "Oleg"} 1 1]})))) (deftest test-lookup-refs - (let [db (d/db-with (d/empty-db {:name {:db/unique :db.unique/identity}}) + (let [db (d/db-with (d/empty-db {:name { :db/unique :db.unique/identity }}) [{:db/id 1 :name "Petr" :age 44} {:db/id 2 :name "Ivan" :age 25} {:db/id 3 :name "Oleg" :age 11}])] (is (= (set (d/q '[:find ?ref ?a (pull ?ref [:db/id :name]) :in $ [?ref ...] :where [?ref :age ?a] - [(>= ?a 18)]] - db [[:name "Ivan"] [:name "Oleg"] [:name "Petr"]])) - #{[[:name "Petr"] 44 {:db/id 1 :name "Petr"}] - [[:name "Ivan"] 25 {:db/id 2 :name "Ivan"}]})))) + [(>= ?a 18)]] + db [[:name "Ivan"] [:name "Oleg"] [:name "Petr"]])) + #{[[:name "Petr"] 44 {:db/id 1 :name "Petr"}] + [[:name "Ivan"] 25 {:db/id 2 :name "Ivan"}]})))) diff --git a/test/datascript/test/query_return_map.cljc b/test/datascript/test/query_return_map.cljc index 90ffa248..ee8cb41a 100644 --- a/test/datascript/test/query_return_map.cljc +++ b/test/datascript/test/query_return_map.cljc @@ -1,46 +1,45 @@ (ns datascript.test.query-return-map (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] [datascript.test.core :as tdc])) -(def *test-db - (delay - (d/db-with (d/empty-db) - [[:db/add 1 :name "Petr"] - [:db/add 1 :age 44] - [:db/add 2 :name "Ivan"] - [:db/add 2 :age 25] - [:db/add 3 :name "Sergey"] - [:db/add 3 :age 11]]))) +(def test-db + (d/db-with (d/empty-db) + [[:db/add 1 :name "Petr"] + [:db/add 1 :age 44] + [:db/add 2 :name "Ivan"] + [:db/add 2 :age 25] + [:db/add 3 :name "Sergey"] + [:db/add 3 :age 11]])) (deftest test-find-specs (is (= (d/q '[:find ?name ?age :keys n a :where [?e :name ?name] - [?e :age ?age]] - @*test-db) + [?e :age ?age]] + test-db) #{{:n "Petr" :a 44} {:n "Ivan" :a 25} {:n "Sergey" :a 11}})) (is (= (d/q '[:find ?name ?age :syms n a :where [?e :name ?name] - [?e :age ?age]] - @*test-db) + [?e :age ?age]] + test-db) #{{'n "Petr" 'a 44} {'n "Ivan" 'a 25} {'n "Sergey" 'a 11}})) (is (= (d/q '[:find ?name ?age :strs n a :where [?e :name ?name] - [?e :age ?age]] - @*test-db) + [?e :age ?age]] + test-db) #{{"n" "Petr" "a" 44} {"n" "Ivan" "a" 25} {"n" "Sergey" "a" 11}})) (is (= (d/q '[:find [?name ?age] :keys n a :where [?e :name ?name] - [(= ?name "Ivan")] - [?e :age ?age]] - @*test-db) + [(= ?name "Ivan")] + [?e :age ?age]] + test-db) {:n "Ivan" :a 25}))) - - diff --git a/test/datascript/test/query_rules.cljc b/test/datascript/test/query_rules.cljc index cde21f11..fb746802 100644 --- a/test/datascript/test/query_rules.cljc +++ b/test/datascript/test/query_rules.cljc @@ -1,109 +1,112 @@ (ns datascript.test.query-rules (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] - [datascript.test.core :as tdc])) + #?(:cljd [cljd.core :refer [ExceptionInfo]]) + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]])) (deftest test-rules (let [db [ [5 :follow 3] [1 :follow 2] [2 :follow 3] [3 :follow 4] [4 :follow 6] - [2 :follow 4]]] + [2 :follow 4]]] (is (= (d/q '[:find ?e1 ?e2 :in $ % :where (follow ?e1 ?e2)] - db - '[[(follow ?x ?y) - [?x :follow ?y]]]) - #{[1 2] [2 3] [3 4] [2 4] [5 3] [4 6]})) - + db + '[[(follow ?x ?y) + [?x :follow ?y]]]) + #{[1 2] [2 3] [3 4] [2 4] [5 3] [4 6]})) + (testing "Joining regular clauses with rule" (is (= (d/q '[:find ?y ?x :in $ % :where [_ _ ?x] - (rule ?x ?y) - [(even? ?x)]] - db - '[[(rule ?a ?b) - [?a :follow ?b]]]) - #{[3 2] [6 4] [4 2]}))) - + (rule ?x ?y) + [(even? ?x)]] + db + '[[(rule ?a ?b) + [?a :follow ?b]]]) + #{[3 2] [6 4] [4 2]}))) + (testing "Rule context is isolated from outer context" (is (= (d/q '[:find ?x :in $ % :where [?e _ _] - (rule ?x)] - db - '[[(rule ?e) - [_ ?e _]]]) - #{[:follow]}))) + (rule ?x)] + db + '[[(rule ?e) + [_ ?e _]]]) + #{[:follow]}))) (testing "Rule with branches" (is (= (d/q '[:find ?e2 :in $ ?e1 % :where (follow ?e1 ?e2)] - db - 1 - '[[(follow ?e2 ?e1) - [?e2 :follow ?e1]] - [(follow ?e2 ?e1) - [?e2 :follow ?t] - [?t :follow ?e1]]]) - #{[2] [3] [4]}))) + db + 1 + '[[(follow ?e2 ?e1) + [?e2 :follow ?e1]] + [(follow ?e2 ?e1) + [?e2 :follow ?t] + [?t :follow ?e1]]]) + #{[2] [3] [4]}))) (testing "Recursive rules" (is (= (d/q '[:find ?e2 :in $ ?e1 % :where (follow ?e1 ?e2)] - db - 1 - '[[(follow ?e1 ?e2) - [?e1 :follow ?e2]] - [(follow ?e1 ?e2) - [?e1 :follow ?t] - (follow ?t ?e2)]]) - #{[2] [3] [4] [6]})) + db + 1 + '[[(follow ?e1 ?e2) + [?e1 :follow ?e2]] + [(follow ?e1 ?e2) + [?e1 :follow ?t] + (follow ?t ?e2)]]) + #{[2] [3] [4] [6]})) (is (= (d/q '[:find ?e1 ?e2 - :in $ % - :where (follow ?e1 ?e2)] - [[1 :follow 2] [2 :follow 3]] - '[[(follow ?e1 ?e2) - [?e1 :follow ?e2]] - [(follow ?e1 ?e2) - (follow ?e2 ?e1)]]) - #{[1 2] [2 3] [2 1] [3 2]})) + :in $ % + :where (follow ?e1 ?e2)] + [[1 :follow 2] [2 :follow 3]] + '[[(follow ?e1 ?e2) + [?e1 :follow ?e2]] + [(follow ?e1 ?e2) + (follow ?e2 ?e1)]]) + #{[1 2] [2 3] [2 1] [3 2]})) (is (= (d/q '[:find ?e1 ?e2 - :in $ % - :where (follow ?e1 ?e2)] - [[1 :follow 2] [2 :follow 3] [3 :follow 1]] - '[[(follow ?e1 ?e2) - [?e1 :follow ?e2]] - [(follow ?e1 ?e2) - (follow ?e2 ?e1)]]) - #{[1 2] [2 3] [3 1] [2 1] [3 2] [1 3]}))) + :in $ % + :where (follow ?e1 ?e2)] + [[1 :follow 2] [2 :follow 3] [3 :follow 1]] + '[[(follow ?e1 ?e2) + [?e1 :follow ?e2]] + [(follow ?e1 ?e2) + (follow ?e2 ?e1)]]) + #{[1 2] [2 3] [3 1] [2 1] [3 2] [1 3]}))) (testing "Mutually recursive rules" (is (= (d/q '[:find ?e1 ?e2 :in $ % :where (f1 ?e1 ?e2)] - [[0 :f1 1] - [1 :f2 2] - [2 :f1 3] - [3 :f2 4] - [4 :f1 5] - [5 :f2 6]] - '[[(f1 ?e1 ?e2) - [?e1 :f1 ?e2]] - [(f1 ?e1 ?e2) - [?t :f1 ?e2] - (f2 ?e1 ?t)] - [(f2 ?e1 ?e2) - [?e1 :f2 ?e2]] - [(f2 ?e1 ?e2) - [?t :f2 ?e2] - (f1 ?e1 ?t)]]) + [[0 :f1 1] + [1 :f2 2] + [2 :f1 3] + [3 :f2 4] + [4 :f1 5] + [5 :f2 6]] + '[[(f1 ?e1 ?e2) + [?e1 :f1 ?e2]] + [(f1 ?e1 ?e2) + [?t :f1 ?e2] + (f2 ?e1 ?t)] + [(f2 ?e1 ?e2) + [?e1 :f2 ?e2]] + [(f2 ?e1 ?e2) + [?t :f2 ?e2] + (f1 ?e1 ?t)]]) #{[0 1] [0 3] [0 5] [1 3] [1 5] [2 3] [2 5] @@ -115,51 +118,52 @@ :in $ % ?even :where (match ?even ?x ?y)] - db - '[[(match ?pred ?e ?e2) - [?e :follow ?e2] - [(?pred ?e)] - [(?pred ?e2)]]] - even?) - #{[4 6] [2 4]}))) - + db + '[[(match ?pred ?e ?e2) + [?e :follow ?e2] + [(?pred ?e)] + [(?pred ?e2)]]] + even?) + #{[4 6] [2 4]}))) + (testing "Using built-ins inside rule" (is (= (d/q '[:find ?x ?y :in $ % :where (match ?x ?y)] - db - '[[(match ?e ?e2) - [?e :follow ?e2] - [(even? ?e)] - [(even? ?e2)]]]) - #{[4 6] [2 4]}))) - (testing "Calling rule twice (issue-44)" + db + '[[(match ?e ?e2) + [?e :follow ?e2] + [(even? ?e)] + [(even? ?e2)]]]) + #{[4 6] [2 4]}))) + (testing "Calling rule twice (#44)" (d/q '[:find ?p :in $ % ?fn :where (rule ?p ?fn "a") - (rule ?p ?fn "b")] - [[1 :attr "a"]] - '[[(rule ?p ?fn ?x) - [?p :attr ?x] - [(?fn ?x)]]] - (constantly true)))) + (rule ?p ?fn "b")] + [[1 :attr "a"]] + '[[(rule ?p ?fn ?x) + [?p :attr ?x] + [(?fn ?x)]]] + (constantly true))) + ) (testing "Specifying db to rule" (is (= (d/q '[:find ?n :in $sexes $ages % :where ($sexes male ?n) - ($ages adult ?n)] - [["Ivan" :male] ["Darya" :female] ["Oleg" :male] ["Igor" :male]] - [["Ivan" 15] ["Oleg" 66] ["Darya" 32]] - '[[(male ?x) - [?x :male]] - [(adult ?y) - [?y ?a] - [(>= ?a 18)]]]) - #{["Oleg"]}))) + ($ages adult ?n) ] + [["Ivan" :male] ["Darya" :female] ["Oleg" :male] ["Igor" :male]] + [["Ivan" 15] ["Oleg" 66] ["Darya" 32]] + '[[(male ?x) + [?x :male]] + [(adult ?y) + [?y ?a] + [(>= ?a 18)]]]) + #{["Oleg"]}))) - (testing "Rule name validation issue-319" + (testing "Rule name validation #319" (is (thrown-msg? "Unknown rule 'wat in (wat ?x)" (d/q '[:find ?x :in $ % @@ -167,15 +171,15 @@ [] [])))) (testing "Rule vars validation" - (is (thrown-msg? "Cannot parse var, expected symbol starting with ?, got: $e1" ;; issue-300 - (d/q '[:find ?e :in $ % :where [?e]] - (d/empty-db) - '[[(rule $e1 ?e2) - [?e1 :ref ?e2]]]))))) + (is (thrown-msg? "Cannot parse var, expected symbol starting with ?, got: $e1" ;; #300 + (d/q '[:find ?e :in $ % :where [?e]] + (d/empty-db) + '[[(rule $e1 ?e2) + [?e1 :ref ?e2]]]))))) -;; issue-218 +;; https://github.com/tonsky/datascript/issues/218 (deftest test-false-arguments - (let [db (d/db-with (d/empty-db) + (let [db (d/db-with (d/empty-db) [[:db/add 1 :attr true] [:db/add 2 :attr false]]) rules '[[(is ?id ?val) @@ -188,40 +192,3 @@ (d/q '[:find ?id :in $ % :where (is ?id false)] db rules))))) - - -; issue-456 -; this used to stall for nearly a minute and/or fail with an OOM exception -; due to propagation of a relation with duplicate tuples during rule solving -(deftest test-rule-performance-on-larger-datasets - (let [now (fn [] - #?(:clj (/ (System/nanoTime) 1000000.0) - :cljs (js/performance.now))) - inline (fn [db] - (d/q '[:find ?e - :where [?e :item/status ?status] - [(ground "pending") ?status]] - db)) - rule (fn [db] - (d/q '[:find ?e - :in $ % - :where [?e :item/status ?status] - (pending? ?status)] - db - '[[(pending? ?status) - [(ground "pending") ?status]]])) - measure (fn [f & args] - (let [start (now) - result (apply f args)] - [(- (now) start) result])) - db (-> (d/empty-db) - (d/db-with (for [x (range 1 50000)] - {:db/id (- x) - :item/id x - :item/status (rand-nth ["started" "pending" "stopped"])}))) - [inline-time inline-result] (measure inline db) - [rule-time rule-result] (measure rule db)] - ; (println "inline-time" inline-time "ms, rule-time" rule-time "ms") - (is (= inline-result rule-result)) - ; show that rule performance continues to be within an order of magnitude of inline performance - (is (<= 0 rule-time (* 10 inline-time))))) diff --git a/test/datascript/test/query_v3.cljc b/test/datascript/test/query_v3.cljc index aca96359..65425b35 100644 --- a/test/datascript/test/query_v3.cljc +++ b/test/datascript/test/query_v3.cljc @@ -1,13 +1,17 @@ (ns datascript.test.query-v3 (:require - [clojure.test :as t :refer [is are deftest testing]] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) [datascript.core :as d] [datascript.db :as db] [datascript.query-v3 :as dq] [datascript.test.core :as tdc]) - #?(:clj - (:import - [clojure.lang ExceptionInfo]))) +#?(:cljd (:require [cljd.core :refer [ExceptionInfo]]) + :clj + (:import [clojure.lang ExceptionInfo]))) + + (deftest test-validation (are [q ins msg] (thrown-with-msg? ExceptionInfo msg (apply dq/q q ins)) @@ -16,8 +20,8 @@ '[:find ?a :where [?a]] [0 1] #"Wrong number of arguments for bindings \[\$\], 1 required, 2 provided" '[:find ?a :where [?a 1]] [:a] #"Cannot match by pattern \[\?a 1\] because source is not a collection: :a")) - + #_(deftest test-query - (is (= (dq/q '[:find ?a :where [?a ?a]] - [[1 2] [3 3] [4 5] [6 6]]) - #{[3] [6]}))) + (is (= (dq/q '[:find ?a :where [?a ?a]] + [[1 2] [3 3] [4 5] [6 6]]) + #{[3] [6]}))) diff --git a/test/datascript/test/serialize.cljc b/test/datascript/test/serialize.cljc index 8a278135..7c53bb54 100644 --- a/test/datascript/test/serialize.cljc +++ b/test/datascript/test/serialize.cljc @@ -1,23 +1,29 @@ (ns datascript.test.serialize (:require - [clojure.edn :as edn] - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.db :as db] - [datascript.test.core :as tdc] - #?(:clj [cheshire.core :as cheshire]) - #?(:clj [jsonista.core :as jsonista])) - #?(:clj - (:import - [clojure.lang ExceptionInfo]))) + [#?(:cljd cljd.reader :cljs cljs.reader :clj clojure.edn) :as edn] + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + [datascript.core :as d] + [datascript.db :as db] + [datascript.test.core :as tdc] + #?(:cljd ["dart:convert" :as dart:convert]) + #?(:cljd nil :clj [cheshire.core :as cheshire]) + #?(:cljd nil :clj [jsonista.core :as jsonista])) + #?(:cljd + (:require [cljd.core :refer [ExceptionInfo]]) + :clj + (:import [clojure.lang ExceptionInfo]))) (t/use-fixtures :once tdc/no-namespace-maps) (def readers - {#?@(:cljs ["cljs.reader/read-string" cljs.reader/read-string] - :clj ["clojure.edn/read-string" #(clojure.edn/read-string {:readers d/data-readers} %) - "clojure.core/read-string" #(binding [*data-readers* (merge *data-readers* d/data-readers)] - (read-string %))])}) + { #?@(:cljd ["cljd.reader/read-string" #(binding [*data-readers* (merge *data-readers* d/data-readers)] + (cljd.reader/read-string %))] + :cljs ["cljs.reader/read-string" cljs.reader/read-string] + :clj ["clojure.edn/read-string" #(clojure.edn/read-string {:readers d/data-readers} %) + "clojure.core/read-string" #(binding [*data-readers* (merge *data-readers* d/data-readers)] + (read-string %))]) }) (deftest test-pr-read (doseq [[r read-fn] readers] @@ -25,15 +31,15 @@ (let [d (db/datom 1 :name "Oleg" 17 true)] (is (= (pr-str d) "#datascript/Datom [1 :name \"Oleg\" 17 true]")) (is (= d (read-fn (pr-str d))))) - + (let [d (db/datom 1 :name 3)] (is (= (pr-str d) "#datascript/Datom [1 :name 3 536870912 true]")) (is (= d (read-fn (pr-str d))))) - + (let [db (-> (d/empty-db {:name {:db/unique :db.unique/identity}}) - (d/db-with [[:db/add 1 :name "Petr"] - [:db/add 1 :age 44]]) - (d/db-with [[:db/add 2 :name "Ivan"]]))] + (d/db-with [ [:db/add 1 :name "Petr"] + [:db/add 1 :age 44] ]) + (d/db-with [ [:db/add 2 :name "Ivan"] ]))] (is (= (pr-str db) (str "#datascript/DB {" ":schema {:name {:db/unique :db.unique/identity}}, " @@ -44,6 +50,7 @@ "]}"))) (is (= db (read-fn (pr-str db)))))))) + (def data [[1 :name "Petr"] [1 :aka "Devil"] @@ -53,36 +60,35 @@ [1 :email "petr@gmail.com"] [1 :avatar 10] [10 :url "http://"] - [1 :attach {:some-key :some-value}] + [1 :attach { :some-key :some-value }] [2 :name "Oleg"] [2 :age 30] [2 :email "oleg@gmail.com"] - [2 :attach [:just :values]] + [2 :attach [ :just :values ]] [3 :name "Ivan"] [3 :age 15] [3 :follows 2] - [3 :attach {:another :map}] + [3 :attach { :another :map }] [3 :avatar 30] [4 :name "Nick" d/tx0] [5 :inf ##Inf] [5 :-inf ##-Inf] - #?@(:clj [[5 :ratio 22/7] - [5 :bigint (bigint 100)] - [5 :biginteger (biginteger 100)] - [5 :bigdec (bigdec 100.005)]]) ;; check that facts about transactions doesn’t set off max-eid [d/tx0 :txInstant 0xdeadbeef] - [30 :url "https://"]]) - -(def schema - {:name {} ;; nothing special about name - :aka {:db/cardinality :db.cardinality/many} - :age {:db/index true} - :follows {:db/valueType :db.type/ref} - :email {:db/unique :db.unique/identity} - :avatar {:db/valueType :db.type/ref, :db/isComponent true} - :url {} ;; just a component prop - :attach {}}) ;; should skip index + [30 :url "https://" ]]) + + +(def schema + { :name { } ;; nothing special about name + :aka { :db/cardinality :db.cardinality/many } + :age { :db/index true } + :follows { :db/valueType :db.type/ref } + :email { :db/unique :db.unique/identity } + :avatar { :db/valueType :db.type/ref, :db/isComponent true } + :url { } ;; just a component prop + :attach { } ;; should skip index +}) + (deftest test-init-db (let [db-init (d/init-db @@ -96,10 +102,10 @@ (is (= db-init db-transact))) (testing "db-init produces the same max-eid as regular transactions" - (let [assertions [[:db/add -1 :name "Lex"]]] + (let [assertions [ [:db/add -1 :name "Lex"] ]] (is (= (d/db-with db-init assertions) (d/db-with db-transact assertions))))) - + (testing "Roundtrip" (doseq [[r read-fn] readers] (testing r @@ -109,15 +115,7 @@ (is (thrown-with-msg? ExceptionInfo #"init-db expects list of Datoms, got " (d/init-db [[:add -1 :name "Ivan"] {:add -1 :age 35}] schema)))))) -(deftest ^{:doc "issue-463"} test-max-eid-from-refs - (let [db (-> (d/empty-db {:ref {:db/valueType :db.type/ref}}) - (d/db-with [[:db/add 1 :name "Ivan"]]) - (d/db-with [{:db/id 1 :ref {:name "Oleg"}}]))] - (is (= 2 (:max-eid db))) - (doseq [[r read-fn] readers] - (testing r - (let [db' (read-fn (pr-str db))] - (is (= 2 (:max-eid db')))))))) + (deftest serialize (let [db (d/db-with @@ -125,37 +123,50 @@ (map (fn [[e a v]] [:db/add e a v]) data))] (is (= db (-> db d/serializable d/from-serializable))) (is (= db (-> db d/serializable pr-str edn/read-string d/from-serializable))) + (is (= db (-> db (d/serializable {:freeze-fn tdc/transit-write-str}) pr-str edn/read-string (d/from-serializable {:thaw-fn tdc/transit-read-str})))) (doseq [type [:json :json-verbose #?(:clj :msgpack)]] (testing type (is (= db (-> db d/serializable (tdc/transit-write type) (tdc/transit-read type) d/from-serializable))))) - #?(:clj + #?(:cljd nil + :clj (is (= db (-> db d/serializable jsonista/write-value-as-string jsonista/read-value d/from-serializable)))) - #?(:clj + #?(:cljd nil + :clj (let [mapper (com.fasterxml.jackson.databind.ObjectMapper.)] (is (= db (-> db d/serializable (jsonista/write-value-as-string mapper) (jsonista/read-value mapper) d/from-serializable))))) - #?(:clj + #?(:cljd nil + :clj (is (= db (-> db d/serializable cheshire/generate-string cheshire/parse-string d/from-serializable)))) - #?(:cljs - (is (= db (-> db d/serializable js/JSON.stringify js/JSON.parse d/from-serializable)))))) + #?(:cljd + (is (= db (-> db d/serializable dart:convert/json.encode dart:convert/json.decode d/from-serializable))) + :cljs + (is (= db (-> db d/serializable js/JSON.stringify js/JSON.parse d/from-serializable)))) + )) + (deftest test-nan (let [db (d/db-with (d/empty-db schema) [[:db/add 1 :nan ##NaN]]) - valid? #(#?(:clj Double/isNaN :cljs js/isNaN) (:nan (d/entity % 1)))] + valid? #(-> (:nan (d/entity % 1)) #?(:cljd .-isNaN :clj Double/isNaN :cljs js/isNaN))] (is (valid? (-> db d/serializable d/from-serializable))) (is (valid? (-> db d/serializable pr-str edn/read-string d/from-serializable))) (is (valid? (-> db (d/serializable {:freeze-fn tdc/transit-write-str}) pr-str edn/read-string (d/from-serializable {:thaw-fn tdc/transit-read-str})))) (doseq [type [:json :json-verbose #?(:clj :msgpack)]] (testing type (is (valid? (-> db d/serializable (tdc/transit-write type) (tdc/transit-read type) d/from-serializable))))) - #?(:clj + #?(:cljd nil + :clj (is (valid? (-> db d/serializable jsonista/write-value-as-string jsonista/read-value d/from-serializable)))) - #?(:clj + #?(:cljd nil + :clj (let [mapper (com.fasterxml.jackson.databind.ObjectMapper.)] (is (valid? (-> db d/serializable (jsonista/write-value-as-string mapper) (jsonista/read-value mapper) d/from-serializable))))) - #?(:clj + #?(:cljd nil + :clj (is (valid? (-> db d/serializable cheshire/generate-string cheshire/parse-string d/from-serializable)))) - #?(:cljs + #?(:cljd + (is (valid? (-> db d/serializable dart:convert/json.encode dart:convert/json.decode d/from-serializable))) + :cljs (is (valid? (-> db d/serializable js/JSON.stringify js/JSON.parse d/from-serializable)))))) diff --git a/test/datascript/test/storage.clj b/test/datascript/test/storage.clj index c1a634ac..bfdf9664 100644 --- a/test/datascript/test/storage.clj +++ b/test/datascript/test/storage.clj @@ -250,15 +250,15 @@ (d/transact! conn [[:db/add 2 :name "Oleg"]]) (is (= 7 (count @(:*writes storage)))) (is (= @#'storage/tail-addr (last @(:*writes storage)))) - (is (= 2 (count (:tx-tail @(:atom conn))))) - (is (= 2 (count (apply concat (:tx-tail @(:atom conn)))))) - + (is (= 2 (count (:tx-tail @(:storage-state (meta conn)))))) + (is (= 2 (count (apply concat (:tx-tail @(:storage-state (meta conn))))))) + ;; bigger tx, still writing tail (d/transact! conn (mapv #(vector :db/add % :name (str %)) (range 3 33))) (is (= 8 (count @(:*writes storage)))) (is (= @#'storage/tail-addr (last @(:*writes storage)))) - (is (= 3 (count (:tx-tail @(:atom conn))))) - (is (= 32 (count (apply concat (:tx-tail @(:atom conn)))))) + (is (= 3 (count (:tx-tail @(:storage-state (meta conn)))))) + (is (= 32 (count (apply concat (:tx-tail @(:storage-state (meta conn))))))) ;; tail overflows, flush db (d/transact! conn [[:db/add 33 :name "Petr"]]) @@ -295,11 +295,11 @@ ;; gc on conn (is (> (count (storage/-list-addresses storage)) - (count (d/addresses (:db-last-stored @(:atom conn'')))))) - + (count (d/addresses (:db-last-stored @(:storage-state (meta conn''))))))) + (d/collect-garbage storage) (is (= (count (storage/-list-addresses storage)) - (count (d/addresses (:db-last-stored @(:atom conn'')))))) + (count (d/addresses (:db-last-stored @(:storage-state (meta conn''))))))) (let [conn''' (d/restore-conn storage)] (is (= @conn'' @conn'''))))))) diff --git a/test/datascript/test/transact.cljc b/test/datascript/test/transact.cljc index 9d115f4d..05d6b6e0 100644 --- a/test/datascript/test/transact.cljc +++ b/test/datascript/test/transact.cljc @@ -1,24 +1,27 @@ (ns datascript.test.transact (:require - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.db :as db] - [datascript.test.core :as tdc])) + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + [datascript.core :as d] + [datascript.db :as db] + #?(:cljd [cljd.core :refer [ExceptionInfo]]) + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]])) (deftest test-with (let [db (-> (d/empty-db {:aka {:db/cardinality :db.cardinality/many}}) - (d/db-with [[:db/add 1 :name "Ivan"]]) - (d/db-with [[:db/add 1 :name "Petr"]]) - (d/db-with [[:db/add 1 :aka "Devil"]]) - (d/db-with [[:db/add 1 :aka "Tupen"]]))] + (d/db-with [[:db/add 1 :name "Ivan"]]) + (d/db-with [[:db/add 1 :name "Petr"]]) + (d/db-with [[:db/add 1 :aka "Devil"]]) + (d/db-with [[:db/add 1 :aka "Tupen"]]))] (is (= (d/q '[:find ?v :where [1 :name ?v]] db) - #{["Petr"]})) + #{["Petr"]})) (is (= (d/q '[:find ?v :where [1 :aka ?v]] db) - #{["Devil"] ["Tupen"]})) - + #{["Devil"] ["Tupen"]})) + (testing "Retract" (let [db (-> db (d/db-with [[:db/retract 1 :name "Petr"]]) @@ -26,90 +29,91 @@ (is (= (d/q '[:find ?v :where [1 :name ?v]] db) - #{})) + #{})) (is (= (d/q '[:find ?v :where [1 :aka ?v]] db) - #{["Tupen"]})) + #{["Tupen"]})) - (is (= (into {} (d/entity db 1)) {:aka #{"Tupen"}})))) + (is (= (into {} (d/entity db 1)) { :aka #{"Tupen"} })))) (testing "Cannot retract what's not there" (let [db (-> db - (d/db-with [[:db/retract 1 :name "Ivan"]]))] + (d/db-with [[:db/retract 1 :name "Ivan"]]))] (is (= (d/q '[:find ?v :where [1 :name ?v]] db) - #{["Petr"]}))))) - + #{["Petr"]}))))) + (testing "Skipping nils in tx" (let [db (-> (d/empty-db) - (d/db-with [[:db/add 1 :attr 2] - nil - [:db/add 3 :attr 4]]))] + (d/db-with [[:db/add 1 :attr 2] + nil + [:db/add 3 :attr 4]]))] (is (= [[1 :attr 2], [3 :attr 4]] - (map (juxt :e :a :v) (d/datoms db :eavt))))))) + (map (juxt :e :a :v) (d/datoms db :eavt))))))) + (deftest test-with-datoms (testing "keeps tx number" (let [db (-> (d/empty-db) - (d/db-with [(d/datom 1 :name "Oleg") - (d/datom 1 :age 17 (+ 1 d/tx0)) - [:db/add 1 :aka "x" (+ 2 d/tx0)]]))] + (d/db-with [(d/datom 1 :name "Oleg") + (d/datom 1 :age 17 (+ 1 d/tx0)) + [:db/add 1 :aka "x" (+ 2 d/tx0)]]))] (is (= [[1 :age 17 (+ 1 d/tx0)] [1 :aka "x" (+ 2 d/tx0)] - [1 :name "Oleg" d/tx0]] - (map (juxt :e :a :v :tx) - (d/datoms db :eavt)))))) - + [1 :name "Oleg" d/tx0 ]] + (map (juxt :e :a :v :tx) + (d/datoms db :eavt)))))) + (testing "retraction" (let [db (-> (d/empty-db) - (d/db-with [(d/datom 1 :name "Oleg") - (d/datom 1 :age 17) - (d/datom 1 :name "Oleg" d/tx0 false)]))] + (d/db-with [(d/datom 1 :name "Oleg") + (d/datom 1 :age 17) + (d/datom 1 :name "Oleg" d/tx0 false)]))] (is (= [[1 :age 17 d/tx0]] - (map (juxt :e :a :v :tx) - (d/datoms db :eavt))))))) + (map (juxt :e :a :v :tx) + (d/datoms db :eavt))))))) (deftest test-retract-fns - (let [db (-> (d/empty-db {:aka {:db/cardinality :db.cardinality/many} - :friend {:db/valueType :db.type/ref}}) - (d/db-with [{:db/id 1, :name "Ivan", :age 15, :aka ["X" "Y" "Z"], :friend 2} - {:db/id 2, :name "Petr", :age 37}]))] - (let [db (d/db-with db [[:db.fn/retractEntity 1]])] + (let [db (-> (d/empty-db {:aka { :db/cardinality :db.cardinality/many } + :friend { :db/valueType :db.type/ref }}) + (d/db-with [ { :db/id 1, :name "Ivan", :age 15, :aka ["X" "Y" "Z"], :friend 2 } + { :db/id 2, :name "Petr", :age 37 } ]))] + (let [db (d/db-with db [ [:db.fn/retractEntity 1] ])] (is (= (d/q '[:find ?a ?v :where [1 ?a ?v]] db) - #{})) + #{})) (is (= (d/q '[:find ?a ?v :where [2 ?a ?v]] db) - #{[:name "Petr"] [:age 37]}))) + #{[:name "Petr"] [:age 37]}))) (is (= (d/db-with db [[:db.fn/retractEntity 1]]) - (d/db-with db [[:db/retractEntity 1]]))) + (d/db-with db [[:db/retractEntity 1]]))) (testing "Retract entitiy with incoming refs" (is (= (d/q '[:find ?e :where [1 :friend ?e]] db) - #{[2]})) - - (let [db (d/db-with db [[:db.fn/retractEntity 2]])] + #{[2]})) + + (let [db (d/db-with db [ [:db.fn/retractEntity 2] ])] (is (= (d/q '[:find ?e :where [1 :friend ?e]] db) - #{})))) - - (let [db (d/db-with db [[:db.fn/retractAttribute 1 :name]])] + #{})))) + + (let [db (d/db-with db [ [:db.fn/retractAttribute 1 :name] ])] (is (= (d/q '[:find ?a ?v :where [1 ?a ?v]] db) - #{[:age 15] [:aka "X"] [:aka "Y"] [:aka "Z"] [:friend 2]})) + #{[:age 15] [:aka "X"] [:aka "Y"] [:aka "Z"] [:friend 2]})) (is (= (d/q '[:find ?a ?v :where [2 ?a ?v]] db) - #{[:name "Petr"] [:age 37]}))) + #{[:name "Petr"] [:age 37]}))) - (let [db (d/db-with db [[:db.fn/retractAttribute 1 :aka]])] + (let [db (d/db-with db [ [:db.fn/retractAttribute 1 :aka] ])] (is (= (d/q '[:find ?a ?v :where [1 ?a ?v]] db) - #{[:name "Ivan"] [:age 15] [:friend 2]})) + #{[:name "Ivan"] [:age 15] [:friend 2]})) (is (= (d/q '[:find ?a ?v :where [2 ?a ?v]] db) - #{[:name "Petr"] [:age 37]}))))) + #{[:name "Petr"] [:age 37]}))))) -(deftest test-retract-without-value-issue-339 +(deftest test-retract-without-value-339 (let [db (-> (d/empty-db {:aka {:db/cardinality :db.cardinality/many} :friend {:db/valueType :db.type/ref}}) (d/db-with [{:db/id 1, :name "Ivan", :age 15, :aka ["X" "Y" "Z"], :friend 2} @@ -123,13 +127,13 @@ (let [db' (d/db-with db [[:db/retract 2 :employed? false]])] (is (= [(db/datom 2 :employed? true)] (d/datoms db' :eavt 2 :employed?)))))) - + (deftest test-retract-fns-not-found - (let [db (-> (d/empty-db {:name {:db/unique :db.unique/identity}}) - (d/db-with [[:db/add 1 :name "Ivan"]])) + (let [db (-> (d/empty-db { :name { :db/unique :db.unique/identity } }) + (d/db-with [[:db/add 1 :name "Ivan"]])) all #(vec (d/datoms % :eavt))] - (are [op] (= [(d/datom 1 :name "Ivan")] - (all (d/db-with db [op]))) + (are [op] (= [(d/datom 1 :name "Ivan")] + (all (d/db-with db [op]))) [:db/retract 2 :name "Petr"] [:db.fn/retractAttribute 2 :name] [:db.fn/retractEntity 2] @@ -137,10 +141,10 @@ [:db/retract [:name "Petr"] :name "Petr"] [:db.fn/retractAttribute [:name "Petr"] :name] [:db.fn/retractEntity [:name "Petr"]]) - - (are [op] (= [[] []] - [(all (d/db-with db [op])) - (all (d/db-with db [op op]))]) ;; idempotency + + (are [op] (= [[] []] + [(all (d/db-with db [op])) + (all (d/db-with db [op op]))]) ;; idempotency [:db/retract 1 :name "Ivan"] [:db.fn/retractAttribute 1 :name] [:db.fn/retractEntity 1] @@ -150,7 +154,7 @@ [:db.fn/retractEntity [:name "Ivan"]]))) (deftest test-transact! - (let [conn (d/create-conn {:aka {:db/cardinality :db.cardinality/many}})] + (let [conn (d/create-conn {:aka { :db/cardinality :db.cardinality/many }})] (d/transact! conn [[:db/add 1 :name "Ivan"]]) (d/transact! conn [[:db/add 1 :name "Petr"]]) (d/transact! conn [[:db/add 1 :aka "Devil"]]) @@ -158,10 +162,10 @@ (is (= (d/q '[:find ?v :where [1 :name ?v]] @conn) - #{["Petr"]})) + #{["Petr"]})) (is (= (d/q '[:find ?v :where [1 :aka ?v]] @conn) - #{["Devil"] ["Tupen"]})))) + #{["Devil"] ["Tupen"]})))) (deftest test-db-fn-cas (let [conn (d/create-conn)] @@ -172,8 +176,8 @@ (is (= (:weight (d/entity @conn 1)) 400)) (is (thrown-msg? ":db.fn/cas failed on datom [1 :weight 400], expected 200" (d/transact! conn [[:db.fn/cas 1 :weight 200 210]])))) - - (let [conn (d/create-conn {:label {:db/cardinality :db.cardinality/many}})] + + (let [conn (d/create-conn {:label { :db/cardinality :db.cardinality/many }})] (d/transact! conn [[:db/add 1 :label :x]]) (d/transact! conn [[:db/add 1 :label :y]]) (d/transact! conn [[:db.fn/cas 1 :label :y :z]]) @@ -194,13 +198,13 @@ [:db.fn/cas -1 :attr nil :val]]))))) (deftest test-db-fn - (let [conn (d/create-conn {:aka {:db/cardinality :db.cardinality/many}}) + (let [conn (d/create-conn {:aka { :db/cardinality :db.cardinality/many }}) inc-age (fn [db name] (if-let [[eid age] (first (d/q '{:find [?e ?age] :in [$ ?name] :where [[?e :name ?name] [?e :age ?age]]} - db name))] + db name))] [{:db/id eid :age (inc age)} [:db/add eid :had-birthday true]] (throw (ex-info (str "No entity with name: " name) {}))))] (d/transact! conn [{:db/id 1 :name "Ivan" :age 31}]) @@ -209,31 +213,17 @@ (d/transact! conn [[:db/add 1 :aka "Tupen"]]) (is (= (d/q '[:find ?v ?a :where [?e :name ?v] - [?e :age ?a]] @conn) - #{["Petr" 31]})) + [?e :age ?a]] @conn) + #{["Petr" 31]})) (is (= (d/q '[:find ?v :where [?e :aka ?v]] @conn) - #{["Devil"] ["Tupen"]})) + #{["Devil"] ["Tupen"]})) (is (thrown-msg? "No entity with name: Bob" (d/transact! conn [[:db.fn/call inc-age "Bob"]]))) (let [{:keys [db-after]} (d/transact! conn [[:db.fn/call inc-age "Petr"]]) e (d/entity db-after 1)] (is (= (:age e) 32)) - (is (:had-birthday e))) - - (let [{:keys [db-after]} (d/transact! conn - [[:db.fn/call (fn [db] - [{:name "Oleg"}])]]) - e (d/entity db-after 2)] - (is (= "Oleg" (:name e)))) - - (let [{:keys [db-after - tempids]} (d/transact! conn - [[:db.fn/call (fn [db] - [{:db/id -1 - :name "Vera"}])]]) - e (d/entity db-after (tempids -1))] - (is (= "Vera" (:name e)))))) + (is (:had-birthday e))))) (deftest test-db-ident-fn (let [conn (d/create-conn {:name {:db/unique :db.unique/identity}}) @@ -275,7 +265,7 @@ {-1 1 -2 2 "Serg" 3 - :db/current-tx (+ d/tx0 1)})) + :db/current-tx (+ d/tx0 1) })) (is (= #{[1 :name "Ivan"] [1 :age 19] [2 :name "Petr"] @@ -289,7 +279,7 @@ (is (= #{[1 :name "Ivan"] [2 :ref 1]} (tdc/all-datoms db')))) - (testing "issue-363" + (testing "#363" (let [db' (-> db (d/db-with [[:db/add -1 :name "Ivan"]]) (d/db-with [[:db/add -1 :name "Ivan"] @@ -301,7 +291,7 @@ [:db/add -2 :ref -1]]))] (is (= #{[1 :aka "Batman"] [2 :ref 1]} (tdc/all-datoms db'))))))) -(deftest test-tempid-ref-issue-295 +(deftest test-tempid-ref-295 (let [db (-> (d/empty-db {:ref {:db/unique :db.unique/identity :db/valueType :db.type/ref}}) (d/db-with [[:db/add -1 :name "Ivan"] @@ -326,14 +316,9 @@ q '[:find ?fn :in $ ?n :where [?e :name ?n] - [?e :friend ?fe] - [?fe :name ?fn]]] - (is (= {-1 2 - -2 3 - "B" 4 - -3 5 - :db/current-tx (+ d/tx0 1)} - (:tempids tx))) + [?e :friend ?fe] + [?fe :name ?fn]]] + (is (= (:tempids tx) { 1 1, -1 2, -2 3, "B" 4, -3 5, :db/current-tx (+ d/tx0 1) })) (is (= (d/q q @conn "Sergey") #{["Ivan"] ["Petr"]})) (is (= (d/q q @conn "Boris") #{["Oleg"]})) (is (= (d/q q @conn "Oleg") #{["Boris"]})) @@ -341,7 +326,7 @@ (let [db (d/empty-db {:friend {:db/valueType :db.type/ref} :comp {:db/valueType :db.type/ref, :db/isComponent true} :multi {:db/cardinality :db.cardinality/many}})] - (testing "Unused tempid" ;; issue-304 + (testing "Unused tempid" ;; #304 (is (thrown-msg? "Tempids used only as value in transaction: (-2)" (d/db-with db [[:db/add -1 :friend -2]]))) (is (thrown-msg? "Tempids used only as value in transaction: (-2)" @@ -349,7 +334,7 @@ (is (thrown-msg? "Tempids used only as value in transaction: (-1)" (d/db-with db [{:db/id -1} [:db/add -2 :friend -1]]))) - ; Needs issue-357 + ; Needs #357 ; (is (thrown-msg? "Tempids used only as value in transaction: (-1)" ; (d/db-with db [{:db/id -1 :comp {}} ; [:db/add -2 :friend -1]]))) @@ -373,23 +358,21 @@ [(+ d/tx0 1) :prop2 "prop2"] [2 :name "Y"] [2 :created-at (+ d/tx0 1)]})) - (is (= (assoc {-1 2 - :db/current-tx (+ d/tx0 1)} - tx-tempid (+ d/tx0 1)) - (:tempids tx1))) + (is (= (:tempids tx1) (assoc {1 1, -1 2, :db/current-tx (+ d/tx0 1)} + tx-tempid (+ d/tx0 1)))) (let [tx2 (d/transact! conn [[:db/add tx-tempid :prop3 "prop3"]]) tx-id (get-in tx2 [:tempids tx-tempid])] (is (= tx-id (+ d/tx0 2))) (is (= (into {} (d/entity @conn tx-id)) - {:prop3 "prop3"}))) + {:prop3 "prop3"}))) (let [tx3 (d/transact! conn [{:db/id tx-tempid, :prop4 "prop4"}]) tx-id (get-in tx3 [:tempids tx-tempid])] (is (= tx-id (+ d/tx0 3))) (is (= (into {} (d/entity @conn tx-id)) - {:prop4 "prop4"}))))))) + {:prop4 "prop4"}))))))) -(deftest test-transient-issue-294 - "db.fn/retractEntity retracts attributes of adjacent entities issue-294" +(deftest test-transient-294 + "db.fn/retractEntity retracts attributes of adjacent entities #294" (let [db (reduce #(d/db-with %1 [{:db/id %2 :a1 1 :a2 2 :a3 3}]) (d/empty-db) (range 1 10)) @@ -400,10 +383,10 @@ (d/datom 1 :a3 3) (d/datom 2 :a1 1) (d/datom 2 :a2 2) - (d/datom 2 :a3 3)] - (:tx-data report))))) + (d/datom 2 :a3 3)] + (:tx-data report))))) -(deftest test-large-ids-issue-292 +(deftest test-large-ids-292 (let [db (d/empty-db {:ref {:db/valueType :db.type/ref}})] (is (thrown-msg? "Highest supported entity id is 2147483647, got 285873023227265" (d/with db [[:db/add 285873023227265 :name "Valerii"]]))) @@ -418,7 +401,7 @@ (is (thrown-msg? "Highest supported entity id is 2147483647, got 285873023227265" (d/with db [(db/datom 1 :ref 285873023227265)])))))) -(deftest test-uncomparable-issue-356 +(deftest test-uncomparable-356 (let [db (d/empty-db {:multi {:db/cardinality :db.cardinality/many} :index {:db/index true}})] @@ -457,14 +440,15 @@ (is (= [(db/datom 1 :index {:map 3})] (vec (d/datoms db' :aevt :index 1 {:map 3})))) (is (= [(db/datom 1 :index {:map 3})] - (vec (d/datoms db' :avet :index {:map 3} 1))))))) + (vec (d/datoms db' :avet :index {:map 3} 1 ))))) +)) -(deftest test-compare-numbers-js-issue-404 +(deftest test-compare-numbers-js-404 (let [db (d/db-with (d/empty-db) [{:num 42.5}]) db' (d/db-with db [[:db/retract 1 :num 42]])] (is (= #{[1 :num 42.5]} (tdc/all-datoms db'))))) -(deftest test-transitive-type-compare-issue-386 +(deftest test-transitive-type-compare-386 (let [txs [[{:block/uid "2LB4tlJGy"}] [{:block/uid "2ON453J0Z"}] [{:block/uid "2KqLLNbPg"}] @@ -488,10 +472,3 @@ (is (empty? (->> (d/datoms db :eavt) (map (fn [[_ a v]] [a v])) (remove #(d/entity db %))))))) - -(deftest test-db-fn-returning-entity-without-db-id-issue-474 - (let [conn (d/create-conn {}) - _ (d/transact! conn [[:db.fn/call (fn [db] - [{:foo "bar"}])]]) - db @conn] - (is (= #{[1 :foo "bar"]} (tdc/all-datoms db))))) diff --git a/test/datascript/test/tuples.cljc b/test/datascript/test/tuples.cljc index 23ba35d3..9a0698b3 100644 --- a/test/datascript/test/tuples.cljc +++ b/test/datascript/test/tuples.cljc @@ -1,11 +1,12 @@ (ns datascript.test.tuples (:require - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.test.core :as tdc]) - #?(:clj - (:import - [clojure.lang ExceptionInfo]))) + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + #?(:cljd [cljd.core :refer [ExceptionInfo]]) + [datascript.core :as d] + [datascript.test.core :as tdc :refer [#?(:cljd thrown-msg?)]]) + (:import #?(:cljd nil :clj [clojure.lang ExceptionInfo]))) (deftest test-schema (let [db (d/empty-db @@ -193,7 +194,7 @@ [2 :b "b"] [2 :a+b ["a" "b"]] [2 :c "c"]} - (tdc/all-datoms (d/db conn)))) + (tdc/all-datoms (d/db conn)))) (is (thrown-msg? "Conflicting upserts: [:a+b [\"A\" \"B\"]] resolves to 1, but [:c \"c\"] resolves to 2" (d/transact! conn [{:a+b ["A" "B"] :c "c"}]))) @@ -215,35 +216,6 @@ [2 :c "c"]} (tdc/all-datoms (d/db conn)))))) -;; issue-473 -(deftest test-upsert-by-tuple-components - (let [db (d/empty-db {:a+b {:db/tupleAttrs [:a :b] - :db/unique :db.unique/identity}}) - db' (d/db-with db [{:a "A" :b "B" :name "Ivan"}])] - (is (= #{[1 :a "A"] - [1 :b "B"] - [1 :a+b ["A" "B"]] - [1 :name "Oleg"]} - (tdc/all-datoms - (d/db-with db' - [{:db/id -1 :a "A" :b "B" :name "Oleg"}])))) - (is (= #{[1 :a "A"] - [1 :b "B"] - [1 :a+b ["A" "B"]] - [1 :name "Oleg"]} - (tdc/all-datoms - (d/db-with db' - [{:a "A" :b "B" :name "Oleg"}])))) - (is (= #{[1 :a "A"] - [1 :b "B"] - [1 :a+b ["A" "B"]] - [1 :name "Oleg"]} - (tdc/all-datoms - (d/db-with db' - [[:db/add -1 :a "A"] - [:db/add -1 :b "B"] - [:db/add -1 :name "Oleg"]])))))) - (deftest test-lookup-refs (let [conn (d/create-conn {:a+b {:db/tupleAttrs [:a :b] :db/unique :db.unique/identity} @@ -262,7 +234,7 @@ [2 :b "b"] [2 :a+b ["a" "b"]] [2 :c "c"]} - (tdc/all-datoms (d/db conn)))) + (tdc/all-datoms (d/db conn)))) (is (thrown-with-msg? ExceptionInfo #"Cannot add .* because of unique constraint: .*" (d/transact! conn [[:db/add [:a+b ["A" "B"]] :c "c"]]))) @@ -294,37 +266,6 @@ :c "c"} (d/pull (d/db conn) '[*] [:a+b ["a" "b"]]))))) -;; issue-452 -(deftest lookup-refs-in-tuple - (let [schema {:ref {:db/valueType :db.type/ref} - :name {:db/unique :db.unique/identity} - :ref+name {:db/valueType :db.type/tuple - :db/tupleAttrs [:ref :name] - :db/unique :db.unique/identity}} - db (-> (d/empty-db schema) - (d/db-with - [{:db/id -1 :name "Ivan"} - {:db/id -2 :name "Oleg"} - {:db/id -3 :name "Petr" :ref -1} - {:db/id -4 :name "Yuri" :ref -2}]))] - (let [db' (d/db-with db [{:ref+name [1 "Petr"], :age 32}])] - (is (= {:age 32} (d/pull db' [:age] 3)))) - - (let [db' (d/db-with db [{:ref+name [[:name "Ivan"] "Petr"], :age 32}])] - (is (= {:age 32} (d/pull db' [:age] 3)))) - - (let [db' (d/db-with db [[:db/add -1 :ref+name [1 "Petr"]] - [:db/add -1 :age 32]])] - (is (= {:age 32} (d/pull db' [:age] 3)))) - - (let [db' (d/db-with db [[:db/add -1 :ref+name [[:name "Ivan"] "Petr"]] - [:db/add -1 :age 32]])] - (is (= {:age 32} (d/pull db' [:age] 3)))) - - (is (= 1 (:db/id (d/entity db [:name "Ivan"])))) - (is (= 3 (:db/id (d/entity db [:ref+name [1 "Petr"]])))) - (is (= 3 (:db/id (d/entity db [:ref+name [[:name "Ivan"] "Petr"]])))))) - (deftest test-validation (let [db (d/empty-db {:a+b {:db/tupleAttrs [:a :b]}}) db1 (d/db-with db [[:db/add 1 :a "a"]])] @@ -376,10 +317,11 @@ (is (= #{[["A" "B"]] [["A" "b"]] [["a" "B"]] [["a" "b"]]} (d/q '[:find ?a+b :where [?e :a ?a] - [?e :b ?b] - [(tuple ?a ?b) ?a+b]] db))) + [?e :b ?b] + [(tuple ?a ?b) ?a+b]] db))) (is (= #{["A" "B"] ["A" "b"] ["a" "B"] ["a" "b"]} (d/q '[:find ?a ?b :where [?e :a+b ?a+b] - [(untuple ?a+b) [?a ?b]]] db))))) + [(untuple ?a+b) [?a ?b]]] db))) + )) diff --git a/test/datascript/test/upsert.cljc b/test/datascript/test/upsert.cljc index 38cf78e8..6f9d67fc 100644 --- a/test/datascript/test/upsert.cljc +++ b/test/datascript/test/upsert.cljc @@ -1,239 +1,206 @@ (ns datascript.test.upsert (:require - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.db :as db] - [datascript.test.core :as tdc])) + #?(:cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + #?(:cljd [cljd.core :refer [ExceptionInfo]]) + [datascript.core :as d] + [datascript.db :as db] + [datascript.test.core :as tdc])) #?(:cljs - (def Throwable - js/Error)) + (def Throwable js/Error)) (deftest test-upsert - (let [ivan {:db/id 1 :name "Ivan" :email "@1"} - petr {:db/id 2 :name "Petr" :email "@2" :ref 3} - dima {:db/id 3 :name "Dima" :email "@3" :ref 4} - olga {:db/id 4 :name "Olga" :email "@4" :ref 1} - db (d/db-with (d/empty-db {:name {:db/unique :db.unique/identity} - :email {:db/unique :db.unique/identity} - :slugs {:db/unique :db.unique/identity - :db/cardinality :db.cardinality/many} - :ref {:db/unique :db.unique/identity - :db/type :db.type/ref}}) - [ivan petr dima olga]) - pull (fn [tx e] - (d/pull (:db-after tx) ['* {[:ref :xform #(:db/id %)] [:db/id]}] e)) - tempids (fn [tx] - (dissoc (:tempids tx) :db/current-tx))] + (let [db (d/db-with (d/empty-db {:name { :db/unique :db.unique/identity } + :email { :db/unique :db.unique/identity } + :slugs { :db/unique :db.unique/identity + :db/cardinality :db.cardinality/many }}) + [{:db/id 1 :name "Ivan" :email "@1"} + {:db/id 2 :name "Petr" :email "@2"}]) + touched (fn [tx e] (into {} (d/touch (d/entity (:db-after tx) e)))) + tempids (fn [tx] (dissoc (:tempids tx) :db/current-tx))] (testing "upsert, no tempid" (let [tx (d/with db [{:name "Ivan" :age 35}])] - (is (= {:db/id 1 :name "Ivan" :email "@1" :age 35} - (pull tx 1))) - (is (= {} - (tempids tx))))) + (is (= (touched tx 1) + {:name "Ivan" :email "@1" :age 35})) + (is (= (tempids tx) + {})))) (testing "upsert by 2 attrs, no tempid" (let [tx (d/with db [{:name "Ivan" :email "@1" :age 35}])] - (is (= {:db/id 1 :name "Ivan" :email "@1" :age 35} - (pull tx 1))) - (is (= {} - (tempids tx))))) + (is (= (touched tx 1) + {:name "Ivan" :email "@1" :age 35})) + (is (= (tempids tx) + {})))) (testing "upsert with tempid" (let [tx (d/with db [{:db/id -1 :name "Ivan" :age 35}])] - (is (= {:db/id 1 :name "Ivan" :email "@1" :age 35} - (pull tx 1))) + (is (= (touched tx 1) + {:name "Ivan" :email "@1" :age 35})) (is (= (tempids tx) - {-1 1})))) + {-1 1})))) (testing "upsert with string tempid" (let [tx (d/with db [{:db/id "1" :name "Ivan" :age 35} [:db/add "2" :name "Oleg"] [:db/add "2" :email "@2"]])] - (is (= {:db/id 1 :name "Ivan" :email "@1" :age 35} - (pull tx 1))) - (is (= {:db/id 2 :name "Oleg" :email "@2" :ref 3} - (pull tx 2))) + (is (= (touched tx 1) + {:name "Ivan" :email "@1" :age 35})) + (is (= (touched tx 2) + {:name "Oleg" :email "@2"})) (is (= (tempids tx) - {"1" 1 - "2" 2})))) + {"1" 1 + "2" 2})))) (testing "upsert by 2 attrs with tempid" (let [tx (d/with db [{:db/id -1 :name "Ivan" :email "@1" :age 35}])] - (is (= {:db/id 1 :name "Ivan" :email "@1" :age 35} - (pull tx 1))) + (is (= (touched tx 1) + {:name "Ivan" :email "@1" :age 35})) (is (= (tempids tx) - {-1 1})))) + {-1 1})))) (testing "upsert to two entities, resolve to same tempid" (let [tx (d/with db [{:db/id -1 :name "Ivan" :age 35} {:db/id -1 :name "Ivan" :age 36}])] - (is (= {:db/id 1 :name "Ivan" :email "@1" :age 36} - (pull tx 1))) + (is (= (touched tx 1) + {:name "Ivan" :email "@1" :age 36})) (is (= (tempids tx) - {-1 1})))) + {-1 1})))) (testing "upsert to two entities, two tempids" (let [tx (d/with db [{:db/id -1 :name "Ivan" :age 35} {:db/id -2 :name "Ivan" :age 36}])] - (is (= {:db/id 1 :name "Ivan" :email "@1" :age 36} - (pull tx 1))) + (is (= (touched tx 1) + {:name "Ivan" :email "@1" :age 36})) (is (= (tempids tx) - {-1 1, -2 1})))) + {-1 1, -2 1})))) (testing "upsert with existing id" (let [tx (d/with db [{:db/id 1 :name "Ivan" :age 35}])] - (is (= {:db/id 1 :name "Ivan" :email "@1" :age 35} - (pull tx 1))) + (is (= (touched tx 1) + {:name "Ivan" :email "@1" :age 35})) (is (= (tempids tx) - {})))) + {})))) (testing "upsert by 2 attrs with existing id" (let [tx (d/with db [{:db/id 1 :name "Ivan" :email "@1" :age 35}])] - (is (= {:db/id 1 :name "Ivan" :email "@1" :age 35} - (pull tx 1))) + (is (= (touched tx 1) + {:name "Ivan" :email "@1" :age 35})) (is (= (tempids tx) - {})))) + {})))) (testing "upsert by 2 attrs with existing id as lookup ref" (let [tx (d/with db [{:db/id [:name "Ivan"] :name "Ivan" :email "@1" :age 35}])] - (is (= {:db/id 1 :name "Ivan" :email "@1" :age 35} - (pull tx 1))) + (is (= (touched tx 1) + {:name "Ivan" :email "@1" :age 35})) (is (= (tempids tx) - {})))) + {})))) (testing "upsert conflicts with existing id" - (is (thrown-with-msg? Throwable #"Conflicting upsert: \[:name \"Ivan\"\] resolves to 1, but entity already has :db/id 2" - (d/with db [{:db/id 2 :name "Ivan" :age 36}])))) + (is (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) + #"Conflicting upsert: \[:name \"Ivan\"\] resolves to 1, but entity already has :db/id 2" + (d/with db [{:db/id 2 :name "Ivan" :age 36}])))) (testing "upsert conflicts with non-existing id" - (is (thrown-with-msg? Throwable #"Conflicting upsert: \[:name \"Ivan\"\] resolves to 1, but entity already has :db/id 5" - (d/with db [{:db/id 5 :name "Ivan" :age 36}])))) + (is (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) + #"Conflicting upsert: \[:name \"Ivan\"\] resolves to 1, but entity already has :db/id 3" + (d/with db [{:db/id 3 :name "Ivan" :age 36}])))) (testing "upsert by non-existing value resolves as update" - (let [tx (d/with db [{:name "Ivan" :email "@5" :age 35}])] - (is (= {:db/id 1 :name "Ivan" :email "@5" :age 35} - (pull tx 1))) - (is (= {} - (tempids tx))))) + (let [tx (d/with db [{:name "Ivan" :email "@3" :age 35}])] + (is (= (touched tx 1) + {:name "Ivan" :email "@3" :age 35})) + (is (= (tempids tx) + {})))) (testing "upsert by 2 conflicting fields" - (is (thrown-with-msg? Throwable #"Conflicting upserts: \[:name \"Ivan\"\] resolves to 1, but \[:email \"@2\"\] resolves to 2" - (d/with db [{:name "Ivan" :email "@2" :age 35}])))) + (is (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) + #"Conflicting upserts: \[:name \"Ivan\"\] resolves to 1, but \[:email \"@2\"\] resolves to 2" + (d/with db [{:name "Ivan" :email "@2" :age 35}])))) (testing "upsert over intermediate db" (let [tx (d/with db [{:name "Igor" :age 35} {:name "Igor" :age 36}])] - (is (= {:db/id 5 :name "Igor" :age 36} - (pull tx 5))) - (is (= {} - (tempids tx))))) + (is (= (touched tx 3) + {:name "Igor" :age 36})) + (is (= (tempids tx) + {3 3})))) (testing "upsert over intermediate db, tempids" (let [tx (d/with db [{:db/id -1 :name "Igor" :age 35} {:db/id -1 :name "Igor" :age 36}])] - (is (= {:db/id 5 :name "Igor" :age 36} - (pull tx 5))) + (is (= (touched tx 3) + {:name "Igor" :age 36})) (is (= (tempids tx) - {-1 5})))) + {-1 3})))) (testing "upsert over intermediate db, different tempids" (let [tx (d/with db [{:db/id -1 :name "Igor" :age 35} {:db/id -2 :name "Igor" :age 36}])] - (is (= {:db/id 5 :name "Igor" :age 36} - (pull tx 5))) + (is (= (touched tx 3) + {:name "Igor" :age 36})) (is (= (tempids tx) - {-1 5, -2 5})))) + {-1 3, -2 3})))) (testing "upsert and :current-tx conflict" - (is (thrown-with-msg? Throwable #"Conflicting upsert: \[:name \"Ivan\"\] resolves to 1, but entity already has :db/id \d+" - (d/with db [{:db/id :db/current-tx :name "Ivan" :age 35}])))) + (is (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) + #"Conflicting upsert: \[:name \"Ivan\"\] resolves to 1, but entity already has :db/id \d+" + (d/with db [{:db/id :db/current-tx :name "Ivan" :age 35}])))) (testing "upsert of unique, cardinality-many values" (let [tx (d/with db [{:name "Ivan" :slugs "ivan1"} {:name "Petr" :slugs "petr1"}]) tx2 (d/with (:db-after tx) [{:name "Ivan" :slugs ["ivan1" "ivan2"]}])] - (is (= {:db/id 1 :name "Ivan" :email "@1" :slugs ["ivan1"]} - (pull tx 1))) - (is (= {:db/id 1 :name "Ivan" :email "@1" :slugs ["ivan1" "ivan2"]} - (pull tx2 1))) - (is (thrown-with-msg? Throwable #"Conflicting upserts:" - (d/with (:db-after tx) [{:slugs ["ivan1" "petr1"]}]))))) - - (testing "upsert by ref" - (let [tx (d/with db [{:ref 3 :age 36}])] - (is (= {:db/id 2 :name "Petr" :email "@2" :ref 3 :age 36} - (pull tx 2)))) - (let [tx (d/with db [{:ref 4 :age 37}])] - (is (= {:db/id 3 :name "Dima" :email "@3" :ref 4 :age 37} - (pull tx 3)))) - (let [tx (d/with db [{:ref 1 :age 38}])] - (is (= {:db/id 4 :name "Olga" :email "@4" :ref 1 :age 38} - (pull tx 4))))) - - (testing "upsert by lookup ref" - (let [tx (d/with db [{:ref [:name "Dima"] :age 36}])] - (is (= {:db/id 2 :name "Petr" :email "@2" :ref 3 :age 36} - (pull tx 2)))) - (let [tx (d/with db [{:ref [:name "Olga"] :age 37}])] - (is (= {:db/id 3 :name "Dima" :email "@3" :ref 4 :age 37} - (pull tx 3)))) - (let [tx (d/with db [{:ref [:name "Ivan"] :age 38}])] - (is (= {:db/id 4 :name "Olga" :email "@4" :ref 1 :age 38} - (pull tx 4))))) - - ;; issue-464 - (testing "not upsert by ref" - (let [tx (d/with db [{:db/id -1 :name "Igor"} - {:db/id -2 :name "Anna" :ref -1}])] - (is (= {:db/id 5 :name "Igor"} (pull tx 5))) - (is (= {:db/id 6 :name "Anna" :ref 5} (pull tx 6)))) - - (let [tx (d/with db [{:db/id "A" :name "Igor"} - {:db/id "B" :name "Anna" :ref "A"}])] - (is (= {:db/id 5 :name "Igor"} (pull tx 5))) - (is (= {:db/id 6 :name "Anna" :ref 5} (pull tx 6))))))) + (is (= (touched tx 1) + {:name "Ivan" :email "@1" :slugs #{"ivan1"}})) + (is (= (touched tx2 1) + {:name "Ivan" :email "@1" :slugs #{"ivan1" "ivan2"}})) + (is (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) #"Conflicting upserts:" + (d/with (:db-after tx) [{:slugs ["ivan1" "petr1"]}]))))) + )) + (deftest test-redefining-ids - (let [db (-> (d/empty-db {:name {:db/unique :db.unique/identity}}) - (d/db-with [{:db/id -1 :name "Ivan"}]))] + (let [db (-> (d/empty-db {:name { :db/unique :db.unique/identity }}) + (d/db-with [{:db/id -1 :name "Ivan"}]))] (let [tx (d/with db [{:db/id -1 :age 35} {:db/id -1 :name "Ivan" :age 36}])] (is (= #{[1 :age 36] [1 :name "Ivan"]} - (tdc/all-datoms (:db-after tx)))) + (tdc/all-datoms (:db-after tx)))) (is (= {-1 1, :db/current-tx (+ d/tx0 2)} - (:tempids tx))))) + (:tempids tx))))) - (let [db (-> (d/empty-db {:name {:db/unique :db.unique/identity}}) - (d/db-with [{:db/id -1 :name "Ivan"} - {:db/id -2 :name "Oleg"}]))] - (is (thrown-with-msg? Throwable #"Conflicting upsert: -1 resolves both to 1 and 2" - (d/with db [{:db/id -1 :name "Ivan" :age 35} - {:db/id -1 :name "Oleg" :age 36}]))))) - -;; issue-285 + (let [db (-> (d/empty-db {:name { :db/unique :db.unique/identity }}) + (d/db-with [{:db/id -1 :name "Ivan"} + {:db/id -2 :name "Oleg"}]))] + (is (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) + #"Conflicting upsert: -1 resolves both to 1 and 2" + (d/with db [{:db/id -1 :name "Ivan" :age 35} + {:db/id -1 :name "Oleg" :age 36}]))))) + +;; https://github.com/tonsky/datascript/issues/285 (deftest test-retries-order (let [db (-> (d/empty-db {:name {:db/unique :db.unique/identity}}) - (d/db-with [[:db/add -1 :age 42] - [:db/add -2 :likes "Pizza"] - [:db/add -1 :name "Bob"] - [:db/add -2 :name "Bob"]]))] + (d/db-with [[:db/add -1 :age 42] + [:db/add -2 :likes "Pizza"] + [:db/add -1 :name "Bob"] + [:db/add -2 :name "Bob"]]))] (is (= {:db/id 1, :name "Bob", :likes "Pizza", :age 42} - (tdc/entity-map db 1)))) + (tdc/entity-map db 1)))) (let [db (-> (d/empty-db {:name {:db/unique :db.unique/identity}}) - (d/db-with [[:db/add -1 :age 42] - [:db/add -2 :likes "Pizza"] - [:db/add -2 :name "Bob"] - [:db/add -1 :name "Bob"]]))] + (d/db-with [[:db/add -1 :age 42] + [:db/add -2 :likes "Pizza"] + [:db/add -2 :name "Bob"] + [:db/add -1 :name "Bob"]]))] (is (= {:db/id 2, :name "Bob", :likes "Pizza", :age 42} - (tdc/entity-map db 2))))) + (tdc/entity-map db 2))))) -;; issue-403 +;; https://github.com/tonsky/datascript/issues/403 (deftest test-upsert-string-tempid-ref (let [db (-> (d/empty-db {:name {:db/unique :db.unique/identity} :ref {:db/valueType :db.type/ref}}) - (d/db-with [{:name "Alice"}])) + (d/db-with [{:name "Alice"}])) expected #{[1 :name "Alice"] [2 :age 36] [2 :ref 1]}] @@ -250,43 +217,24 @@ (d/db-with db [[:db/add -1, :name "Alice"] {:age 36, :ref -1}])))))) -;; issue-472 -(deftest test-two-tempids-two-retries - (let [schema {:name {:db/unique :db.unique/identity} - :ref {:db/valueType :db.type/ref}} - db (d/db-with - (d/empty-db schema) - [{:name "Alice"} - {:name "Bob"}]) - expected #{[1 :name "Alice"] - [2 :name "Bob"] - [3 :ref 1] - [4 :ref 2]}] - (is (= expected - (tdc/all-datoms - (d/db-with db - [{:db/id 3, :ref "A"} - {:db/id 4, :ref "B"} - {:db/id "A", :name "Alice"} - {:db/id "B", :name "Bob"}])))))) - (deftest test-vector-upsert (let [db (-> (d/empty-db {:name {:db/unique :db.unique/identity}}) - (d/db-with [{:db/id -1, :name "Ivan"}]))] + (d/db-with [{:db/id -1, :name "Ivan"}]))] (are [tx res] (= res (tdc/all-datoms (d/db-with db tx))) [[:db/add -1 :name "Ivan"] [:db/add -1 :age 12]] #{[1 :age 12] [1 :name "Ivan"]} - + [[:db/add -1 :age 12] [:db/add -1 :name "Ivan"]] #{[1 :age 12] [1 :name "Ivan"]})) - (let [db (-> (d/empty-db {:name {:db/unique :db.unique/identity}}) - (d/db-with [[:db/add -1 :name "Ivan"] - [:db/add -2 :name "Oleg"]]))] - (is (thrown-with-msg? Throwable #"Conflicting upsert: -1 resolves both to 1 and 2" - (d/with db [[:db/add -1 :name "Ivan"] - [:db/add -1 :age 35] - [:db/add -1 :name "Oleg"] - [:db/add -1 :age 36]]))))) + (let [db (-> (d/empty-db {:name { :db/unique :db.unique/identity }}) + (d/db-with [[:db/add -1 :name "Ivan"] + [:db/add -2 :name "Oleg"]]))] + (is (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) + #"Conflicting upsert: -1 resolves both to 1 and 2" + (d/with db [[:db/add -1 :name "Ivan"] + [:db/add -1 :age 35] + [:db/add -1 :name "Oleg"] + [:db/add -1 :age 36]]))))) diff --git a/test/datascript/test/validation.cljc b/test/datascript/test/validation.cljc index e8ff902f..4ebad7fd 100644 --- a/test/datascript/test/validation.cljc +++ b/test/datascript/test/validation.cljc @@ -1,47 +1,49 @@ (ns datascript.test.validation (:require - [clojure.test :as t :refer [is are deftest testing]] - [datascript.core :as d] - [datascript.test.core :as tdc])) + #?(:cljd [cljd.test :as t :refer [is are deftest testing]] + :cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + [datascript.core :as d] + #?(:cljd [cljd.core :refer [ExceptionInfo]]) + [datascript.test.core :as tdc])) #?(:cljs - (def Throwable - js/Error)) + (def Throwable js/Error)) (deftest test-with-validation (let [db (d/empty-db {:profile {:db/valueType :db.type/ref} :id {:db/unique :db.unique/identity}})] - (are [tx] (thrown-with-msg? Throwable #"Expected number, string or lookup ref for :db/id" (d/db-with db tx)) + (are [tx] (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) #"Expected number, string or lookup ref for :db/id" (d/db-with db tx)) [{:db/id #"" :name "Ivan"}]) - - (are [tx] (thrown-with-msg? Throwable #"Bad entity attribute" (d/db-with db tx)) + + (are [tx] (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) #"Bad entity attribute" (d/db-with db tx)) [[:db/add -1 nil "Ivan"]] [[:db/add -1 17 "Ivan"]] [{:db/id -1 17 "Ivan"}]) - - (are [tx] (thrown-with-msg? Throwable #"Cannot store nil as a value" (d/db-with db tx)) + + (are [tx] (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) #"Cannot store nil as a value" (d/db-with db tx)) [[:db/add -1 :name nil]] [{:db/id -1 :name nil}] [[:db/add -1 :id nil]] [{:db/id -1 :id "A"} {:db/id -1 :id nil}]) - - (are [tx] (thrown-with-msg? Throwable #"Expected number or lookup ref for entity id" (d/db-with db tx)) + + (are [tx] (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) #"Expected number or lookup ref for entity id" (d/db-with db tx)) [[:db/add nil :name "Ivan"]] [[:db/add {} :name "Ivan"]] [[:db/add -1 :profile #"regexp"]] [{:db/id -1 :profile #"regexp"}]) - - (is (thrown-with-msg? Throwable #"Unknown operation" (d/db-with db [["aaa" :name "Ivan"]]))) - (is (thrown-with-msg? Throwable #"Bad entity type at" (d/db-with db [:db/add "aaa" :name "Ivan"]))) - (is (thrown-with-msg? Throwable #"Tempids are allowed in :db/add only" (d/db-with db [[:db/retract -1 :name "Ivan"]]))) - (is (thrown-with-msg? Throwable #"Bad transaction data" (d/db-with db {:profile "aaa"}))))) + + (is (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) #"Unknown operation" (d/db-with db [["aaa" :name "Ivan"]]))) + (is (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) #"Bad entity type at" (d/db-with db [:db/add "aaa" :name "Ivan"]))) + (is (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) #"Tempids are allowed in :db/add only" (d/db-with db [[:db/retract -1 :name "Ivan"]]))) + (is (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) #"Bad transaction data" (d/db-with db {:profile "aaa"}))))) (deftest test-unique (let [db (d/db-with (d/empty-db {:name {:db/unique :db.unique/value}}) - [[:db/add 1 :name "Ivan"] - [:db/add 2 :name "Petr"]])] - (are [tx] (thrown-with-msg? Throwable #"unique constraint" (d/db-with db tx)) + [[:db/add 1 :name "Ivan"] + [:db/add 2 :name "Petr"]])] + (are [tx] (thrown-with-msg? #?(:cljd ExceptionInfo :default Throwable) #"unique constraint" (d/db-with db tx)) [[:db/add 3 :name "Ivan"]] [{:db/add 3 :name "Petr"}]) (d/db-with db [[:db/add 3 :name "Igor"]])