greg/mentat
1
0
Fork 0
Code Issues 294 Pull requests Packages Projects Releases 9 Wiki Activity

Strip out Clojure tests and release directories.

Browse source
This commit is contained in:
Richard Newman 2016-12-16 10:30:57 -08:00
parent 9cc26616a9
commit 73f179c887
30 changed files with 0 additions and 4372 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
package.json
View file

@ -1,53 +0,0 @@
{
"name": "datomish",
"private": "true",
"engines": {
"node": "6.x.x"
},
"version": "0.3.7",
"description": "A persistent, embedded knowledge base inspired by Datomic and DataScript.",
"dependencies": {
"promise-sqlite": "1.5.0",
"source-map-support": "ncalexan/node-source-map-support#fileUrls-plus",
"sqlite3": "3.1.8",
"thenify-all": "^1.6.0",
"tmp": "0.0.28",
"ws": "1.1.1"
},
"scripts": {
"test": "babel-node test/js/tests.js"
},
"devDependencies": {
"babel-cli": "^6.14.0",
"babel-core": "6.14.0",
"babel-eslint": "6.1.2",
"babel-loader": "6.2.5",
"babel-plugin-transform-async-to-generator": "6.8.0",
"babel-plugin-transform-class-properties": "6.11.5",
"babel-plugin-transform-es2015-destructuring": "6.9.0",
"babel-plugin-transform-es2015-modules-commonjs": "6.11.5",
"babel-plugin-transform-es2015-parameters": "6.11.4",
"babel-plugin-transform-object-rest-spread": "6.8.0",
"babel-plugin-transform-runtime": "6.12.0",
"babel-polyfill": "6.13.0",
"babel-preset-react": "6.11.1",
"babel-preset-react-optimize": "1.0.1",
"babel-register": "6.14.0",
"babel-runtime": "6.11.6",
"tmp": "0.0.28"
},
"repository": {
"type": "git",
"url": "git+https://github.com/mozilla/datomish.git"
},
"author": "Mozilla Corporation",
"license": "Apache-2.0",
"bugs": {
"url": "https://github.com/mozilla/datomish/issues"
},
"homepage": "https://github.com/mozilla/datomish#readme",
"main": "./datomish.js",
"files": [
"datomish.js"
]
}

115
project.clj
View file

@ -1,115 +0,0 @@
(defproject mozilla/datomish "0.3.7"
:description "A persistent, embedded knowledge base inspired by Datomic and DataScript."
:url "https://github.com/mozilla/datomish"
:license {:name "Apache License, Version 2.0"
:url "https://www.apache.org/licenses/LICENSE-2.0"}
:dependencies [[org.clojure/clojurescript "1.9.229"]
[org.clojure/clojure "1.8.0"]
[org.clojure/core.async "0.2.385"]
[datascript "0.15.4"]
[org.clojars.rnewman/honeysql "0.8.2"]
;[com.taoensso/tufte "1.0.2"]
[jamesmacaulay/cljs-promises "0.1.0"]]
;; The browser will never require from the .JAR anyway.
:source-paths [
"src/common"
;; Can't be enabled by default: layers on top of cljsbuild!
;; Instead, add the :node profile:
;; lein with-profile node install
;; "src/node"
]
:test-paths ["test" "src/helpers"]
:cljsbuild {:builds
{
:release-node
{
:source-paths ["src/common" "src/node"]
:assert false
:compiler
{
;; :externs specified in deps.cljs.
:elide-asserts true
:hashbang false
:language-in :ecmascript5
:language-out :ecmascript5
:optimizations :advanced
:output-dir "target/release-node"
:output-to "target/release-node/datomish.bare.js"
:output-wrapper false
:parallel-build true
:pretty-print true
:pseudo-names true
:static-fns true
:target :nodejs
}
:notify-command ["release-node/wrap_bare.sh"]}
:release-browser
;; Release builds for use in Firefox must:
;; * Use :optimizations > :none, so that a single file is generated
;; without a need to import Closure's own libs.
;; * Be wrapped, so that a CommonJS module is produced.
;; * Have a preload script that defines what `println` does.
;;
;; There's no point in generating a source map -- it'll be wrong
;; due to wrapping.
{
:source-paths ["src/common" "src/browser"]
:assert false
:compiler
{
:elide-asserts true
:externs ["src/browser/externs/datomish.js"]
:language-in :ecmascript5
:language-out :ecmascript5
:optimizations :advanced
:output-dir "target/release-browser"
:output-to "target/release-browser/datomish.bare.js"
:output-wrapper false
:parallel-build true
:preloads [datomish.preload]
:pretty-print true
:pseudo-names true
:static-fns true
}
:notify-command ["release-browser/wrap_bare.sh"]}
:test
{
:source-paths ["src/common" "src/node" "src/helpers" "test"]
:compiler
{
:language-in :ecmascript5
:language-out :ecmascript5
:main datomish.test
:optimizations :none
:output-dir "target/test"
:output-to "target/test/datomish.js"
:parallel-build true
:source-map true
:target :nodejs
}}
}}
:profiles {:node {:source-paths ["src/common" "src/node"]}
:dev {:dependencies [[cljsbuild "1.1.3"]
[tempfile "0.2.0"]
[com.cemerick/piggieback "0.2.1"]
[org.clojure/tools.nrepl "0.2.10"]
[org.clojure/java.jdbc "0.6.2-alpha3"]
[org.xerial/sqlite-jdbc "3.15.1"]]
:jvm-opts ["-Xss4m"]
:repl-options {:nrepl-middleware [cemerick.piggieback/wrap-cljs-repl]}
:plugins [[lein-cljsbuild "1.1.3"]
[lein-doo "0.1.6"]
[venantius/ultra "0.4.1"]
[com.jakemccrary/lein-test-refresh "0.16.0"]]
}}
:doo {:build "test"}
:clean-targets ^{:protect false} ["target"]
)

5
release-browser/README.md
View file

@ -1,5 +0,0 @@
# Datomish
Datomish is a persistent, embedded knowledge base. It's written in ClojureScript, and draws heavily on [DataScript](https://github.com/tonsky/datascript) and [Datomic](http://datomic.com).
For more info, check out the [project page](https://github.com/mozila/datomish).

7
release-browser/wrap_bare.sh
View file

@ -1,7 +0,0 @@
#!/bin/sh
set -e
(cat release-browser/wrapper.prefix; cat target/release-browser/datomish.bare.js; cat release-browser/wrapper.suffix) > target/release-browser/datomish.js
echo "Packed target/release-browser/datomish.js"

41
release-browser/wrapper.prefix
View file

@ -1,41 +0,0 @@
/* Copyright 2016 Mozilla
*
* Licensed under the Apache License, Version 2.0 (the "License"); you may not use
* this file except in compliance with the License. You may obtain a copy of the
* License at http://www.apache.org/licenses/LICENSE-2.0
* Unless required by applicable law or agreed to in writing, software distributed
* under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
* CONDITIONS OF ANY KIND, either express or implied. See the License for the
* specific language governing permissions and limitations under the License.
*/
// Datomish 0.3.0
(function (definition) {
// This file will function properly as a <script> tag, or a module
// using CommonJS and NodeJS or RequireJS module formats.
// Wrapper gratefully adapted from:
// https://github.com/kriskowal/q/blob/v1/q.js
// https://github.com/swannodette/mori/blob/master/support/wrapper.js
// https://github.com/tonsky/datascript/blob/master/release-js/wrapper.js
// CommonJS
if (typeof exports === "object") {
module.exports = definition();
// RequireJS
} else if (typeof define === "function" && define.amd) {
define(definition);
// <script>
} else {
datomish = definition();
}
})(function () {
return function () {
// Monkeypatch setTimeout so that the Closure Compiler
// output can use it in a Sandbox context.
var { setTimeout } = require("sdk/timers");
this.setTimeout = setTimeout;

6
release-browser/wrapper.suffix
View file

@ -1,6 +0,0 @@
;return this.datomish.js;
}.call({});
});

5
release-node/README.md
View file

@ -1,5 +0,0 @@
# Datomish
Datomish is a persistent, embedded knowledge base. It's written in ClojureScript, and draws heavily on [DataScript](https://github.com/tonsky/datascript) and [Datomic](http://datomic.com).
For more info, check out the [project page](https://github.com/mozila/datomish).

2
release-node/test_include_node.js
View file

@ -1,2 +0,0 @@
var d = require('../target/release-node/datomish');
console.log(d.q("[:find ?e ?v :where [?e \"name\" ?v] {:x :y}]"));

7
release-node/wrap_bare.sh
View file

@ -1,7 +0,0 @@
#!/bin/sh
set -e
(cat release-node/wrapper.prefix && cat target/release-node/datomish.bare.js && cat release-node/wrapper.suffix) > target/release-node/datomish.js
echo "Packed target/release-node/datomish.js"

36
release-node/wrapper.prefix
View file

@ -1,36 +0,0 @@
/* Copyright 2016 Mozilla
*
* Licensed under the Apache License, Version 2.0 (the "License"); you may not use
* this file except in compliance with the License. You may obtain a copy of the
* License at http://www.apache.org/licenses/LICENSE-2.0
* Unless required by applicable law or agreed to in writing, software distributed
* under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
* CONDITIONS OF ANY KIND, either express or implied. See the License for the
* specific language governing permissions and limitations under the License.
*/
// Datomish 0.3.0
(function (definition) {
// This file will function properly as a <script> tag, or a module
// using CommonJS and NodeJS or RequireJS module formats.
// Wrapper gratefully adapted from:
// https://github.com/kriskowal/q/blob/v1/q.js
// https://github.com/swannodette/mori/blob/master/support/wrapper.js
// https://github.com/tonsky/datascript/blob/master/release-js/wrapper.js
// CommonJS
if (typeof exports === "object") {
module.exports = definition();
// RequireJS
} else if (typeof define === "function" && define.amd) {
define(definition);
// <script>
} else {
datomish = definition();
}
})(function () {
return function () {

6
release-node/wrapper.suffix
View file

@ -1,6 +0,0 @@
;return this.datomish.js;
}.call({});
});

14
repl.clj
View file

@ -1,14 +0,0 @@
(require 'cljs.repl)
(require 'cljs.build.api)
(require 'cljs.repl.node)
(cljs.build.api/build
"src"
{:main 'datomish.core
:output-to "target/datomish.js"
:verbose true})
(cljs.repl/repl
(cljs.repl.node/repl-env)
:watch "src"
:output-dir "target")

951
test/datomish/db_test.cljc
View file

@ -1,951 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
(ns datomish.db-test
#?(:cljs
(:require-macros
[datomish.pair-chan :refer [go-pair <?]]
[datomish.node-tempfile-macros :refer [with-tempfile]]
[cljs.core.async.macros :as a :refer [go]]))
(:require
[datomish.api :as d]
[datomish.db.debug :refer [<datoms-after <datoms>= <transactions-after <shallow-entity <fulltext-values]]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
[datomish.schema :as ds]
[datomish.simple-schema]
[datomish.sqlite :as s]
[datomish.sqlite-schema]
[datomish.datom]
#?@(:clj [[datomish.jdbc-sqlite]
[datomish.pair-chan :refer [go-pair <?]]
[tempfile.core :refer [tempfile with-tempfile]]
[datomish.test-macros :refer [deftest-async deftest-db]]
[clojure.test :as t :refer [is are deftest testing]]
[clojure.core.async :refer [go <! >!]]])
#?@(:cljs [[datomish.js-sqlite]
[datomish.pair-chan]
[datomish.test-macros :refer-macros [deftest-async deftest-db]]
[datomish.node-tempfile :refer [tempfile]]
[cljs.test :as t :refer-macros [is are deftest testing async]]
[cljs.core.async :as a :refer [<! >!]]]))
#?(:clj
(:import [clojure.lang ExceptionInfo]))
#?(:clj
(:import [datascript.db DB])))
#?(:cljs
(def Throwable js/Error))
(defn- tempids [tx]
(into {} (map (juxt (comp :idx first) second) (:tempids tx))))
(def test-schema
[{:db/id (d/id-literal :db.part/user)
:db/ident :x
:db/unique :db.unique/identity
:db/valueType :db.type/long
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :name
:db/unique :db.unique/identity
:db/valueType :db.type/string
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :y
:db/cardinality :db.cardinality/many
:db/valueType :db.type/long
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :aka
:db/cardinality :db.cardinality/many
:db/valueType :db.type/string
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :age
:db/valueType :db.type/long
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :email
:db/unique :db.unique/identity
:db/valueType :db.type/string
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :spouse
:db/unique :db.unique/value
:db/valueType :db.type/string
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :friends
:db/cardinality :db.cardinality/many
:db/valueType :db.type/ref
:db.install/_attribute :db.part/db}
])
(deftest-db test-add-one conn
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))]
(let [{:keys [tx txInstant]} (<? (d/<transact! conn [[:db/add 0 :name "valuex"]]))]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[0 :name "valuex"]}))
(is (= (<? (<transactions-after (d/db conn) tx0))
[[0 :name "valuex" tx 1] ;; TODO: true, not 1.
[tx :db/txInstant txInstant tx 1]])))))
(deftest-db test-add-two conn
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))
{tx1 :tx txInstant1 :txInstant} (<? (d/<transact! conn [[:db/add 1 :name "Ivan"]]))
{tx2 :tx txInstant2 :txInstant} (<? (d/<transact! conn [[:db/add 1 :name "Petr"]]))
{tx3 :tx txInstant3 :txInstant} (<? (d/<transact! conn [[:db/add 1 :aka "Tupen"]]))
{tx4 :tx txInstant4 :txInstant} (<? (d/<transact! conn [[:db/add 1 :aka "Devil"]]))]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[1 :name "Petr"]
[1 :aka "Tupen"]
[1 :aka "Devil"]}))
(is (= (<? (<transactions-after (d/db conn) tx0))
[[1 :name "Ivan" tx1 1] ;; TODO: true, not 1.
[tx1 :db/txInstant txInstant1 tx1 1]
[1 :name "Ivan" tx2 0]
[1 :name "Petr" tx2 1]
[tx2 :db/txInstant txInstant2 tx2 1]
[1 :aka "Tupen" tx3 1]
[tx3 :db/txInstant txInstant3 tx3 1]
[1 :aka "Devil" tx4 1]
[tx4 :db/txInstant txInstant4 tx4 1]]))))
(deftest-db test-retract conn
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))
{tx1 :tx txInstant1 :txInstant} (<? (d/<transact! conn [[:db/add 0 :x 123]]))
{tx2 :tx txInstant2 :txInstant} (<? (d/<transact! conn [[:db/retract 0 :x 123]]))]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{}))
(is (= (<? (<transactions-after (d/db conn) tx0))
[[0 :x 123 tx1 1]
[tx1 :db/txInstant txInstant1 tx1 1]
[0 :x 123 tx2 0]
[tx2 :db/txInstant txInstant2 tx2 1]]))))
(deftest-db test-id-literal-1 conn
(let [tx0 (:tx (<? (d/<transact! conn test-schema)))
report (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :x 0]
[:db/add (d/id-literal :db.part/user -1) :y 1]
[:db/add (d/id-literal :db.part/user -2) :y 2]
[:db/add (d/id-literal :db.part/user -2) :y 3]]))]
(is (= (keys (:tempids report)) ;; TODO: include values.
[(d/id-literal :db.part/user -1)
(d/id-literal :db.part/user -2)]))
(let [eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])
eid2 (get-in report [:tempids (d/id-literal :db.part/user -2)])]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :x 0]
[eid1 :y 1]
[eid2 :y 2]
[eid2 :y 3]})))))
(deftest-db test-unique conn
(let [tx0 (:tx (<? (d/<transact! conn test-schema)))]
(testing "Multiple :db/unique values in tx-data violate unique constraint, no tempid"
(is (thrown-with-msg?
ExceptionInfo #"unique constraint"
(<? (d/<transact! conn [[:db/add 1 :x 0]
[:db/add 2 :x 0]])))))
(testing "Multiple :db/unique values in tx-data violate unique constraint, tempid"
(is (thrown-with-msg?
ExceptionInfo #"unique constraint"
(<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :spouse "Dana"]
[:db/add (d/id-literal :db.part/user -2) :spouse "Dana"]])))))))
(deftest-db test-valueType-keyword conn
(let [tx0 (:tx (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1)
:db/ident :test/kw
:db/unique :db.unique/identity
:db/valueType :db.type/keyword}
{:db/id :db.part/db :db.install/attribute (d/id-literal :db.part/user -1)}])))]
(let [report (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :test/kw :test/kw1]]))
eid (get-in report [:tempids (d/id-literal :db.part/user -1)])]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid :test/kw ":test/kw1"]})) ;; Value is raw.
(testing "Adding the same value compares existing values correctly."
(<? (d/<transact! conn [[:db/add eid :test/kw :test/kw1]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid :test/kw ":test/kw1"]}))) ;; Value is raw.
(testing "Upserting retracts existing value correctly."
(<? (d/<transact! conn [[:db/add eid :test/kw :test/kw2]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid :test/kw ":test/kw2"]}))) ;; Value is raw.
(testing "Retracting compares values correctly."
(<? (d/<transact! conn [[:db/retract eid :test/kw :test/kw2]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{}))))))
(deftest-db test-vector-upsert conn
;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; succeed on top of each other, so we never need to reset the underlying store.
(<? (d/<transact! conn test-schema))
(let [tx0 (:tx (<? (d/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}])))]
(testing "upsert with tempid"
(let [report (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :name "Ivan"]
[:db/add (d/id-literal :db.part/user -1) :age 12]]))]
(is (= (<? (<shallow-entity (d/db conn) 101))
{:name "Ivan" :age 12 :email "@1"}))
(is (= (tempids report)
{-1 101}))))
(testing "upsert with tempid, order does not matter"
(let [report (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :age 13]
[:db/add (d/id-literal :db.part/user -1) :name "Petr"]]))]
(is (= (<? (<shallow-entity (d/db conn) 102))
{:name "Petr" :age 13 :email "@2"}))
(is (= (tempids report)
{-1 102}))))
(testing "Conflicting upserts fail"
(is (thrown-with-msg? Throwable #"Conflicting upsert"
(<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :name "Ivan"]
[:db/add (d/id-literal :db.part/user -1) :age 35]
[:db/add (d/id-literal :db.part/user -1) :name "Petr"]
[:db/add (d/id-literal :db.part/user -1) :age 36]])))))))
(deftest-db test-multistep-upsert conn
(<? (d/<transact! conn test-schema))
;; The upsert algorithm will first try to resolve -1, fail, and then allocate both -1 and -2.
(let [tx0 (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :email "@1"}
{:db/id (d/id-literal :db.part/user -2) :name "Petr" :friends (d/id-literal :db.part/user -1)}]))]
;; Sanity checks that these are freshly allocated, not resolved.
(is (> (get (tempids tx0) -1) 1000))
(is (> (get (tempids tx0) -1) 1000))
;; This time, we can resolve both, but we have to try -1, succeed, and then resolve -2.
(let [tx1 (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :email "@1"}
{:db/id (d/id-literal :db.part/user -2) :name "Petr" :friends (d/id-literal :db.part/user -1)}]))]
;; Ensure these are resolved, not freshly allocated.
(is (= (tempids tx0)
(tempids tx1))))))
(deftest-db test-map-upsert conn
;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; succeed on top of each other, so we never need to reset the underlying store.
(<? (d/<transact! conn test-schema))
(let [tx0 (:tx (<? (d/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}])))]
(testing "upsert with tempid"
(let [tx (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :age 35}]))]
(is (= (<? (<shallow-entity (d/db conn) 101))
{:name "Ivan" :email "@1" :age 35}))
(is (= (tempids tx)
{-1 101}))))
(testing "upsert by 2 attrs with tempid"
(let [tx (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :email "@1" :age 35}]))]
(is (= (<? (<shallow-entity (d/db conn) 101))
{:name "Ivan" :email "@1" :age 35}))
(is (= (tempids tx)
{-1 101}))))
(testing "upsert with existing id"
(let [tx (<? (d/<transact! conn [{:db/id 101 :name "Ivan" :age 36}]))]
(is (= (<? (<shallow-entity (d/db conn) 101))
{:name "Ivan" :email "@1" :age 36}))
(is (= (tempids tx)
{}))))
(testing "upsert by 2 attrs with existing id"
(let [tx (<? (d/<transact! conn [{:db/id 101 :name "Ivan" :email "@1" :age 37}]))]
(is (= (<? (<shallow-entity (d/db conn) 101))
{:name "Ivan" :email "@1" :age 37}))
(is (= (tempids tx)
{}))))
(testing "upsert to two entities, resolve to same tempid, fails due to overlapping writes"
(is (thrown-with-msg? Throwable #"cardinality constraint"
(<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :age 35}
{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :age 36}])))))
(testing "upsert to two entities, two tempids, fails due to overlapping writes"
(is (thrown-with-msg? Throwable #"cardinality constraint"
(<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :age 35}
{:db/id (d/id-literal :db.part/user -2) :name "Ivan" :age 36}])))))))
(deftest-db test-map-upsert-conflicts conn
;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; fail until the final one, so we never need to reset the underlying store.
(<? (d/<transact! conn test-schema))
(let [tx0 (:tx (<? (d/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}])))]
;; TODO: improve error message to refer to upsert inputs.
(testing "upsert conficts with existing id"
(is (thrown-with-msg? Throwable #"unique constraint"
(<? (d/<transact! conn [{:db/id 102 :name "Ivan" :age 36}])))))
;; TODO: improve error message to refer to upsert inputs.
(testing "upsert conficts with non-existing id"
(is (thrown-with-msg? Throwable #"unique constraint"
(<? (d/<transact! conn [{:db/id 103 :name "Ivan" :age 36}])))))
;; TODO: improve error message to refer to upsert inputs.
(testing "upsert by 2 conflicting fields"
(is (thrown-with-msg? Throwable #"Conflicting upsert"
(<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :email "@2" :age 35}])))))
(testing "upsert by non-existing value resolves as update"
(let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :email "@3" :age 35}]))]
(is (= (<? (<shallow-entity (d/db conn) 101))
{:name "Ivan" :email "@3" :age 35}))
(is (= (tempids report)
{-1 101}))))))
(deftest-db test-add-schema conn
(let [es [[:db/add :db.part/db :db.install/attribute (d/id-literal :db.part/db -1)]
{:db/id (d/id-literal :db.part/db -1)
:db/ident :test/attr
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one}]
report (<? (d/<transact! conn es))
db-after (:db-after report)
tx (:tx db-after)]
(testing "New ident is allocated"
(is (some? (d/entid db-after :test/attr))))
(testing "Schema is modified"
(is (= (get-in db-after [:symbolic-schema :test/attr])
{:db/valueType :db.type/string,
:db/cardinality :db.cardinality/one})))
(testing "Schema is used in subsequent transaction"
(<? (d/<transact! conn [{:db/id 100 :test/attr "value 1"}]))
(<? (d/<transact! conn [{:db/id 100 :test/attr "value 2"}]))
(is (= (<? (<shallow-entity (d/db conn) 100))
{:test/attr "value 2"})))))
(deftest-db test-fulltext conn
(let [schema [{:db/id (d/id-literal :db.part/db -1)
:db/ident :test/fulltext
:db/valueType :db.type/string
:db/fulltext true
:db/unique :db.unique/identity}
{:db/id :db.part/db :db.install/attribute (d/id-literal :db.part/db -1)}
{:db/id (d/id-literal :db.part/db -2)
:db/ident :test/other
:db/valueType :db.type/string
:db/fulltext true
:db/cardinality :db.cardinality/one}
{:db/id :db.part/db :db.install/attribute (d/id-literal :db.part/db -2)}
]
tx0 (:tx (<? (d/<transact! conn schema)))]
(testing "Schema checks"
(is (ds/fulltext? (d/schema (d/db conn))
(d/entid (d/db conn) :test/fulltext))))
(testing "Can add fulltext indexed datoms"
(let [{tx1 :tx txInstant1 :txInstant}
(<? (d/<transact! conn [[:db/add 101 :test/fulltext "test this"]]))]
(is (= (<? (<fulltext-values (d/db conn)))
[[1 "test this"]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :test/fulltext 1]})) ;; Values are raw; 1 is the rowid into fulltext_values.
(is (= (<? (<transactions-after (d/db conn) tx0))
[[101 :test/fulltext 1 tx1 1] ;; Values are raw; 1 is the rowid into fulltext_values.
[tx1 :db/txInstant txInstant1 tx1 1]]))
(testing "Can replace fulltext indexed datoms"
(let [{tx2 :tx txInstant2 :txInstant} (<? (d/<transact! conn [[:db/add 101 :test/fulltext "alternate thing"]]))]
(is (= (<? (<fulltext-values (d/db conn)))
[[1 "test this"]
[2 "alternate thing"]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :test/fulltext 2]})) ;; Values are raw; 2 is the rowid into fulltext_values.
(is (= (<? (<transactions-after (d/db conn) tx0))
[[101 :test/fulltext 1 tx1 1] ;; Values are raw; 1 is the rowid into fulltext_values.
[tx1 :db/txInstant txInstant1 tx1 1]
[101 :test/fulltext 1 tx2 0] ;; Values are raw; 1 is the rowid into fulltext_values.
[101 :test/fulltext 2 tx2 1] ;; Values are raw; 2 is the rowid into fulltext_values.
[tx2 :db/txInstant txInstant2 tx2 1]]))
(testing "Can upsert keyed by fulltext indexed datoms"
(let [{tx3 :tx txInstant3 :txInstant} (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user) :test/fulltext "alternate thing" :test/other "other"}]))]
(is (= (<? (<fulltext-values (d/db conn)))
[[1 "test this"]
[2 "alternate thing"]
[3 "other"]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :test/fulltext 2] ;; Values are raw; 2, 3 are the rowids into fulltext_values.
[101 :test/other 3]}))
(is (= (<? (<transactions-after (d/db conn) tx0))
[[101 :test/fulltext 1 tx1 1] ;; Values are raw; 1 is the rowid into fulltext_values.
[tx1 :db/txInstant txInstant1 tx1 1]
[101 :test/fulltext 1 tx2 0] ;; Values are raw; 1 is the rowid into fulltext_values.
[101 :test/fulltext 2 tx2 1] ;; Values are raw; 2 is the rowid into fulltext_values.
[tx2 :db/txInstant txInstant2 tx2 1]
[101 :test/other 3 tx3 1] ;; Values are raw; 3 is the rowid into fulltext_values.
[tx3 :db/txInstant txInstant3 tx3 1]]))
))))))
(testing "Can re-use fulltext indexed datoms"
(let [r (<? (d/<transact! conn [[:db/add 102 :test/other "test this"]]))]
(is (= (<? (<fulltext-values (d/db conn)))
[[1 "test this"]
[2 "alternate thing"]
[3 "other"]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :test/fulltext 2]
[101 :test/other 3]
[102 :test/other 1]})) ;; Values are raw; 1, 2, 3 are the rowids into fulltext_values.
))
(testing "Can retract fulltext indexed datoms"
(let [r (<? (d/<transact! conn [[:db/retract 101 :test/fulltext "alternate thing"]]))]
(is (= (<? (<fulltext-values (d/db conn)))
[[1 "test this"]
[2 "alternate thing"]
[3 "other"]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :test/other 3]
[102 :test/other 1]})) ;; Values are raw; 1, 3 are the rowids into fulltext_values.
))))
(deftest-db test-txInstant conn
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))
{txa :tx txInstantA :txInstant} (<? (d/<transact! conn []))]
(testing ":db/txInstant is set by default"
(is (= (<? (<transactions-after (d/db conn) tx0))
[[txa :db/txInstant txInstantA txa 1]])))
;; TODO: range check txInstant values against DB clock.
(testing ":db/txInstant can be set explicitly"
(let [{txb :tx txInstantB :txInstant} (<? (d/<transact! conn [[:db/add :db/tx :db/txInstant (+ txInstantA 1)]]))]
(is (= txInstantB (+ txInstantA 1)))
(is (= (<? (<transactions-after (d/db conn) txa))
[[txb :db/txInstant txInstantB txb 1]]))
(testing ":db/txInstant can be set explicitly, with additional datoms"
(let [{txc :tx txInstantC :txInstant} (<? (d/<transact! conn [[:db/add :db/tx :db/txInstant (+ txInstantB 2)]
[:db/add :db/tx :x 123]]))]
(is (= txInstantC (+ txInstantB 2)))
(is (= (<? (<transactions-after (d/db conn) txb))
[[txc :db/txInstant txInstantC txc 1]
[txc :x 123 txc 1]]))
(testing "additional datoms can be added, without :db/txInstant explicitly"
(let [{txd :tx txInstantD :txInstant} (<? (d/<transact! conn [[:db/add :db/tx :x 456]]))]
(is (= (<? (<transactions-after (d/db conn) txc))
[[txd :db/txInstant txInstantD txd 1]
[txd :x 456 txd 1]]))))))))))
(deftest-db test-no-tx conn
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))]
(testing "Cannot specificy an explicit tx"
(is (thrown-with-msg?
ExceptionInfo #"Bad entity: too long"
(<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user) :x 0 10101]])))))))
(deftest-db test-explode-sequences conn
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))]
(testing ":db.cardinality/many sequences are accepted"
(<? (d/<transact! conn [{:db/id 101 :aka ["first" "second"]}]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :aka "first"]
[101 :aka "second"]})))
(testing ":db.cardinality/many sequences are recursively applied, allowing unexpected sequence nesting"
(<? (d/<transact! conn [{:db/id 102 :aka [[["first"]] ["second"]]}]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :aka "first"]
[101 :aka "second"]
[102 :aka "first"]
[102 :aka "second"]})))
(testing ":db.cardinality/one sequences fail"
(is (thrown-with-msg?
ExceptionInfo #"Sequential values"
(<? (d/<transact! conn [{:db/id 101 :email ["@1" "@2"]}])))))))
(deftest-db test-explode-maps conn
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))]
(testing "nested maps are accepted"
(<? (d/<transact! conn [{:db/id 101 :friends {:name "Petr"}}]))
;; TODO: this works only because we have a single friend.
(let [{petr :friends} (<? (<shallow-entity (d/db conn) 101))]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :friends petr]
[petr :name "Petr"]}))))
(testing "recursively nested maps are accepted"
(<? (d/<transact! conn [{:db/id 102 :friends {:name "Ivan" :friends {:name "Petr"}}}]))
;; This would be much easier with `entity` and lookup refs.
(let [{ivan :friends} (<? (<shallow-entity (d/db conn) 102))
{petr :friends} (<? (<shallow-entity (d/db conn) ivan))]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :friends petr]
[petr :name "Petr"]
[102 :friends ivan]
[ivan :name "Ivan"]
[ivan :friends petr]}))))
(testing "nested maps without :db.type/ref fail"
(is (thrown-with-msg?
ExceptionInfo #"\{:db/valueType :db.type/ref\}"
(<? (d/<transact! conn [{:db/id 101 :aka {:name "Petr"}}])))))))
(deftest-db test-explode-reverse-refs conn
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))]
(testing "reverse refs are accepted"
(<? (d/<transact! conn [{:db/id 101 :name "Igor"}]))
(<? (d/<transact! conn [{:db/id 102 :name "Oleg" :_friends 101}]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :name "Igor"]
[102 :name "Oleg"]
[101 :friends 102]})))
(testing "reverse refs without :db.type/ref fail"
(is (thrown-with-msg?
ExceptionInfo #"\{:db/valueType :db.type/ref\}"
(<? (d/<transact! conn [{:db/id 101 :_aka 102}])))))))
;; We don't use deftest-db in order to be able to re-open an on disk file.
(deftest-async test-next-eid
(with-tempfile [t (tempfile)]
(let [conn (<? (d/<connect t))
{tx0 :tx} (<? (d/<transact! conn test-schema))]
(testing "entids are increasing, tx ids are larger than user ids"
(let [r1 (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Igor"}]))
r2 (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -2) :name "Oleg"}]))
e1 (get (tempids r1) -1)
e2 (get (tempids r2) -2)]
(is (< e1 (:tx r1)))
(is (< e2 (:tx r2)))
(is (< e1 e2))
(is (< (:tx r1) (:tx r2)))
;; Close and re-open same DB.
(<? (d/<close conn))
(let [conn (<? (d/<connect t))]
(try
(testing "entid counters are persisted across re-opens"
(let [r3 (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -3) :name "Petr"}]))
e3 (get (tempids r3) -3)]
(is (< e3 (:tx r3)))
(is (< e2 e3))
(is (< (:tx r2) (:tx r3)))))
(finally
(<? (d/<close conn))))))))))
(deftest-db test-unique-value conn
(let [tx0 (:tx (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1)
:db/ident :test/x
:db/unique :db.unique/value
:db/valueType :db.type/long
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user -2)
:db/ident :test/y
:db/unique :db.unique/value
:db/valueType :db.type/long
:db.install/_attribute :db.part/db}])))]
(testing "can insert different :db.unique/value attributes with the same value"
(let [report1 (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :test/x 12345]]))
eid1 (get-in report1 [:tempids (d/id-literal :db.part/user -1)])
report2 (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -2) :test/y 12345]]))
eid2 (get-in report2 [:tempids (d/id-literal :db.part/user -2)])]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :test/x 12345]
[eid2 :test/y 12345]}))))
(testing "can't upsert a :db.unique/value field"
(is (thrown-with-msg?
ExceptionInfo #"unique constraint"
(<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/x 12345 :test/y 99999}])))))))
(def retract-schema
[{:db/id (d/id-literal :db.part/user -1)
:db/ident :test/long
:db/cardinality :db.cardinality/many
:db/valueType :db.type/long
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user -2)
:db/ident :test/fulltext
:db/cardinality :db.cardinality/many
:db/valueType :db.type/string
:db/fulltext true
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user -3)
:db/ident :test/ref
:db/valueType :db.type/ref
:db.install/_attribute :db.part/db}])
(deftest-db test-retract-attribute conn
(let [tx0 (:tx (<? (d/<transact! conn retract-schema)))]
(testing "retractAttribute"
(let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/long [12345 123456]}
{:db/id (d/id-literal :db.part/user -2) :test/ref (d/id-literal :db.part/user -1)}]))
eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])
eid2 (get-in report [:tempids (d/id-literal :db.part/user -2)])]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :test/long 12345]
[eid1 :test/long 123456]
[eid2 :test/ref eid1]}))
(testing "retractAttribute with no matching datoms succeeds"
(<? (d/<transact! conn [[:db.fn/retractAttribute eid1 :test/ref]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :test/long 12345]
[eid1 :test/long 123456]
[eid2 :test/ref eid1]})))
(testing "retractAttribute retracts datoms"
(let [{tx1 :tx} (<? (d/<transact! conn [[:db.fn/retractAttribute eid2 :test/ref]]))]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :test/long 12345]
[eid1 :test/long 123456]})))
(let [{tx2 :tx} (<? (d/<transact! conn [[:db.fn/retractAttribute eid1 :test/long]]))]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{}))))))))
(deftest-db test-retract-attribute-multiple conn
(let [tx0 (:tx (<? (d/<transact! conn retract-schema)))]
(let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/long [12345 123456]}
{:db/id (d/id-literal :db.part/user -1) :test/fulltext ["1 fulltext value" "2 fulltext value"]}]))
eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])]
(is (= (<? (<fulltext-values (d/db conn)))
[[1 "1 fulltext value"]
[2 "2 fulltext value"]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :test/fulltext 1]
[eid1 :test/fulltext 2]
[eid1 :test/long 12345]
[eid1 :test/long 123456]}))
(testing "multiple retractAttribute in one transaction"
(let [{tx1 :tx} (<? (d/<transact! conn [[:db.fn/retractAttribute eid1 :test/long]
[:db.fn/retractAttribute eid1 :test/fulltext]]))]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{})))))))
(deftest-db test-retract-attribute-fulltext conn
(let [tx0 (:tx (<? (d/<transact! conn retract-schema)))]
(testing "retractAttribute, fulltext"
(let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/fulltext ["1 fulltext value" "2 fulltext value"]}
{:db/id (d/id-literal :db.part/user -2) :test/ref (d/id-literal :db.part/user -1)}]))
eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])
eid2 (get-in report [:tempids (d/id-literal :db.part/user -2)])]
(is (= (<? (<fulltext-values (d/db conn)))
[[1 "1 fulltext value"]
[2 "2 fulltext value"]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :test/fulltext 1]
[eid1 :test/fulltext 2]
[eid2 :test/ref eid1]}))
(testing "retractAttribute retracts datoms, fulltext"
(let [{tx1 :tx} (<? (d/<transact! conn [[:db.fn/retractAttribute eid2 :test/ref]]))]
;; fulltext values are not purged.
(is (= (<? (<fulltext-values (d/db conn)))
[[1 "1 fulltext value"]
[2 "2 fulltext value"]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :test/fulltext 1]
[eid1 :test/fulltext 2]})))
(let [{tx2 :tx} (<? (d/<transact! conn [[:db.fn/retractAttribute eid1 :test/fulltext]]))]
;; fulltext values are not purged.
(is (= (<? (<fulltext-values (d/db conn)))
[[1 "1 fulltext value"]
[2 "2 fulltext value"]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{}))))))))
(deftest-db test-retract-entity conn
(let [tx0 (:tx (<? (d/<transact! conn retract-schema)))]
(testing "retractEntity"
(let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/long [12345 123456]}
{:db/id (d/id-literal :db.part/user -2) :test/ref (d/id-literal :db.part/user -1)}
{:db/id (d/id-literal :db.part/user -3) :test/long 0xdeadbeef}]))
eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])
eid2 (get-in report [:tempids (d/id-literal :db.part/user -2)])
eid3 (get-in report [:tempids (d/id-literal :db.part/user -3)])]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :test/long 12345]
[eid1 :test/long 123456]
[eid2 :test/ref eid1]
[eid3 :test/long 0xdeadbeef]}))
(testing "retractEntity with no matching datoms succeeds"
(<? (d/<transact! conn [[:db.fn/retractEntity 0xdeadbeef]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :test/long 12345]
[eid1 :test/long 123456]
[eid2 :test/ref eid1]
[eid3 :test/long 0xdeadbeef]})))
(testing "retractEntity retracts datoms"
(let [{tx1 :tx} (<? (d/<transact! conn [[:db.fn/retractEntity eid3]]))]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :test/long 12345]
[eid1 :test/long 123456]
[eid2 :test/ref eid1]}))))
(testing "retractEntity retracts datoms and references"
(let [{tx2 :tx} (<? (d/<transact! conn [[:db.fn/retractEntity eid1]]))]
(is (= (<? (<datoms-after (d/db conn) tx0))
;; [eid2 :test/ref eid1] is gone, since the ref eid1 is gone.
#{}))))))))
(deftest-db test-retract-entity-multiple conn
(let [tx0 (:tx (<? (d/<transact! conn retract-schema)))]
(let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/long [12345 123456]}
{:db/id (d/id-literal :db.part/user -2) :test/fulltext ["1 fulltext value" "2 fulltext value"]}]))
eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])
eid2 (get-in report [:tempids (d/id-literal :db.part/user -2)])]
(is (= (<? (<fulltext-values (d/db conn)))
[[1 "1 fulltext value"]
[2 "2 fulltext value"]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid2 :test/fulltext 1]
[eid2 :test/fulltext 2]
[eid1 :test/long 12345]
[eid1 :test/long 123456]}))
(testing "multiple retractEntity in one transaction"
(let [{tx1 :tx} (<? (d/<transact! conn [[:db.fn/retractEntity eid1]
[:db.fn/retractEntity eid2]]))]
(is (= (<? (<datoms-after (d/db conn) tx0))
#{})))))))
(deftest-db test-retract-entity-fulltext conn
(let [tx0 (:tx (<? (d/<transact! conn retract-schema)))]
(testing "retractEntity, fulltext"
(let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/fulltext ["1 fulltext value" "2 fulltext value"]}
{:db/id (d/id-literal :db.part/user -2) :test/ref (d/id-literal :db.part/user -1)}
{:db/id (d/id-literal :db.part/user -3) :test/fulltext "3 fulltext value"}]))
eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])
eid2 (get-in report [:tempids (d/id-literal :db.part/user -2)])
eid3 (get-in report [:tempids (d/id-literal :db.part/user -3)])]
(is (= (<? (<fulltext-values (d/db conn)))
[[1 "1 fulltext value"]
[2 "2 fulltext value"]
[3 "3 fulltext value"]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :test/fulltext 1]
[eid1 :test/fulltext 2]
[eid2 :test/ref eid1]
[eid3 :test/fulltext 3]}))
(testing "retractEntity with no matching datoms succeeds, fulltext"
(<? (d/<transact! conn [[:db.fn/retractEntity 0xdeadbeef]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :test/fulltext 1]
[eid1 :test/fulltext 2]
[eid2 :test/ref eid1]
[eid3 :test/fulltext 3]})))
(testing "retractEntity retracts datoms, fulltext"
(let [{tx1 :tx} (<? (d/<transact! conn [[:db.fn/retractEntity eid3]]))]
;; fulltext values are not purged.
(is (= (<? (<fulltext-values (d/db conn)))
[[1 "1 fulltext value"]
[2 "2 fulltext value"]
[3 "3 fulltext value"]]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :test/fulltext 1]
[eid1 :test/fulltext 2]
[eid2 :test/ref eid1]}))))
(testing "retractEntity retracts datoms and references, fulltext"
(let [{tx2 :tx} (<? (d/<transact! conn [[:db.fn/retractEntity eid1]]))]
(is (= (<? (<datoms-after (d/db conn) tx0))
;; [eid2 :test/ref eid1] is gone, since the ref eid1 is gone.
#{}))))))))
;; We don't use deftest-db in order to be able to re-open an on disk file.
(deftest-async test-reopen-schema
(with-tempfile [t (tempfile)]
(let [conn (<? (d/<connect t))
test-schema [{:db/id (d/id-literal :db.part/user -1)
:db/ident :test/fulltext
:db/cardinality :db.cardinality/many
:db/valueType :db.type/string
:db/fulltext true
:db/doc "Documentation string"
:db.install/_attribute :db.part/db}]
{tx0 :tx} (<? (d/<transact! conn test-schema))]
(testing "Values in schema are correct initially"
(let [db (d/db conn)
schema (d/schema db)]
(is (= true (ds/indexing? schema (d/entid db :db/txInstant))))
(is (= true (ds/fulltext? schema (d/entid db :test/fulltext))))
(is (= "Documentation string" (ds/doc schema (d/entid db :test/fulltext))))
(is (= :db.type/string (ds/valueType schema (d/entid db :test/fulltext))))))
;; Close and re-open same DB.
(<? (d/<close conn))
(let [conn (<? (d/<connect t))]
(try
(testing "Boolean values in schema are correct after re-opening"
(let [db (d/db conn)
schema (d/schema db)]
(is (= true (ds/indexing? schema (d/entid db :db/txInstant))))
(is (= true (ds/fulltext? schema (d/entid db :test/fulltext))))
(is (= "Documentation string" (ds/doc schema (d/entid db :test/fulltext))))
(is (= :db.type/string (ds/valueType schema (d/entid db :test/fulltext))))))
(finally
(<? (d/<close conn))))))))
(deftest-db test-simple-schema conn
(let [in {:name "mystuff"
:attributes [{:name "foo/age"
:type "long"
:cardinality "one"}
{:name "foo/name"
:type "string"
:cardinality "many"
:doc "People can have many names."}
{:name "foo/id"
:type "string"
:cardinality "one"
:unique "value"}]}
expected [{:db/ident :foo/age
:db/valueType :db.type/long
:db/cardinality :db.cardinality/one
:db.install/_attribute :db.part/db}
{:db/ident :foo/name
:db/valueType :db.type/string
:db/cardinality :db.cardinality/many
:db/doc "People can have many names."
:db.install/_attribute :db.part/db}
{:db/ident :foo/id
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one
:db/unique :db.unique/value
:db.install/_attribute :db.part/db}]]
(testing "Simple schemas are expanded."
(is (= (map #(dissoc %1 :db/id) (datomish.simple-schema/simple-schema->schema in))
expected)))))
(deftest-db test-lookup-refs conn
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))
{tx1 :tx} (<? (d/<transact! conn [[:db/add 1 :name "Ivan"]
[:db/add 2 :name "Phil"]
[:db/add 3 :name "Petr"]]))]
(testing "Looks up entity refs"
(let [{tx :tx} (<? (d/<transact! conn [[:db/add (d/lookup-ref :name "Ivan") :aka "Devil"]
[:db/add (d/lookup-ref :name "Phil") :email "@1"]]))]
(is (= #{[1 :name "Ivan"]
[2 :name "Phil"]
[3 :name "Petr"]
[1 :aka "Devil"]
[2 :email "@1"]}
(<? (<datoms>= (d/db conn) tx1))))))
(testing "Looks up value refs"
(let [{tx :tx} (<? (d/<transact! conn [[:db/add 1 :friends (d/lookup-ref :name "Petr")]
[:db/add 3 :friends (d/lookup-ref :name "Ivan")]]))]
(is (= #{[1 :friends 3]
[3 :friends 1]}
(<? (<datoms>= (d/db conn) tx))))))
(testing "Looks up entity refs in maps"
(let [{tx :tx} (<? (d/<transact! conn [{:db/id (d/lookup-ref :name "Phil") :friends 1}]))]
(is (= #{[2 :friends 1]}
(<? (<datoms>= (d/db conn) tx))))))
(testing "Looks up value refs in maps"
(let [{tx :tx} (<? (d/<transact! conn [{:db/id 2 :friends (d/lookup-ref :name "Petr")}]))]
(is (= #{[2 :friends 3]}
(<? (<datoms>= (d/db conn) tx))))))
(testing "Looks up value refs in sequences in maps"
(let [{tx :tx} (<? (d/<transact! conn [{:db/id 1 :friends [(d/lookup-ref :name "Ivan") (d/lookup-ref :name "Phil")]}]))]
(is (= #{[1 :friends 1]
[1 :friends 2]}
(<? (<datoms>= (d/db conn) tx))))))
(testing "Looks up refs when there are more than 999 refs (all present)"
(let
[bound (* 999 2)
make-add #(vector :db/add (+ 1000 %) :name (str "Ivan-" %))
make-ref #(-> {:db/id (d/lookup-ref :name (str "Ivan-" %)) :email (str "Ivan-" % "@" %)})
{tx-data1 :tx-data} (<? (d/<transact! conn (map make-add (range bound))))
{tx-data2 :tx-data} (<? (d/<transact! conn (map make-ref (range bound))))]
(is (= bound (dec (count tx-data1)))) ;; Each :name is new; dec to account for :db/tx.
(is (= bound (dec (count tx-data2)))) ;; Each lookup-ref exists, each :email is new; dec for :db/tx.
))
(testing "Fails for missing entities"
(is (thrown-with-msg?
ExceptionInfo #"No entity found for lookup-ref"
(<? (d/<transact! conn [[:db/add (d/lookup-ref :name "Mysterioso") :aka "The Magician"]]))))
(is (thrown-with-msg?
ExceptionInfo #"No entity found for lookup-ref"
(<? (d/<transact! conn [[:db/add 1 :friends (d/lookup-ref :name "Mysterioso")]])))))
(testing "Fails for non-identity attributes"
(is (thrown-with-msg?
ExceptionInfo #"Lookup-ref found with non-unique-identity attribute"
(<? (d/<transact! conn [[:db/add (d/lookup-ref :aka "The Magician") :email "@2"]]))))
(is (thrown-with-msg?
ExceptionInfo #"Lookup-ref found with non-unique-identity attribute"
(<? (d/<transact! conn [[:db/add 1 :friends (d/lookup-ref :aka "The Magician")]])))))))
(deftest-db test-fulltext-lookup-refs conn
(let [schema [{:db/id (d/id-literal :db.part/db -1)
:db/ident :test/fulltext
:db/valueType :db.type/string
:db/fulltext true
:db/unique :db.unique/identity}
{:db/id :db.part/db :db.install/attribute (d/id-literal :db.part/db -1)}
{:db/id (d/id-literal :db.part/db -2)
:db/ident :test/other
:db/valueType :db.type/string
:db/fulltext true
:db/cardinality :db.cardinality/one}
{:db/id :db.part/db :db.install/attribute (d/id-literal :db.part/db -2)}
]
tx0 (:tx (<? (d/<transact! conn schema)))]
(testing "Can look up fulltext refs"
(<? (d/<transact! conn [[:db/add 101 :test/fulltext "test this"]]))
(let [{tx :tx} (<? (d/<transact! conn [{:db/id (d/lookup-ref :test/fulltext "test this") :test/other "test other"}]))]
(is (= (<? (<fulltext-values (d/db conn)))
[[1 "test this"]
[2 "test other"]]))
(is (= #{[101 :test/other 2]} ;; Values are raw; 2 is the rowid into fulltext_values.
(<? (<datoms>= (d/db conn) tx))))))
(testing "Fails for missing fulltext entities"
(is (thrown-with-msg?
ExceptionInfo #"No entity found for lookup-ref"
(<? (d/<transact! conn [[:db/add (d/lookup-ref :test/fulltext "not found") :test/other "test random"]])))))))
#_ (time (t/run-tests))
#_ (time (clojure.test/test-vars [#'test-lookup-refs]))

59
test/datomish/jdbc_sqlite_test.clj
View file

@ -1,59 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
(ns datomish.jdbc-sqlite-test
(:require
[datomish.sqlite :as s]
[datomish.pair-chan :refer [go-pair <?]]
[datomish.jdbc-sqlite :as j]
[datomish.test-macros :refer [deftest-async]]
[tempfile.core :refer [tempfile with-tempfile]]
[clojure.core.async :as a :refer [<! >!]]
[clojure.test :as t :refer [is are deftest testing]]))
(deftest-async test-all-rows
(with-tempfile [t (tempfile)]
(let [db (<? (j/open t))]
(try
(<? (s/execute! db ["CREATE TABLE test (a INTEGER)"]))
(<? (s/execute! db ["INSERT INTO test VALUES (?)" 1]))
(<? (s/execute! db ["INSERT INTO test VALUES (?)" 2]))
(let [rows (<? (s/all-rows db ["SELECT * FROM test ORDER BY a ASC"]))]
(is (= rows [{:a 1} {:a 2}])))
(finally
(<? (s/close db)))))))
(deftest-async test-in-transaction!
(with-tempfile [t (tempfile)]
(let [db (<? (j/open t))]
(try
(<? (s/execute! db ["CREATE TABLE ta (a INTEGER)"]))
(<? (s/execute! db ["CREATE TABLE tb (b INTEGER)"]))
(<? (s/execute! db ["INSERT INTO ta VALUES (?)" 1]))
(let [[v e] (<! (s/in-transaction! db #(s/execute! db ["INSERT INTO tb VALUES (?)" 2])))]
(is (not e)))
(let [rows (<? (s/all-rows db ["SELECT * FROM ta ORDER BY a ASC"]))]
(is (= rows [{:a 1}])))
(let [rows (<? (s/all-rows db ["SELECT * FROM tb ORDER BY b ASC"]))]
(is (= rows [{:b 2}])))
(let [f #(go-pair
;; The first succeeds ...
(<? (s/execute! db ["INSERT INTO ta VALUES (?)" 3]))
;; ... but will get rolled back by the second failing.
(<? (s/execute! db ["INSERT INTO tb VALUES (?)" 4 "bad parameter"])))
[v e] (<! (s/in-transaction! db f))]
(is (some? e)))
;; No changes, since the transaction as a whole failed.
(let [rows (<? (s/all-rows db ["SELECT * FROM ta ORDER BY a ASC"]))]
(is (= rows [{:a 1}])))
(let [rows (<? (s/all-rows db ["SELECT * FROM tb ORDER BY b ASC"]))]
(is (= rows [{:b 2}])))
(finally
(<? (s/close db)))))))

94
test/datomish/places/importer_test.cljc
View file

@ -1,94 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
;;
;; These tests are disabled for the moment -- they depend on
;; having a particular places.sqlite.
;;
;; Issue #108 tracks removing this code from Datomish itself.
;;
(ns datomish.places.importer-test
#?(:cljs
(:require-macros
[datomish.pair-chan :refer [go-pair <?]]
[datomish.node-tempfile-macros :refer [with-tempfile]]
[cljs.core.async.macros :as a :refer [go]]))
(:require
[datomish.tufte-stub :as tufte
#?(:cljs :refer-macros :clj :refer) [p profile]]
[datomish.api :as d]
[datomish.places.importer :as pi]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
[datomish.sqlite :as s]
#?@(:clj [[datomish.jdbc-sqlite]
[datomish.pair-chan :refer [go-pair <?]]
[tempfile.core :refer [tempfile with-tempfile]]
[datomish.test-macros :refer [deftest-async]]
[clojure.test :as t :refer [is are deftest testing]]
[clojure.core.async :refer [go <! >!]]])
#?@(:cljs [[datomish.js-sqlite]
[datomish.pair-chan]
[datomish.test-macros :refer-macros [deftest-async]]
[datomish.node-tempfile :refer [tempfile]]
[cljs.test :as t :refer-macros [is are deftest testing async]]
[cljs.core.async :as a :refer [<! >!]]])))
#?(:cljs
(def Throwable js/Error))
(tufte/add-basic-println-handler! {})
#_
(deftest-async test-import
(with-tempfile [t (tempfile)]
(let [places (<? (s/<sqlite-connection "/tmp/places.sqlite"))
conn (<? (d/<connect t))]
(try
(let [report (profile {:dynamic? true} (<? (pi/import-places conn places)))]
(is (= nil (count (:tx-data report)))))
(finally
(<? (d/<close conn)))))))
#_
(deftest-async test-import-repeat
;; Repeated import is worst possible for the big joins to find datoms that already exist, because
;; *every* datom added in the first import will match in the second.
(with-tempfile [t (tempfile)]
(let [places (<? (s/<sqlite-connection "/tmp/places.sqlite"))
conn (<? (d/<connect t))]
(try
(let [report0 (<? (pi/import-places conn places))
report (profile {:dynamic? true} (<? (pi/import-places conn places)))]
(is (= nil (count (:tx-data report)))))
(finally
(<? (d/<close conn)))))))
#_
(defn <?? [pair-chan]
(datomish.pair-chan/consume-pair (clojure.core.async/<!! pair-chan)))
#_ [
(def places (<?? (s/<sqlite-connection "/tmp/places.sqlite")))
(def conn (<?? (d/<connect "/tmp/testkb.sqlite")))
(def tx0 (:tx (<?? (d/<transact! conn places-schema-fragment))))
(tufte/add-basic-println-handler! {})
(def report (profile {:dynamic? true} (<?? (pi/import conn places))))
;; Empty:
;; "Elapsed time: 5451.610551 msecs"
;; Reimport:
;; "Elapsed time: 25600.358881 msecs"
]

104
test/datomish/promise_sqlite_test.cljs
View file

@ -1,104 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
(ns datomish.promise-sqlite-test
(:require-macros
[datomish.pair-chan :refer [go-pair <?]]
[datomish.test-macros :refer [deftest-async]]
[datomish.node-tempfile-macros :refer [with-tempfile]]
[cljs.core.async.macros])
(:require
[datomish.node-tempfile :refer [tempfile]]
[cljs.core.async :refer [<! >!]]
[cljs.test :refer-macros [is are deftest testing async]]
[datomish.pair-chan]
[datomish.sqlite :as s]
[datomish.js-sqlite :as ps]))
(deftest-async test-all-rows
(with-tempfile [t (tempfile)]
(let [db (<? (ps/open (.-name t)))]
(try
(<? (s/execute! db ["CREATE TABLE test (a INTEGER)"]))
(<? (s/execute! db ["INSERT INTO test VALUES (?)" 1]))
(<? (s/execute! db ["INSERT INTO test VALUES (?)" 2]))
(let [rows (<? (s/all-rows db ["SELECT * FROM test ORDER BY a ASC"]))]
(is (= rows [{:a 1} {:a 2}])))
(finally
(<? (s/close db)))))))
(deftest-async test-in-transaction!
(with-tempfile [t (tempfile)]
(let [db (<? (ps/open (.-name t)))]
(try
(<? (s/execute! db ["CREATE TABLE ta (a INTEGER)"]))
(<? (s/execute! db ["CREATE TABLE tb (b INTEGER)"]))
(<? (s/execute! db ["INSERT INTO ta VALUES (?)" 1]))
(let [[v e] (<! (s/in-transaction! db #(s/execute! db ["INSERT INTO tb VALUES (?)" 2])))]
(is (not e)))
(let [rows (<? (s/all-rows db ["SELECT * FROM ta ORDER BY a ASC"]))]
(is (= rows [{:a 1}])))
(let [rows (<? (s/all-rows db ["SELECT * FROM tb ORDER BY b ASC"]))]
(is (= rows [{:b 2}])))
(let [f #(go-pair
;; The first succeeds ...
(<? (s/execute! db ["INSERT INTO ta VALUES (?)" 3]))
;; ... but will get rolled back by the second failing.
(<? (s/execute! db ["INSERT INTO tb VALUES (?)" 4 "bad parameter"])))
[v e] (<! (s/in-transaction! db f))]
(is (some? e)))
;; No changes, since the transaction as a whole failed.
(let [rows (<? (s/all-rows db ["SELECT * FROM ta ORDER BY a ASC"]))]
(is (= rows [{:a 1}])))
(let [rows (<? (s/all-rows db ["SELECT * FROM tb ORDER BY b ASC"]))]
(is (= rows [{:b 2}])))
(finally
(<? (s/close db)))))))
(deftest-async test-long-strings
;; Make a string that's nicely over the 32K limit in node-sqlite3/#668.
(let [s (str "be" (apply str (repeat 330000 "la")) "st")]
(with-tempfile [t (tempfile)]
(let [db (<? (ps/open (.-name t)))]
(try
(<? (s/execute! db ["CREATE TABLE strs (x INTEGER, a TEXT)"]))
(<? (s/execute! db ["INSERT INTO strs VALUES (42, ?)" s]))
;; Test retrieval via binding comparison.
(is (= (<? (s/all-rows db ["SELECT x FROM strs WHERE a = ?" s]))
[{:x 42}]))
;; Test computation.
(is (= (<? (s/all-rows db ["SELECT length(a) AS yvr FROM strs"]))
[{:yvr 660004}]))
(is (= (<? (s/all-rows db ["SELECT length(?) AS yvr FROM strs" s]))
[{:yvr 660004}]))
;; Test round-tripping.
(is (= (<? (s/all-rows db ["SELECT x, a FROM strs"]))
[{:x 42, :a s}]))
(is (= (<? (s/all-rows db ["SELECT ? AS yyz FROM strs" s]))
[{:yyz s}]))
(finally
(<? (s/close db))))
))))
(deftest test-tests-are-isolated
(go-pair
(let [conn-1 (<? (s/<sqlite-connection ""))
conn-2 (<? (s/<sqlite-connection ""))]
(is (not (= conn-1 conn-2)))
(<? (s/execute! conn-1 ["CREATE TABLE foo (x INTEGER)"]))
(<? (s/execute! conn-2 ["CREATE TABLE foo (x INTEGER)"]))
(<? (s/execute! conn-1 ["INSERT INTO foo (x) VALUES (5)"]))
(is (empty? (<? (s/all-rows conn-2 ["SELECT x FROM foo"]))))
(s/close conn-1)
(s/close conn-2))))

62
test/datomish/query_test.cljc
View file

@ -1,62 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
(ns datomish.query-test
#?(:cljs
(:require-macros
[datomish.pair-chan :refer [go-pair <?]]
[datomish.node-tempfile-macros :refer [with-tempfile]]
[cljs.core.async.macros :as a :refer [go]]))
(:require
[datomish.api :as d]
#?@(:clj [[datomish.jdbc-sqlite]
[datomish.pair-chan :refer [go-pair <?]]
[tempfile.core :refer [tempfile with-tempfile]]
[datomish.test-macros :refer [deftest-async]]
[clojure.test :as t :refer [is are deftest testing]]
[clojure.core.async :refer [go <! >!]]])
#?@(:cljs [[datomish.js-sqlite]
[datomish.pair-chan]
[datomish.test-macros :refer-macros [deftest-async]]
[datomish.node-tempfile :refer [tempfile]]
[cljs.test :as t :refer-macros [is are deftest testing async]]
[cljs.core.async :as a :refer [<! >!]]]))
#?(:clj
(:import [clojure.lang ExceptionInfo]))
#?(:clj
(:import [datascript.db DB])))
#?(:cljs
(def Throwable js/Error))
(def test-schema
[{:db/id (d/id-literal :db.part/user)
:db/ident :x
:db/unique :db.unique/identity
:db/valueType :db.type/long
:db.install/_attribute :db.part/db}
])
(deftest-async test-q
(with-tempfile [t (tempfile)]
(let [conn (<? (d/<connect t))
{tx0 :tx} (<? (d/<transact! conn test-schema))]
(try
(let [{tx1 :tx} (<? (d/<transact! conn [{:db/id 101 :x 505}]))]
(is (= (<? (d/<q (d/db conn)
[:find '?e '?a '?v '?tx :in '$ :where
'[?e ?a ?v ?tx]
[(list '> '?tx tx0)]
[(list '!= '?a (d/entid (d/db conn) :db/txInstant))] ;; TODO: map ident->entid for values.
] {}))
[[101 (d/entid (d/db conn) :x) 505 tx1]]))) ;; TODO: map entid->ident on egress.
(finally
(<? (d/<close conn)))))))

281
test/datomish/schema_changes_test.cljc
View file

@ -1,281 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
(ns datomish.schema-changes-test
#?(:cljs
(:require-macros
[datomish.pair-chan :refer [go-pair <?]]
[datomish.node-tempfile-macros :refer [with-tempfile]]
[cljs.core.async.macros :as a :refer [go]]))
(:require
[datomish.api :as d]
[datomish.datom :refer [datom]]
[datomish.schema-changes]
[datomish.schema :as ds]
[datomish.sqlite :as s]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
[datomish.db :as dm]
#?@(:clj [[datomish.jdbc-sqlite]
[datomish.pair-chan :refer [go-pair <?]]
[tempfile.core :refer [tempfile with-tempfile]]
[datomish.test-macros :refer [deftest-async deftest-db]]
[clojure.test :as t :refer [is are deftest testing]]
[clojure.core.async :refer [go <! >!]]])
#?@(:cljs [[datomish.js-sqlite]
[datomish.pair-chan]
[datomish.test-macros :refer-macros [deftest-async deftest-db]]
[datomish.node-tempfile :refer [tempfile]]
[cljs.test :as t :refer-macros [is are deftest testing async]]
[cljs.core.async :as a :refer [<! >!]]]))
#?(:clj
(:import [clojure.lang ExceptionInfo]))
#?(:clj
(:import [datascript.db DB])))
#?(:cljs
(def Throwable js/Error))
;; Wrap this so that we can pass the empty second argument.
(defn datoms->schema-fragment [x]
(datomish.schema-changes/datoms->schema-fragment x {}))
(deftest test-datoms->schema-fragment
(let [tx 10101
->datom (fn [xs]
(apply datom (conj xs tx)))]
(are [i o]
(= (datoms->schema-fragment (map ->datom i))
o)
;; Base case.
[]
{}
;; No matches.
[[0 :not-db/add :not-db/install]]
{}
;; Interesting case.
[[:db.part/db :db.install/attribute 1]
[:db.part/db :db.install/attribute 2]
[1 :db/ident :test/attr1]
[1 :db/valueType :db.value/string]
[1 :db/cardinalty :db.cardinality/one]
[1 :db/unique :db.unique/identity]
[2 :db/ident :test/attr2]
[2 :db/valueType :db.value/integer]
[2 :db/cardinalty :db.cardinality/many]]
{:test/attr1
{:db/valueType :db.value/string
:db/cardinalty :db.cardinality/one
:db/unique :db.unique/identity}
:test/attr2
{:db/valueType :db.value/integer
:db/cardinalty :db.cardinality/many}})
;; :db/ident, :db/valueType, and :db/cardinality are required. valueType and cardinality are
;; enforced at the schema level.
(testing "Fails without entity"
(is (thrown-with-msg?
ExceptionInfo #":db.install/attribute requires :db/ident, got \{\} for 1"
(->>
[[:db.part/db :db.install/attribute 1]]
(map ->datom)
(datoms->schema-fragment)))))
(testing "Fails without :db/ident"
(is (thrown-with-msg?
ExceptionInfo #":db.install/attribute requires :db/ident, got \{:db/valueType :db.value/string\} for 1"
(->>
[[:db.part/db :db.install/attribute 1]
[1 :db/valueType :db.value/string]]
(map ->datom)
(datoms->schema-fragment)))))))
(deftest-db test-add-and-change-ident conn
;; Passes through on failure.
(is (= :test/ident (d/entid (d/db conn) :test/ident)))
(let [report (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/db -1) :db/ident :test/ident]]))
eid (get-in report [:tempids (d/id-literal :db.part/db -1)])]
(is (= eid (d/entid (d/db conn) :test/ident)))
(is (= :test/ident (d/ident (d/db conn) eid)))
(testing "idents can be reasserted."
(<? (d/<transact! conn [[:db/add eid :db/ident :test/ident]])))
(testing "idents can't be reused while they're still active."
(is (thrown-with-msg?
ExceptionInfo #"Transaction violates unique constraint"
(<? (d/<transact! conn [[:db/add 5555 :db/ident :test/ident]])))))
(testing "idents can be changed."
;; You can change an entity's ident.
(<? (d/<transact! conn [[:db/add eid :db/ident :test/anotherident]]))
(is (= eid (d/entid (d/db conn) :test/anotherident)))
(is (= :test/anotherident (d/ident (d/db conn) eid)))
(is (not (= eid (d/entid (d/db conn) :test/ident))))
;; Passes through on failure.
(is (= :test/ident (d/entid (d/db conn) :test/ident))))
(testing "Once freed up, an ident can be reused."
(<? (d/<transact! conn [[:db/add 5555 :db/ident :test/ident]]))
(is (= 5555 (d/entid (d/db conn) :test/ident))))))
(deftest-db test-change-schema-ident conn
;; If an ident names an attribute, and is altered, then that attribute has
;; changed in the schema.
(let [tempid (d/id-literal :db.part/db -1)
es [[:db/add :db.part/db :db.install/attribute tempid]
{:db/id tempid
:db/ident :test/someattr
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one}]
report (<? (d/<transact! conn es))
db-after (:db-after report)
eid (get-in report [:tempids tempid])]
(testing "New ident is allocated"
(is (some? (d/entid db-after :test/someattr))))
(testing "Schema is modified"
(is (= (get-in db-after [:symbolic-schema :test/someattr])
{:db/valueType :db.type/string,
:db/cardinality :db.cardinality/one})))
(is (= eid (d/entid (d/db conn) :test/someattr)))
(testing "schema idents can be altered."
(let [report (<? (d/<transact! conn [{:db/id eid
:db/ident :test/otherattr}]))
db-after (:db-after report)]
(is (= eid (d/entid (d/db conn) :test/otherattr)))
;; Passes through on failure.
(is (keyword? (d/entid (d/db conn) :test/someattr)))
(is (nil? (get-in db-after [:symbolic-schema :test/someattr])))
(is (= (get-in db-after [:symbolic-schema :test/otherattr])
{:db/valueType :db.type/string,
:db/cardinality :db.cardinality/one}))))))
(deftest-db test-alter-schema-cardinality-one-to-many conn
(let [tempid (d/id-literal :db.part/db -1)
es [[:db/add :db.part/db :db.install/attribute tempid]
{:db/id tempid
:db/ident :test/attr
:db/valueType :db.type/long
:db/cardinality :db.cardinality/one}]
report (<? (d/<transact! conn es))
db-after (:db-after report)
eid (get-in report [:tempids tempid])]
(is (= (get-in db-after [:symbolic-schema :test/attr :db/cardinality])
:db.cardinality/one))
;; Add two values for the property. Observe that only one is preserved.
(<? (d/<transact! conn [{:db/id 12345 :test/attr 111}]))
(<? (d/<transact! conn [{:db/id 12345 :test/attr 222}]))
(is (= [222]
(<? (d/<q (d/db conn)
'[:find [?a ...] :in $ :where [12345 :test/attr ?a]]))))
;; Change it to a multi-valued property.
(let [report (<? (d/<transact! conn [{:db/id eid
:db/cardinality :db.cardinality/many
:db.alter/_attribute :db.part/db}]))
db-after (:db-after report)]
(is (= eid (d/entid (d/db conn) :test/attr)))
(is (= (get-in db-after [:symbolic-schema :test/attr :db/cardinality])
:db.cardinality/many))
(is (ds/multival? (.-schema (d/db conn)) eid))
(is (= [222]
(<? (d/<q (d/db conn)
'[:find [?a ...] :in $ :where [12345 :test/attr ?a]]))))
(<? (d/<transact! conn [{:db/id 12345 :test/attr 333}]))
(is (= [222 333]
(<? (d/<q (d/db conn)
'[:find [?a ...] :in $ :where [12345 :test/attr ?a]]
{:order-by [[:a :asc]]})))))))
(deftest-db test-alter-schema-cardinality-many-to-one conn
(let [prop-a (d/id-literal :db.part/db -1)
prop-b (d/id-literal :db.part/db -2)
prop-c (d/id-literal :db.part/db -3)
es [[:db/add :db.part/db :db.install/attribute prop-a]
[:db/add :db.part/db :db.install/attribute prop-b]
[:db/add :db.part/db :db.install/attribute prop-c]
{:db/id prop-a
:db/ident :test/attra
:db/valueType :db.type/long
:db/cardinality :db.cardinality/many}
{:db/id prop-b
:db/ident :test/attrb
:db/valueType :db.type/string
:db/fulltext true
:db/cardinality :db.cardinality/many}
{:db/id prop-c
:db/ident :test/attrc
:db/valueType :db.type/long
:db/cardinality :db.cardinality/many}]
report (<? (d/<transact! conn es))
db-after (:db-after report)
e-a (get-in report [:tempids prop-a])
e-b (get-in report [:tempids prop-b])
e-c (get-in report [:tempids prop-c])]
(is (= (get-in db-after [:symbolic-schema :test/attra :db/cardinality])
:db.cardinality/many))
(is (= (get-in db-after [:symbolic-schema :test/attrb :db/cardinality])
:db.cardinality/many))
;; Add two values for one property, one for another, and none for the last.
;; Observe that only all are preserved.
(<? (d/<transact! conn [{:db/id 12345 :test/attrb "foobar"}]))
(<? (d/<transact! conn [{:db/id 12345 :test/attrc 222}]))
(<? (d/<transact! conn [{:db/id 12345 :test/attrc 333}]))
(is (= []
(<? (d/<q (d/db conn)
'[:find [?a ...] :in $ :where [12345 :test/attra ?a]]))))
(is (= ["foobar"]
(<? (d/<q (d/db conn)
'[:find [?b ...] :in $ :where [12345 :test/attrb ?b]]))))
(is (= [222 333]
(<? (d/<q (d/db conn)
'[:find [?c ...] :in $ :where [12345 :test/attrc ?c]]))))
;; Change each to a single-valued property.
;; 'a' and 'b' should succeed, because they match the new cardinality
;; constraint. 'c' should fail, because it already has two values for 12345.
(let [change
(fn [eid attr]
(go-pair
(let [report (<? (d/<transact!
conn
[{:db/id eid
:db/cardinality :db.cardinality/one
:db.alter/_attribute :db.part/db}]))
db-after (:db-after report)]
(is (= eid (d/entid (d/db conn) attr)))
(is (= (get-in db-after [:symbolic-schema attr :db/cardinality])
:db.cardinality/one))
(is (not (ds/multival? (.-schema (d/db conn)) eid))))))]
(<? (change e-a :test/attra))
(<? (change e-b :test/attrb))
(is (thrown-with-msg?
ExceptionInfo #"Can't alter :db/cardinality"
(<? (change e-c :test/attrc)))))))

514
test/datomish/schema_management_test.cljc
View file

@ -1,514 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
(ns datomish.schema-management-test
#?(:cljs
(:require-macros
[datomish.pair-chan :refer [go-pair <?]]
[datomish.node-tempfile-macros :refer [with-tempfile]]
[cljs.core.async.macros :as a :refer [go]]))
(:require
[datomish.schema-management :as sm]
[datomish.api :as d]
#?@(:clj [[datomish.jdbc-sqlite]
[datomish.pair-chan :refer [go-pair <?]]
[tempfile.core :refer [tempfile with-tempfile]]
[datomish.test-macros :refer [deftest-async deftest-db]]
[clojure.test :as t :refer [is are deftest testing]]
[clojure.core.async :refer [go <! >!]]])
#?@(:cljs [[datomish.js-sqlite]
[datomish.pair-chan]
[datomish.test-macros :refer-macros [deftest-async deftest-db]]
[datomish.node-tempfile :refer [tempfile]]
[cljs.test :as t :refer-macros [is are deftest testing async]]
[cljs.core.async :as a :refer [<! >!]]]))
#?(:clj
(:import [clojure.lang ExceptionInfo]))
#?(:clj
(:import [datascript.db DB])))
#?(:cljs
(def Throwable js/Error))
(def id-schema (d/id-literal :db.part/db))
(def id-foobar (d/id-literal :db.part/user))
(def trivial-schema-managed-fragment-v1
{:name :com.example.foo
:version 1
:attributes
{:foo/bar
{:db/cardinality :db.cardinality/one
:db/valueType :db.type/string}}})
(def additional-schema-managed-fragment-v7
{:name :com.example.bar
:version 7
:attributes
{:bar/noo
{:db/cardinality :db.cardinality/one
:db/unique :db.unique/value
:db/valueType :db.type/long}}})
(def additional-schema-managed-fragment-v8
{:name :com.example.bar
:version 8
:attributes
{:bar/choo
{:db/cardinality :db.cardinality/many
:db/fulltext true
:db/valueType :db.type/string}
:bar/noo
{:db/cardinality :db.cardinality/one
:db/unique :db.unique/value
:db/valueType :db.type/long}}})
(def trivial-schema-managed-fragment-v2
{:name :com.example.foo
:version 2
:attributes
{:foo/bar
{:db/cardinality :db.cardinality/many
:db/valueType :db.type/string}}})
(def trivial-schema-v1
(sm/managed-schema-fragment->datoms trivial-schema-managed-fragment-v1))
;; TODO
(deftest test-managed-schema-fragment->datoms)
(defn <initialize-with-schema [conn schema]
(go-pair
(let [tx (<? (d/<transact! conn schema))]
(let [idents (map :db/ident schema)
db (d/db conn)]
(into {}
(map (fn [ident]
[ident (d/entid db ident)])
idents))))))
(deftest-db test-schema-management-downgrades conn
(is (empty? (<? (sm/<collect-schema-fragment-versions (d/db conn)))))
(testing "Downgrades cause errors."
(let [fragment {:name :com.a
:version 4
:attributes
{:foo/bar
{:db/cardinality :db.cardinality/one
:db/valueType :db.type/string}}}]
(<? (<initialize-with-schema
conn
(sm/managed-schema-fragment->datoms fragment)))
(let [current (<? (sm/<collect-schema-fragment-versions (d/db conn)))]
(is (= {:com.a 4} current)))
(is (thrown-with-msg?
Throwable
#"Existing version of :com.a is 4, which is later than requested 3"
(<?
(sm/<prepare-schema-application
(d/db conn)
{:fragments
[(assoc fragment :version 3)]})))))))
(deftest-db test-schema-management-conflicting-ownership conn
(is (empty? (<? (sm/<collect-schema-fragment-versions (d/db conn)))))
(testing "Conflicting managed fragments cause errors."
(is (thrown-with-msg?
Throwable #"Attributes appear in more than one"
(<? (sm/<prepare-schema-application
(d/db conn)
{:fragments
[{:name :com.a
:version 1
:attributes
{:foo/bar
{:db/cardinality :db.cardinality/one
:db/valueType :db.type/string}}}
{:name :com.b
:version 1
:attributes
{:foo/bar
{:db/cardinality :db.cardinality/one
:db/valueType :db.type/string}}}]}))))))
(defn- without-tempids
"Return the map without any k-v pairs for which v is a TempId."
[m]
(into {} (keep (fn [[k v]] (when-not (d/id-literal? v) [k v])) m)))
(defn- op-seq-without-tempids [ops]
(map (fn [[op val]]
(if (= op :transact)
[op (map without-tempids val)]
[op val]))
ops))
;; This is much more convenient than trying to make tempids match
;; in our tests.
(defn- =-op-seq-without-tempids
"Compare two sequences of operations (e.g., [[:call foo]])
without comparing TempIds within :transact operations."
[expected actual]
(= (op-seq-without-tempids expected)
(op-seq-without-tempids actual)))
;;;
;;; In this test we use simple strings to denote pre/post functions.
;;; That makes everything a little easier to test.
;;;
;;; Note carefully that we manually transact some schema fragments,
;;; then we use the schema management functions to get a _plan_. That's
;;; not the same as executing the plan.
;;;
(deftest-db test-schema-management conn
(is (empty? (<? (sm/<collect-schema-fragment-versions (d/db conn)))))
;; Start off with the trivial schema at v1.
(let [attrs (<? (<initialize-with-schema conn trivial-schema-v1))
db (d/db conn)]
(testing "We have a version, and it's 1. There are no other schemas."
(is (= {:com.example.foo 1}
(<? (sm/<collect-schema-fragment-versions db)))))
(testing "This schema fragment has one attribute."
(is (= {:foo/bar :com.example.foo}
(<? (sm/<collect-schema-fragment-attributes db)))))
(testing "The symbolic schema contains our attribute."
(is (= :db.type/string
(get-in (sm/db->symbolic-schema db)
[:foo/bar :db/valueType]))))
(testing "An empty fragment yields no work."
(is (nil? (<? (sm/<prepare-schema-application
db
{:pre "X"
:post "Y"
:fragments []})))))
(testing "The same fragment, expressed as a managed schema fragment, yields no work."
(is (nil? (<? (sm/<prepare-schema-application
db
{:fragments [trivial-schema-managed-fragment-v1]})))))
(testing "If we try to add a second fragment, we run all-pre, new fragment, all-post."
(is (=-op-seq-without-tempids
[[:call "X"]
[:transact (sm/managed-schema-fragment->datoms
additional-schema-managed-fragment-v7)]
[:call "Y"]]
(<? (sm/<prepare-schema-application
db
{:pre "X"
:post "Y"
:fragment-pre {}
:fragment-post {}
:fragments [additional-schema-managed-fragment-v7]})))))
(testing "If we upgrade one of the fragments, we run all-pre, the appropriate fragment pre, changed fragment, fragment post, all-post."
(is (=-op-seq-without-tempids
[[:call "X"]
[:call "A"]
[:transact
[{:db/ident :com.example.foo
:db.schema/version 2}
{:db/ident :foo/bar
:db.alter/_attribute :db.part/db
:db.schema/_attribute (d/entid db :com.example.foo)
:db/cardinality :db.cardinality/many}]]
[:call "B"]
[:call "Y"]]
(<? (sm/<prepare-schema-application
db
{:pre "X"
:post "Y"
:fragment-pre {:com.example.foo {1 "A"}}
:fragment-post {:com.example.foo {1 "B"}}
:fragments [trivial-schema-managed-fragment-v2]})))))
(testing "If we upgrade both, we run all-pre, each fragment pre, fragment, fragment post, all post."
(let [db (:db-after
(<?
(d/<transact! conn (sm/managed-schema-fragment->datoms
additional-schema-managed-fragment-v7))))
next-up
{:pre "XX"
:post "YY"
:fragment-pre {:com.example.foo {1 "AA"}}
:fragment-post {:com.example.foo {1 "BB"}
:com.example.bar {7 "CC"}}
:fragments [trivial-schema-managed-fragment-v2
additional-schema-managed-fragment-v8
]}
counter (atom 0)
pre (atom nil)
post (atom nil)
fragment-pre-foo (atom nil)
fragment-post-foo (atom nil)
fragment-post-bar (atom nil)
next-up-but-with-functions
{:pre (fn [db _]
(reset! pre (swap! counter inc))
nil)
:post (fn [db _]
(reset! post (swap! counter inc))
nil)
:fragment-pre {:com.example.foo
{1 (fn [db _]
(reset! fragment-pre-foo (swap! counter inc))
nil)}}
:fragment-post {:com.example.foo
{1 (fn [db _]
(reset! fragment-post-foo (swap! counter inc))
nil)}
:com.example.bar
{7 (fn [db _]
(reset! fragment-post-bar (swap! counter inc))
nil)}}
:fragments [trivial-schema-managed-fragment-v2
additional-schema-managed-fragment-v8]}]
(testing "Make sure our fragment was added correctly."
(let [bar (d/entid db :com.example.bar)]
(is (integer? bar))
(is (= :com.example.bar (d/ident db bar))))
(is (= {:com.example.foo 1
:com.example.bar 7}
(<? (sm/<collect-schema-fragment-versions db)))))
;; Now we'll see the addition of the new attribute, the
;; bump of both versions, and the change to foo.
(is (=-op-seq-without-tempids
[[:call "XX"]
[:call "AA"]
[:transact
[{:db/ident :com.example.foo
:db.schema/version 2}
{:db/ident :foo/bar
:db.alter/_attribute :db.part/db
:db.schema/_attribute (d/entid db :com.example.foo)
:db/cardinality :db.cardinality/many}]]
[:call "BB"]
[:transact
[{:db/ident :com.example.bar
:db.schema/version 8}
{:db/ident :bar/choo
:db.install/_attribute :db.part/db
:db.schema/_attribute (d/entid db :com.example.bar)
:db/fulltext true
:db/valueType :db.type/string
:db/cardinality :db.cardinality/many}]]
[:call "CC"]
[:call "YY"]]
(<? (sm/<prepare-schema-application
db
next-up))))
;; No change? Nothing to do.
(is (nil? (<? (sm/<apply-schema-alteration conn {:fragments []}))))
;; Now let's try the write!
(let [report (<? (sm/<apply-schema-alteration conn next-up-but-with-functions))
db (:db-after report)]
(is (not (nil? report)))
(testing "Things happened in the right order."
(is (= 1 @pre))
(is (= 2 @fragment-pre-foo))
(is (= 3 @fragment-post-foo))
(is (= 4 @fragment-post-bar))
(is (= 5 @post)))
(testing "Our changes were applied."
(is (= {:com.example.foo 2
:com.example.bar 8}
(<? (sm/<collect-schema-fragment-versions db))))
(is (= {:foo/bar :com.example.foo
:bar/choo :com.example.bar
:bar/noo :com.example.bar}
(<? (sm/<collect-schema-fragment-attributes db))))))))))
(deftest-db test-none-migration conn
(testing "A fragment that's never existed in the DB triggers :none pre and post."
(let [db (atom (d/db conn))
v1-fragment
{:name :com.example.foo
:version 1
:attributes
{:foo/bar
{:db/valueType :db.type/long
:db/cardinality :db.cardinality/many}}}
fail-called (atom nil)
pre-called (atom nil)
post-called (atom nil)
v1-migration
{:fragments [v1-fragment]
:fragment-pre {:com.example.foo
{:none (fn [db _]
(reset! pre-called true)
nil)
1 (fn [db _]
(reset! fail-called true)
nil)}}
:fragment-post {:com.example.foo
{:none (fn [db _]
(reset! post-called true)
nil)
1 (fn [db _]
(reset! fail-called true)
nil)}}}]
(is (empty? (<? (sm/<collect-schema-fragment-versions @db))))
;; Apply the v1 schema.
(reset!
db
(:db-after
(<? (sm/<apply-schema-alteration
conn
v1-migration))))
(is @pre-called)
(is @post-called)
(is (not @fail-called))
(is (= {:com.example.foo 1}
(<? (sm/<collect-schema-fragment-versions @db))))
(is (= {:foo/bar :com.example.foo}
(<? (sm/<collect-schema-fragment-attributes @db)))))))
(deftest-db test-functions-can-do-work conn
(let
[;; Use an atom to keep this long test fairly flat.
db (atom (d/db conn))
v1-fragment
{:name :com.example.bar
:version 1
:attributes
{:bar/thoo
{:db/valueType :db.type/long
:db/cardinality :db.cardinality/many}
:bar/choo
{:db/cardinality :db.cardinality/one
:db/fulltext true
:db/valueType :db.type/string}}}
;; This is what we'll change the schema into.
v2-fragment
(assoc
(assoc-in v1-fragment [:attributes :bar/thoo :db/cardinality] :db.cardinality/one)
:version 2)
;; This is the migration we're going to test.
;; We're going to remove all existing :bar/thoo, and turn it into
;; cardinality one. We're going to make :bar/choo
;; unique, and we're going to use :bar/thoo to count the number of
;; chars in an entity's :bar/choo.
;; Note that the contents of the migration work:
;; - Look just like regular queries and transacts, except for
;; working with the internal API
;; - Don't have to transact the schema change at all.
migration
{:fragments [v2-fragment]
:pre (fn [db do-transact]
;; Retract all existing uses of :bar/thoo.
(go-pair
(<?
(do-transact
db
(map (fn [e]
[:db.fn/retractAttribute e :bar/thoo])
(<? (d/<q db '[:find [?e ...]
:in $
:where [?e :bar/thoo _]])))))))
:post (fn [db do-transact]
;; Transact some new use for :bar/thoo.
(go-pair
(<?
(do-transact
db
(map (fn [[e c]]
[:db/add e :bar/thoo (count c)])
(<? (d/<q db '[:find ?e ?c
:in $
:where [?e :bar/choo ?c]])))))))}]
;; We start empty.
(is (empty? (<? (sm/<collect-schema-fragment-versions @db))))
;; Apply the v1 schema.
(reset!
db
(:db-after
(<? (sm/<apply-schema-alteration
conn
{:fragments [v1-fragment]}))))
;; Make sure it's applied.
(testing "We can begin."
(is (= {:com.example.bar 1}
(<? (sm/<collect-schema-fragment-versions @db))))
(is (= {:bar/choo :com.example.bar
:bar/thoo :com.example.bar}
(<? (sm/<collect-schema-fragment-attributes @db)))))
;; Add some data.
(let [x (d/id-literal :db.part/user)
y (d/id-literal :db.part/user)]
(reset!
db
(:db-after
(<?
(d/<transact! conn [{:db/id x
:bar/thoo 99}
{:db/id y
:bar/thoo 88}
{:db/id x
:bar/choo "hello, world."}])))))
;; Alter the schema to v2, running our migration.
(reset! db (:db-after (<? (sm/<apply-schema-alteration conn migration))))
;; It worked!
(is (not (nil? @db)))
;; It persisted!
(is (= @db @(:current-db conn)))
(testing "The schema change applied."
(is (= :db.cardinality/one
(get-in (sm/db->symbolic-schema @db) [:bar/thoo :db/cardinality]))))
(is (= (count "hello, world.") ; 13.
(<? (d/<q @db
'[:find ?thoo .
:in $
:where
[?x :bar/choo "hello, world."]
[?x :bar/thoo ?thoo]]))))
;; Now that we changed its cardinality, we can transact another :bar/thoo
;; for the same entity, and we will get only the new value.
(let [x (<? (d/<q @db '[:find ?x . :in $ :where [?x :bar/choo "hello, world."]]))]
(is (= [13] (<? (d/<q @db [:find ['?thoo '...] :in '$ :where [x :bar/thoo '?thoo]]))))
(<? (d/<transact! conn [[:db/add x :bar/thoo 1492]]))
(is (= [1492] (<? (d/<q @db [:find ['?thoo '...] :in '$ :where [x :bar/thoo '?thoo]])))))))

28
test/datomish/schema_test.cljc
View file

@ -1,28 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
(ns datomish.schema-test
(:require
[datomish.schema :as schema]
#?@(:clj [[datomish.test-macros :refer [deftest-async]]
[clojure.test :as t :refer [is are deftest testing]]])
#?@(:cljs [[datomish.test-macros :refer-macros [deftest-async]]
[cljs.test :as t :refer-macros [is are deftest testing async]]])))
#?(:clj
(deftest test-uuid-validation
(is (not (schema/uuidish? "123e4567-e89b-12d3-a456-426655440000")))
(is (schema/uuidish? (java.util.UUID/fromString "123e4567-e89b-12d3-a456-426655440000")))))
#?(:cljs
(deftest test-uuid-validation
;; Case-insensitive.
(is (schema/uuidish? "123e4567-e89b-12d3-a456-426655440000"))
(is (schema/uuidish? "123E4567-e89b-12d3-a456-426655440000"))))

41
test/datomish/sqlite_user_version_test.cljc
View file

@ -1,41 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
(ns datomish.sqlite-user-version-test
#?(:cljs
(:require-macros
[datomish.pair-chan :refer [go-pair <?]]
[datomish.node-tempfile-macros :refer [with-tempfile]]
[cljs.core.async.macros :as a :refer [go]]))
(:require
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
[datomish.sqlite :as s]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
[tempfile.core :refer [tempfile with-tempfile]]
[datomish.test-macros :refer [deftest-async]]
[clojure.test :as t :refer [is are deftest testing]]
[clojure.core.async :refer [go <! >!]]])
#?@(:cljs [[datomish.pair-chan]
[datomish.test-macros :refer-macros [deftest-async]]
[datomish.node-tempfile :refer [tempfile]]
[cljs.test :as t :refer-macros [is are deftest testing async]]
[cljs.core.async :as a :refer [<! >!]]])))
(deftest-async test-all-rows
(with-tempfile [t (tempfile)]
(let [db (<? (s/<sqlite-connection t))]
(try
(<? (s/execute! db ["CREATE TABLE test (a INTEGER)"]))
(<? (s/execute! db ["INSERT INTO test VALUES (?)" 1]))
(<? (s/execute! db ["INSERT INTO test VALUES (?)" 2]))
(let [rows (<? (s/all-rows db ["SELECT * FROM test ORDER BY a ASC"]))]
(is (= rows [{:a 1} {:a 2}])))
(finally
(<? (s/close db)))))))

35
test/datomish/test.cljs
View file

@ -1,35 +0,0 @@
(ns datomish.test
(:require
[doo.runner :refer-macros [doo-tests doo-all-tests]]
[cljs.test :as t :refer-macros [is are deftest testing]]
datomish.schema-changes-test
datomish.schema-management-test
datomish.places.importer-test
datomish.promise-sqlite-test
datomish.db-test
datomish.query-test
datomish.schema-test
datomish.sqlite-user-version-test
datomish.tofinoish-test
datomish.transact-test
datomish.util-test
datomish.test.transforms
datomish.test.query
datomish.test-macros-test
))
(doo-tests
'datomish.schema-changes-test
'datomish.schema-management-test
'datomish.places.importer-test
'datomish.promise-sqlite-test
'datomish.db-test
'datomish.query-test
'datomish.schema-test
'datomish.sqlite-user-version-test
'datomish.tofinoish-test
'datomish.transact-test
'datomish.util-test
'datomish.test.transforms
'datomish.test.query
'datomish.test-macros-test)

927
test/datomish/test/query.cljc
View file

@ -1,927 +0,0 @@
(ns datomish.test.query
#?(:cljs
(:require-macros
[datomish.pair-chan :refer [go-pair <?]]
[datomish.node-tempfile-macros :refer [with-tempfile]]
[cljs.core.async.macros :as a :refer [go]]))
(:require
[datomish.query.cc :as cc]
[datomish.query.context :as context]
[datomish.query.source :as source]
[datomish.query.transforms :as transforms]
[datomish.query :as query]
[datomish.db :as db]
[datomish.schema :as schema]
[datomish.transact :as transact]
[datomish.api :as d]
#?@(:clj
[[datomish.pair-chan :refer [go-pair <?]]
[datomish.jdbc-sqlite]
[datomish.test-macros :refer [deftest-db]]
[honeysql.core :as sql :refer [param]]
[tempfile.core :refer [tempfile with-tempfile]]
[clojure.test :as t :refer [is are deftest testing]]])
#?@(:cljs
[[datomish.js-sqlite]
[datomish.test-macros :refer-macros [deftest-db]]
[honeysql.core :as sql :refer-macros [param]]
[datomish.node-tempfile :refer [tempfile]]
[cljs.test :as t :refer-macros [is are deftest testing]]]))
#?(:clj
(:import [clojure.lang ExceptionInfo])))
(defn- fgensym [s c]
(symbol (str s c)))
(defn make-predictable-gensym []
(let [counter (atom 0)]
(fn
([]
(fgensym "G__" (dec (swap! counter inc))))
([s]
(fgensym s (dec (swap! counter inc)))))))
(def simple-schema
[{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/ident :db/txInstant
:db/valueType :db.type/long
:db/cardinality :db.cardinality/one}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/ident :foo/bar
:db/valueType :db.type/string
:db/cardinality :db.cardinality/many}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/ident :foo/int
:db/valueType :db.type/long
:db/cardinality :db.cardinality/one}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/ident :foo/str
:db/valueType :db.type/string
:db/cardinality :db.cardinality/many}])
(def page-schema
[{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/ident :page/loves
:db/valueType :db.type/ref
:db/cardinality :db.cardinality/many}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/ident :page/likes
:db/valueType :db.type/ref
:db/cardinality :db.cardinality/many}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/ident :page/url
:db/valueType :db.type/string
:db/unique :db.unique/identity
:db/cardinality :db.cardinality/one}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/ident :page/title
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/ident :page/save
:db/valueType :db.type/ref
:db/unique :db.unique/identity ; A save uniquely identifies a page.
:db/cardinality :db.cardinality/many}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/ident :page/starred
:db/valueType :db.type/boolean
:db/cardinality :db.cardinality/one}])
(def aggregate-schema
[{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/ident :page/url
:db/valueType :db.type/string
:db/unique :db.unique/identity
:db/cardinality :db.cardinality/one}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/ident :foo/points
:db/valueType :db.type/long
:db/cardinality :db.cardinality/many}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/ident :foo/visitedAt
:db/valueType :db.type/instant
:db/cardinality :db.cardinality/many}])
(def save-schema
[{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/cardinality :db.cardinality/one
:db/valueType :db.type/string
:db/fulltext true
:db/ident :save/title}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/cardinality :db.cardinality/one
:db/valueType :db.type/string
:db/fulltext true
:db/ident :save/excerpt}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/cardinality :db.cardinality/one
:db/valueType :db.type/string
:db/fulltext true
:db/ident :save/content}])
(def schema-with-page
(concat
simple-schema
page-schema))
(defn mock-source [db]
(assoc (datomish.db/datoms-source db)
:table-alias (comp (make-predictable-gensym) name)))
(defn conn->context [conn]
(context/make-context (mock-source (d/db conn))))
(defn- expand [find conn]
(let [context (conn->context conn)
parsed (query/parse find)]
(query/find->sql-clause context parsed)))
(defn- populate [find conn]
(let [context (conn->context conn)
parsed (query/parse find)]
(query/find-into-context context parsed)))
(defn <initialize-with-schema [conn schema]
(go-pair
(let [tx (<? (d/<transact! conn schema))]
(let [idents (map :db/ident schema)
db (d/db conn)]
(into {}
(map (fn [ident]
[ident (d/entid db ident)])
idents))))))
(deftest-db test-type-extraction conn
;; We expect to be able to look up the default types.
(is (integer? (d/entid (d/db conn) :db.type/ref)))
(is (integer? (d/entid (d/db conn) :db.type/long)))
;; Add our own schema.
(<? (<initialize-with-schema conn simple-schema))
(testing "Variable entity."
(is (= (->
(populate '[:find ?e ?v :in $ :where [?e :foo/int ?v]] conn)
:cc :known-types)
{'?v :db.type/long
'?e :db.type/ref})))
(testing "Numeric entid."
(is (= (->
(populate '[:find ?v :in $ :where [6 :foo/int ?v]] conn)
:cc :known-types)
{'?v :db.type/long})))
(testing "Keyword entity."
(is (= (->
(populate '[:find ?v :in $ :where [:my/thing :foo/int ?v]] conn)
:cc :known-types)
{'?v :db.type/long}))))
(deftest-db test-value-constant-constraint-descends-into-not-and-or conn
(let [attrs (<? (<initialize-with-schema conn simple-schema))]
(testing "Elision of types inside a join."
(is (= {:select '([:datoms0.e :e]
[:datoms0.v :v]),
:modifiers [:distinct],
:from [[:datoms 'datoms0]],
:where (list :and
[:= :datoms0.a (:foo/int attrs)]
[:not
[:exists
{:select [1],
:from [[:all_datoms 'all_datoms1]],
:where (list :and
[:= :all_datoms1.e 999]
[:= :datoms0.v :all_datoms1.v])}]])}
(expand
'[:find ?e ?v :in $ :where
[?e :foo/int ?v]
(not [999 ?a ?v])]
conn))))
(testing "Type collisions inside :not."
(is (thrown-with-msg?
ExceptionInfo #"v already has type :db.type.long"
(expand
'[:find ?e ?v :in $ :where
[?e :foo/int ?v]
(not [999 :foo/str ?v])]
conn))))
(testing "Type collisions inside :or"
(is (thrown-with-msg?
ExceptionInfo #"v already has type :db.type.long"
(expand
'[:find ?e ?v :in $ :where
[?e :foo/int ?v]
(or
[999 :foo/str ?v]
[666 :foo/int ?v])]
conn))))))
(deftest-db test-type-collision conn
(<? (<initialize-with-schema conn simple-schema))
(let [find '[:find ?e ?v :in $
:where
[?e :foo/int ?v]
[?x :foo/str ?v]]]
(is (thrown-with-msg?
ExceptionInfo #"v already has type :db.type.long"
(populate find conn)))))
(deftest-db test-value-constant-constraint conn
(<? (<initialize-with-schema conn simple-schema))
(is (= {:select '([:all_datoms0.e :foo]),
:modifiers [:distinct],
:from '[[:all_datoms all_datoms0]],
:where (list :and
(list :or
[:= :all_datoms0.value_type_tag 0]
;; In CLJS, this can also be an `instant`.
#?@(:cljs [[:= :all_datoms0.value_type_tag 4]])
[:= :all_datoms0.value_type_tag 5])
[:= :all_datoms0.v 99])}
(expand
'[:find ?foo :in $ :where
[?foo _ 99]]
conn))))
(deftest-db test-value-constant-constraint-elided-using-schema conn
(let [attrs (<? (<initialize-with-schema conn schema-with-page))]
(testing "Our attributes were interned."
(is (integer? (d/entid (d/db conn) :foo/str)))
(is (integer? (d/entid (d/db conn) :page/starred))))
(testing "There's no need to produce value_type_tag constraints when the attribute is specified."
(is
(= {:select '([:datoms1.v :timestampMicros] [:datoms0.e :page]),
:modifiers [:distinct],
:from [[:datoms 'datoms0]
[:datoms 'datoms1]],
:where (list :and
;; We don't need a type check on the range of page/starred...
[:= :datoms0.a (:page/starred attrs)]
[:= :datoms0.v 1]
[:= :datoms1.a (:db/txInstant attrs)]
[:not
[:exists
{:select [1],
:from [[:datoms 'datoms2]],
:where (list :and
[:= :datoms2.a (:foo/bar attrs)]
[:= :datoms0.e :datoms2.e])}]]
[:= :datoms0.tx :datoms1.e])}
(expand
'[:find ?timestampMicros ?page :in $ ?latest :where
[?page :page/starred true ?t]
[?t :db/txInstant ?timestampMicros]
(not [?page :foo/bar _])]
conn))))))
(deftest-db test-basic-join conn
;; Note that we use a schema without :page/starred, so we
;; don't know what type it is.
(let [attrs (<? (<initialize-with-schema conn simple-schema))]
(is (= {:select '([:datoms1.v :timestampMicros] [:datoms0.e :page]),
:modifiers [:distinct],
:from '([:datoms datoms0]
[:datoms datoms1]),
:where (list
:and
;; Note that :page/starred is literal, because
;; it's not present in the interned schema.
[:= :datoms0.a :page/starred]
[:= :datoms0.value_type_tag 1] ; boolean
[:= :datoms0.v 1]
[:= :datoms1.a (:db/txInstant attrs)]
[:not
(list :and (list :> :datoms0.tx (sql/param :latest)))]
[:= :datoms0.tx :datoms1.e])}
(expand
'[:find ?timestampMicros ?page :in $ ?latest :where
[?page :page/starred true ?t]
[?t :db/txInstant ?timestampMicros]
(not [(> ?t ?latest)])]
conn)))))
(deftest-db test-pattern-not-join conn
(let [attrs (<? (<initialize-with-schema conn simple-schema))]
(is (= {:select '([:datoms1.v :timestampMicros] [:datoms0.e :page]),
:modifiers [:distinct],
:from [[:datoms 'datoms0]
[:datoms 'datoms1]],
:where (list
:and
;; Note that :page/starred is literal, because
;; it's not present in the interned schema.
[:= :datoms0.a :page/starred]
[:= :datoms0.value_type_tag 1] ; boolean
[:= :datoms0.v 1]
[:= :datoms1.a (:db/txInstant attrs)]
[:not
[:exists
{:select [1],
:from [[:datoms 'datoms2]],
:where (list :and
[:= :datoms2.a (:foo/bar attrs)]
[:= :datoms0.e :datoms2.e])}]]
[:= :datoms0.tx :datoms1.e])}
(expand
'[:find ?timestampMicros ?page :in $ ?latest :where
[?page :page/starred true ?t]
[?t :db/txInstant ?timestampMicros]
(not [?page :foo/bar _])]
conn)))))
;; Note that clause ordering is not directly correlated to the output: cross-bindings end up
;; at the front. The SQL engine will do its own analysis. See `clauses/expand-where-from-bindings`.
(deftest-db test-not-clause-ordering-preserved conn
(let [attrs (<? (<initialize-with-schema conn schema-with-page))]
(is (= {:select '([:datoms1.v :timestampMicros] [:datoms0.e :page]),
:modifiers [:distinct],
:from '[[:datoms datoms0]
[:datoms datoms1]],
:where (list
:and
;; We don't need a value tag constraint -- we know the range of the attribute.
[:= :datoms0.a (:page/starred attrs)]
[:= :datoms0.v 1]
[:not
(list :and (list :> :datoms0.tx (sql/param :latest)))]
[:= :datoms1.a (:db/txInstant attrs)]
[:= :datoms0.tx :datoms1.e]
)}
(expand
'[:find ?timestampMicros ?page :in $ ?latest :where
[?page :page/starred true ?t]
(not [(> ?t ?latest)])
[?t :db/txInstant ?timestampMicros]]
conn)))))
(deftest-db test-pattern-not-join-ordering-preserved conn
(let [attrs (<? (<initialize-with-schema conn schema-with-page))]
(is (= {:select '([:datoms2.v :timestampMicros] [:datoms0.e :page]),
:modifiers [:distinct],
:from [[:datoms 'datoms0]
[:datoms 'datoms2]],
:where (list :and
;; We don't need a value tag constraint -- we know the range of the attribute.
[:= :datoms0.a (:page/starred attrs)]
[:= :datoms0.v 1]
[:not
[:exists
{:select [1],
:from [[:datoms 'datoms1]],
:where (list :and
[:= :datoms1.a (:foo/bar attrs)]
[:= :datoms0.e :datoms1.e])}]]
[:= :datoms2.a (:db/txInstant attrs)]
[:= :datoms0.tx :datoms2.e])}
(expand
'[:find ?timestampMicros ?page :in $ ?latest :where
[?page :page/starred true ?t]
(not [?page :foo/bar _])
[?t :db/txInstant ?timestampMicros]]
conn)))))
(deftest-db test-single-or conn
(let [attrs (<? (<initialize-with-schema conn schema-with-page))]
(is (= {:select '([:datoms0.e :page]),
:modifiers [:distinct],
:from '([:datoms datoms0] [:datoms datoms1] [:datoms datoms2]),
:where (list :and
[:= :datoms0.a (:page/url attrs)]
[:= :datoms0.v "http://example.com/"]
[:= :datoms1.a (:page/title attrs)]
[:= :datoms2.a (:page/loves attrs)]
[:= :datoms0.e :datoms1.e]
[:= :datoms0.e :datoms2.v])}
(expand
'[:find ?page :in $ ?latest :where
[?page :page/url "http://example.com/"]
[?page :page/title ?title]
(or
[?entity :page/loves ?page])]
conn)))))
(deftest-db test-simple-or conn
(let [attrs (<? (<initialize-with-schema conn schema-with-page))]
(is (= {:select '([:datoms0.e :page]),
:modifiers [:distinct],
:from '([:datoms datoms0] [:datoms datoms1] [:datoms datoms2]),
:where (list :and
[:= :datoms0.a (:page/url attrs)]
[:= :datoms0.v "http://example.com/"]
[:= :datoms1.a (:page/title attrs)]
(list :or
[:= :datoms2.a (:page/likes attrs)]
[:= :datoms2.a (:page/loves attrs)])
[:= :datoms0.e :datoms1.e]
[:= :datoms0.e :datoms2.v])}
(expand
'[:find ?page :in $ ?latest :where
[?page :page/url "http://example.com/"]
[?page :page/title ?title]
(or
[?entity :page/likes ?page]
[?entity :page/loves ?page])]
conn)))))
(deftest-db test-complex-or conn
(let [attrs (<? (<initialize-with-schema
conn
(concat save-schema schema-with-page)))]
(is (= {:select '([:datoms0.e :page] [:datoms0.v :starred]),
:modifiers [:distinct],
:where (list :and
[:= :datoms0.a (:page/starred attrs)]
[:= :datoms0.e :orjoin1.page])
:from
[[:datoms 'datoms0]
[{:union
(list
;; These first two will be merged together when
;; we implement simple pattern alternation within
;; complex `or`.
{:from '([:datoms datoms2]),
:select '([:datoms2.e :page]),
:where (list :and
[:= :datoms2.a (:page/url attrs)]
[:= :datoms0.e :datoms2.e]
[:= (sql/param :s) :datoms2.v])}
{:from '([:datoms datoms3]),
:select '([:datoms3.e :page]),
:where (list :and
[:= :datoms3.a (:page/title attrs)]
[:= :datoms0.e :datoms3.e]
[:= (sql/param :s) :datoms3.v])}
{:from '([:datoms datoms4]
[:fulltext_datoms fulltext_datoms5]
[:fulltext_datoms fulltext_datoms6]),
:select '([:datoms4.e :page]),
:where (list :and
[:= :datoms4.a (:page/save attrs)]
[:= :fulltext_datoms5.a (:save/excerpt attrs)]
[:= :fulltext_datoms6.a (:save/content attrs)]
[:= :datoms4.v :fulltext_datoms5.e]
[:= :datoms4.v :fulltext_datoms6.e]
[:= :fulltext_datoms5.v :fulltext_datoms6.v]
[:= :datoms0.e :datoms4.e]
[:= (sql/param :s) :fulltext_datoms5.v])})}
'orjoin1]]}
(expand
'[:find ?page ?starred :in $ ?s :where
[?page :page/starred ?starred]
(or-join [?page]
[?page :page/url ?s]
[?page :page/title ?s]
(and [?page :page/save ?saved]
[?saved :save/excerpt ?s]
[?saved :save/content ?s]))]
conn)))))
(defn tag-clauses [column input]
(let [codes (cc/->tag-codes input)]
(if (= 1 (count codes))
[:= column (first codes)]
(cons :or (map (fn [tag]
[:= column tag])
codes)))))
(deftest-db test-url-tag conn
(let [attrs (<? (<initialize-with-schema conn schema-with-page))]
(is (= {:select '([:all_datoms0.e :page]
[:datoms1.v :thing]),
:modifiers [:distinct],
:from '([:all_datoms all_datoms0]
[:datoms datoms1]),
:where (list
:and
(tag-clauses :all_datoms0.value_type_tag "http://example.com/")
[:= :all_datoms0.v "http://example.com/"]
(list
:or
[:= :datoms1.a (:page/likes attrs)]
[:= :datoms1.a (:page/loves attrs)])
[:= :all_datoms0.e :datoms1.e])}
(expand
'[:find ?page ?thing :in $ ?latest :where
[?page _ "http://example.com/"]
(or
[?page :page/likes ?thing]
[?page :page/loves ?thing])]
conn)))))
(deftest-db test-tag-projection conn
(let [attrs (<? (<initialize-with-schema conn schema-with-page))]
(is (= {:select '([:all_datoms0.e :page]
[:all_datoms0.v :thing]
[:all_datoms0.value_type_tag :_thing_type_tag]),
:modifiers [:distinct],
:from '([:all_datoms all_datoms0])}
(expand
'[:find ?page ?thing :in $ :where
[?page _ ?thing]]
conn)))))
(deftest-db test-aggregates conn
(let [attrs (<? (<initialize-with-schema conn aggregate-schema))
context
(populate '[:find ?date (max ?v)
:with ?e
:in $ ?then
:where
[?e :foo/visitedAt ?date]
[(> ?date ?then)]
[?e :foo/points ?v]] conn)]
(is (= (:group-by-vars context)
['?date '?e]))
(is (= {:select '([:preag.date :date]
[:%max.preag.v :_max_v])
:modifiers [:distinct]
:group-by '(:date :e),
:with {:preag
{:select '([:datoms0.v :date]
[:datoms1.v :v]
[:datoms0.e :e]), ; Because we need to group on it.
:modifiers [:distinct],
:from '([:datoms datoms0] [:datoms datoms1]),
:where (list
:and
[:= :datoms0.a (:foo/visitedAt attrs)]
(list :> :datoms0.v (sql/param :then))
[:= :datoms1.a (:foo/points attrs)]
[:= :datoms0.e :datoms1.e])}}
:from [:preag]}
(query/context->sql-clause context)))))
(deftest-db test-get-else conn
(let [attrs (<? (<initialize-with-schema conn page-schema))]
(is (= {:select (list
[:datoms0.e :page]
[{:select [(sql/call
:coalesce
{:select [:v],
:from [:datoms],
:where [:and
[:= 'a 65540]
[:= 'e :datoms0.e]],
:limit 1}
"No title")],
:limit 1} :title]),
:modifiers [:distinct],
:from '([:datoms datoms0]),
:where (list :and [:= :datoms0.a 65539])}
(expand '[:find ?page ?title :in $
:where
[?page :page/url _]
[(get-else $ ?page :page/title "No title") ?title]]
conn)))))
(deftest-db test-ground conn
(let [attrs (<? (<initialize-with-schema conn page-schema))]
(is (= {:select (list
[:datoms0.e :page]
[(sql/param :xyz) :foo]),
:modifiers [:distinct],
:from '([:datoms datoms0]),
:where (list :and [:= :datoms0.a (:page/url attrs)])}
(expand '[:find ?page ?foo :in
$ ?xyz ; Bound param.
:where
[(ground ?xyz) ?foo]
[?page :page/url _]]
conn)))
(is (= {:select (list
[:datoms0.e :page]
[452 :foo]),
:modifiers [:distinct],
:from '([:datoms datoms0]),
:where (list :and [:= :datoms0.a (:page/url attrs)])}
(expand '[:find ?page ?foo :in $
:where
[(ground 452) ?foo]
[?page :page/url _]]
conn)))))
(deftest-db test-limit-order conn
(let [attrs (<? (<initialize-with-schema conn aggregate-schema))
context
(populate '[:find ?date (max ?v)
:with ?e
:in $ ?then
:where
[?e :foo/visitedAt ?date]
[(> ?date ?then)]
[?e :foo/points ?v]] conn)]
(is
(thrown-with-msg?
ExceptionInfo #"Invalid limit \?x"
(query/options-into-context context '?x [[:date :asc]])))
(is
(thrown-with-msg?
ExceptionInfo #"Ordering expressions must be :asc or :desc"
(query/context->sql-clause
(query/options-into-context context 10 [[:date :upsidedown]]))))
(is
(thrown-with-msg?
ExceptionInfo #"Ordering vars \#\{:nonexistent\} not a subset"
(query/context->sql-clause
(query/options-into-context context 10 [[:nonexistent :desc]]))))
(is
(=
{:limit 10}
(select-keys
(query/context->sql-clause
(query/options-into-context context 10 nil))
[:order-by :limit]
)))
(is
(=
{:order-by [[:date :asc]]}
(select-keys
(query/context->sql-clause
(query/options-into-context context nil [[:date :asc]]))
[:order-by :limit]
)))
(is
(=
{:limit 10
:order-by [[:date :asc]]}
(select-keys
(query/context->sql-clause
(query/options-into-context context 10 [[:date :asc]]))
[:order-by :limit]
)))))
(deftest-db test-parsing-fulltext conn
(let [attrs (<? (<initialize-with-schema conn save-schema))]
(is (= {:select (list [:datoms1.e :save]),
:modifiers [:distinct],
:from (list [:fulltext_values 'fulltext_values0]
[:datoms 'datoms1]),
:where (list :and
[:match :fulltext_values0.fulltext_values "something"]
[:= :datoms1.v :fulltext_values0.rowid]
[:= :datoms1.a (:save/title attrs)])}
(expand {:find '[?save]
:in '[$]
:where [[(list 'fulltext
'$
:save/title
"something")
'[[?save]]]]}
conn)))
(is (= {:select (list [:datoms1.e :save]),
:modifiers [:distinct],
:from (list [:fulltext_values 'fulltext_values0]
[:datoms 'datoms1]),
:where (list :and
[:match :fulltext_values0.fulltext_values "something"]
[:= :datoms1.v :fulltext_values0.rowid]
(list :or
[:= :datoms1.a (:save/title attrs)]
[:= :datoms1.a (:save/excerpt attrs)]))}
(expand {:find '[?save]
:in '[$]
:where [[(list 'fulltext
'$
#{:save/title :save/excerpt}
"something")
'[[?save]]]]}
conn)))))
(deftest-db test-find-specs-expansion conn
(let [attrs (<? (<initialize-with-schema conn save-schema))]
;; Relation.
(is (= {:select (list [:fulltext_datoms0.v :title])
:modifiers [:distinct]
:from (list [:fulltext_datoms 'fulltext_datoms0])
:where (list :and [:= :fulltext_datoms0.a (:save/title attrs)])}
(expand [:find '?title
:in '$
:where '[?save :save/title ?title]]
conn)))
;; Tuple. We expect only one result, and indeed we only take one.
;; No need for :distinct in this case!
(is (= {:select (list [:fulltext_datoms0.v :title])
:modifiers []
:limit 1
:from (list [:fulltext_datoms 'fulltext_datoms0])
:where (list :and [:= :fulltext_datoms0.a (:save/title attrs)])}
(expand [:find '[?title]
:in '$
:where '[?save :save/title ?title]]
conn)))
;; Scalar. As with the tuple form, we expect only one result.
(is (= {:select (list [:fulltext_datoms0.v :title])
:modifiers []
:limit 1
:from (list [:fulltext_datoms 'fulltext_datoms0])
:where (list :and [:= :fulltext_datoms0.a (:save/title attrs)])}
(expand [:find '?title '.
:in '$
:where '[?save :save/title ?title]]
conn)))
;; Collection.
(is (= {:select (list [:fulltext_datoms0.v :title])
:modifiers [:distinct]
:from (list [:fulltext_datoms 'fulltext_datoms0])
:where (list :and [:= :fulltext_datoms0.a (:save/title attrs)])}
(expand [:find '[?title ...]
:in '$
:where '[?save :save/title ?title]]
conn)))))
(defn orderless=
"Compare two arrays regardless of order."
[a b]
(= (set a) (set b)))
(deftest-db test-find-specs-empty-results conn
(let [attrs (<? (<initialize-with-schema conn save-schema))]
;; Relation.
(is (= []
(<? (d/<q (d/db conn)
[:find '?title
:in '$
:where '[?save :save/title ?title]]))))
;; Tuple.
(is (nil? (<? (d/<q (d/db conn)
[:find '[?title]
:in '$
:where '[?save :save/title ?title]]))))
;; Scalar.
(is (nil? (<? (d/<q (d/db conn)
[:find '?title '.
:in '$
:where '[?save :save/title ?title]]))))
;; Collection.
(is (= []
(<? (d/<q (d/db conn)
[:find '[?title ...]
:in '$
:where '[?save :save/title ?title]]))))))
(deftest-db test-find-specs-result-shape conn
(let [attrs (<? (<initialize-with-schema conn save-schema))]
;; Add some data.
(<? (d/<transact! conn
[{:db/id (d/id-literal :db.part/user -1)
:save/title "Some page title"}
{:db/id (d/id-literal :db.part/user -2)
:save/title "A different page"}]))
;; Relation.
(is (orderless=
[["A different page"]["Some page title"]]
(<? (d/<q (d/db conn)
[:find '?title
:in '$
:where '[?save :save/title ?title]]
{:order-by [[:title :asc]]}))))
;; Tuple. We expect only one result, and indeed we only take one.
;; No need for :distinct in this case!
(let [result (<? (d/<q (d/db conn)
[:find '[?title]
:in '$
:where '[?save :save/title ?title]]
{:order-by [[:title :asc]]}))]
(is (= ["A different page"] result)))
;; Scalar. As with the tuple form, we expect only one result.
(let [result (<? (d/<q (d/db conn)
[:find '?title '.
:in '$
:where '[?save :save/title ?title]]
{:order-by [[:title :asc]]}))]
(is (= "A different page" result)))
;; Collection.
(is (orderless=
["Some page title" "A different page"]
(<? (d/<q (d/db conn)
[:find '[?title ...]
:in '$
:where '[?save :save/title ?title]]
{:order-by [[:title :desc]]}))))))
(deftest-db test-tuple conn
(let [attrs (<? (<initialize-with-schema conn save-schema))]
(<? (d/<transact! conn
[{:db/id (d/id-literal :db.part/user -1)
:save/title "Some page title"
:save/excerpt "Some page excerpt"}
{:db/id (d/id-literal :db.part/user -2)
:save/title "A different page"
:save/excerpt "A different excerpt"}]))
(let [result (<? (d/<q (d/db conn)
[:find '[?title ?excerpt]
:in '$
:where
'[?save :save/title ?title]
'[?save :save/excerpt ?excerpt]]))]
(is (or (= ["Some page title" "Some page excerpt"] result)
(= ["A different page" "A different excerpt"] result))))))
(deftest-db test-or-join-real-world conn
;; This tests the simplest cause of https://github.com/mozilla/datomish/issues/84.
(testing "or-join with fulltext expressions doesn't leak type_tag columns."
(let [attrs (<? (<initialize-with-schema
conn
(concat save-schema schema-with-page)))]
(is
(=
{:select (list
[:datoms6.v :url]
[{:select [(sql/call :coalesce
{:select [:v]
:from [:datoms]
:where [:and
[:= 'a 65546]
[:= 'e :orjoin0.page]]
:limit 1}
"")]
:limit 1}
:title])
:modifiers []
:from (list
[{:union (list
{:select '([:datoms2.e :page])
:from '([:fulltext_values fulltext_values1] [:datoms datoms2])
:where (list :and
[:match :fulltext_values1.fulltext_values (sql/param :str)]
[:= :datoms2.v :fulltext_values1.rowid]
(list :or [:= :datoms2.a (:page/url attrs)] [:= :datoms2.a (:page/title attrs)]))}
{:select '([:datoms5.e :page])
:from '([:fulltext_values fulltext_values3] [:datoms datoms4] [:datoms datoms5])
:where (list :and
[:match :fulltext_values3.fulltext_values (sql/param :str)]
[:= :datoms4.v :fulltext_values3.rowid]
(list :or
[:= :datoms4.a (:save/title attrs)]
[:= :datoms4.a (:save/content attrs)]
[:= :datoms4.a (:save/excerpt attrs)]
)
[:= :datoms5.a (:page/save attrs)]
[:= :datoms4.e :datoms5.v])})}
'orjoin0]
'[:datoms datoms6])
:where (list :and
[:= :datoms6.a (:page/url attrs)]
[:= :orjoin0.page :datoms6.e])
:limit 1}
(expand
'[:find [?url ?title]
:in $ ?str
:where
(or-join [?page]
[(fulltext $ #{:page/url :page/title} ?str) [[?page]]]
(and
[(fulltext $ #{:save/title :save/excerpt :save/content} ?str) [[?save]]]
[?page :page/save ?save]))
[?page :page/url ?url]
[(get-else $ ?page :page/title "") ?title]]
conn))))))
;; honeysql up to 0.8.2 includes parentheses around the arms of a
;; UNION. This isn't acceptable to SQLite.
;; See https://github.com/jkk/honeysql/pull/142.
(deftest test-honeysql-union
(testing "UNION doesn't include surplus parentheses."
(is (= ["SELECT x FROM (SELECT x FROM abc UNION SELECT x FROM def) foo"]
(sql/format {:select ['x]
:from (list [{:union (list
{:select ['x]
:from [:abc]}
{:select ['x]
:from [:def]})}
:foo])})))))

26
test/datomish/test/transforms.cljc
View file

@ -1,26 +0,0 @@
(ns datomish.test.transforms
(:require
[datomish.query.transforms :as transforms]
#?(:clj [clojure.test :as t :refer [is are deftest testing]])
#?(:cljs [cljs.test :as t :refer-macros [is are deftest testing]])
))
(deftest test-attribute-transform-string
(is (= "p/foo"
(transforms/attribute-transform-string :p/foo))))
(deftest test-constant-transform-default
;; Keywords.
(is (= "p/foo" (transforms/constant-transform-default :p/foo))) ; For now.
;; Booleans.
(is (= 1 (transforms/constant-transform-default true)))
(is (= 0 (transforms/constant-transform-default false)))
;; Numbers and strings.
#?(:cljs (is (= 1 (transforms/constant-transform-default 1.0))))
#?(:clj (is (= 1.0 (transforms/constant-transform-default 1.0))))
(is (= -1 (transforms/constant-transform-default -1)))
(is (= 42 (transforms/constant-transform-default 42)))
(is (= "" (transforms/constant-transform-default "")))
(is (= "foo" (transforms/constant-transform-default "foo"))))

22
test/datomish/test_macros_test.clj
View file

@ -1,22 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
(ns datomish.test-macros-test
(:require
[datomish.pair-chan :refer [go-pair]]
[datomish.test-macros :refer [deftest-async]]
[clojure.core.async :as a]
[clojure.test :as t :refer [is are deftest testing]]))
(deftest sync-test
(is (= 1 1)))
(deftest-async async-test
(is (= 1 1)))

24
test/datomish/test_macros_test.cljs
View file

@ -1,24 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
(ns datomish.test-macros-test
(:require-macros
[datomish.pair-chan :refer [go-pair]]
[cljs.core.async.macros])
(:require
[datomish.test-macros :refer-macros [deftest-async]]
[cljs.core.async]
[cljs.test :refer-macros [is are deftest testing async]]))
(deftest sync-test
(is (= 1 1)))
(deftest-async async-test
(is (= 1 1)))

492
test/datomish/tofinoish_test.cljc
View file

@ -1,492 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
(ns datomish.tofinoish-test
#?(:cljs
(:require-macros
[datomish.pair-chan :refer [go-pair <?]]
[datomish.node-tempfile-macros :refer [with-tempfile]]
[cljs.core.async.macros :as a :refer [go]]))
(:require
[datomish.api :as d]
[datomish.util :as util]
#?@(:clj [[datomish.jdbc-sqlite]
[datomish.pair-chan :refer [go-pair <?]]
[tempfile.core :refer [tempfile with-tempfile]]
[datomish.test-macros :refer [deftest-async deftest-db]]
[clojure.test :as t :refer [is are deftest testing]]
[clojure.core.async :refer [go <! >!]]])
#?@(:cljs [[datomish.js-sqlite]
[datomish.pair-chan]
[datomish.test-macros :refer-macros [deftest-async deftest-db]]
[datomish.node-tempfile :refer [tempfile]]
[cljs.test :as t :refer-macros [is are deftest testing async]]
[cljs.core.async :as a :refer [<! >!]]]))
#?(:clj
(:import [clojure.lang ExceptionInfo]))
#?(:clj
(:import [datascript.db DB])))
#?(:cljs
(def Throwable js/Error))
(def page-schema
[{:db/id (d/id-literal :db.part/user)
:db/ident :page/url
:db/valueType :db.type/string ; Because not all URLs are java.net.URIs. For JS we may want to use /uri.
:db/cardinality :db.cardinality/one
:db/unique :db.unique/identity
:db/doc "A page's URL."
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :page/title
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one ; We supersede as we see new titles.
:db/doc "A page's title."
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :page/starred
:db/valueType :db.type/boolean
:db/cardinality :db.cardinality/one
:db/doc "Whether the page is starred."
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :page/visit
:db/valueType :db.type/ref
:db/cardinality :db.cardinality/many
:db/doc "A visit to the page."
:db.install/_attribute :db.part/db}])
(def visit-schema
[{:db/id (d/id-literal :db.part/user)
:db/ident :visit/visitAt
:db/valueType :db.type/instant
:db/cardinality :db.cardinality/many
:db/doc "The instant of the visit."
:db.install/_attribute :db.part/db}])
(def session-schema
[{:db/id (d/id-literal :db.part/user)
:db/ident :session/startedFromAncestor
:db/valueType :db.type/ref ; To a session.
:db/cardinality :db.cardinality/one
:db/doc "The ancestor of a session."
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :session/startedInScope
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one
:db/doc "The parent scope of a session."
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :session/startReason
:db/valueType :db.type/string ; TODO: enum?
:db/cardinality :db.cardinality/many
:db/doc "The start reasons of a session."
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :session/endReason
:db/valueType :db.type/string ; TODO: enum?
:db/cardinality :db.cardinality/many
:db/doc "The end reasons of a session."
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :event/session
:db/valueType :db.type/ref ; To a session.
:db/cardinality :db.cardinality/one
:db/doc "The session in which a tx took place."
:db.install/_attribute :db.part/db}])
(def save-schema
[{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/cardinality :db.cardinality/one
:db/valueType :db.type/ref
:db/ident :save/page}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/cardinality :db.cardinality/one
:db/valueType :db.type/instant
:db/ident :save/savedAt}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/cardinality :db.cardinality/one
:db/valueType :db.type/string
:db/fulltext true
:db/ident :save/title}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/cardinality :db.cardinality/one
:db/valueType :db.type/string
:db/fulltext true
:db/ident :save/excerpt}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/cardinality :db.cardinality/one
:db/valueType :db.type/string
:db/fulltext true
:db/ident :save/content}
{:db/id (d/id-literal :db.part/user)
:db.install/_attribute :db.part/db
:db/cardinality :db.cardinality/many
:db/valueType :db.type/string
:db/fulltext false
:db/ident :save/unindexed}])
(def tofino-schema (concat page-schema visit-schema session-schema save-schema))
(defn instant [x]
#?(:cljs x)
#?(:clj (.getTime x)))
(defn now []
#?(:cljs (js/Date.))
#?(:clj (java.util.Date.)))
;; Returns the session ID.
(defn <start-session [conn {:keys [ancestor scope reason]
:or {reason "none"}}]
(let [id (d/id-literal :db.part/user -1)
base {:db/id id
:session/startedInScope (str scope)
:session/startReason reason}
datoms
(if ancestor
[(assoc base :session/startedFromAncestor ancestor)
{:db/id :db/tx
:event/session ancestor}]
[base])]
(go-pair
(->
(<? (d/<transact! conn datoms))
:tempids
(get id)))))
(defn <end-session [conn {:keys [session reason]
:or {reason "none"}}]
(d/<transact!
conn
[{:db/id :db/tx
:event/session session} ; So meta!
{:db/id session
:session/endReason reason}]))
(defn <active-sessions [db]
(d/<q
db
'[:find ?id ?reason ?ts :in $
:where
[?id :session/startReason ?reason ?tx]
[?tx :db/txInstant ?ts]
(not-join [?id]
[?id :session/endReason _])]))
(defn <ended-sessions [db]
(d/<q
db
'[:find ?id ?endReason ?ts :in $
:where
[?id :session/endReason ?endReason ?tx]
[?tx :db/txInstant ?ts]]))
(defn <star-page [conn {:keys [url uri title session]}]
(let [page (d/id-literal :db.part/user -1)]
(d/<transact!
conn
[{:db/id :db/tx
:event/session session}
(merge
(when title
{:page/title title})
{:db/id page
:page/url (or uri url)
:page/starred true})])))
(defn <starred-pages [db]
(go-pair
(->>
(<?
(d/<q
db
'[:find ?page ?uri ?title ?starredOn
:in $
:where
[?page :page/starred true ?tx]
[?tx :db/txInstant ?starredOn]
[?page :page/url ?uri]
[?page :page/title ?title] ; N.B., this means we will exclude pages with no title.
]))
(map (fn [[page uri title starredOn]]
{:page page :uri uri :title title :starredOn starredOn})))))
(defn <save-page [conn {:keys [url uri title session excerpt content]}]
(let [save (d/id-literal :db.part/user -1)
page (d/id-literal :db.part/user -2)]
(d/<transact!
conn
[{:db/id :db/tx
:event/session session}
{:db/id page
:page/url (or uri url)}
(merge
{:db/id save
:save/savedAt (now)
:save/page page}
(when title
{:save/title title})
(when excerpt
{:save/excerpt excerpt})
(when content
{:save/content content}))])))
(defn <saved-pages [db]
(d/<q db
'[:find ?page ?url ?title ?excerpt
:in $
:where
[?save :save/page ?page]
[?page :page/url ?url]
[(get-else $ ?save :save/title "") ?title]
[(get-else $ ?save :save/excerpt "") ?excerpt]]))
(defn <saved-pages-matching-string [db string]
(d/<q db
{:find '[?page ?url ?title ?excerpt]
:in '[$]
:where [[(list 'fulltext '$ :any string) '[[?save]]]
'[?save :save/page ?page]
'[?page :page/url ?url]
'[(get-else $ ?save :save/title "") ?title]
'[(get-else $ ?save :save/excerpt "") ?excerpt]]}))
;; TODO: return ID?
(defn <add-visit [conn {:keys [url uri title session]}]
(let [visit (d/id-literal :db.part/user -1)
page (d/id-literal :db.part/user -2)]
(d/<transact!
conn
[{:db/id :db/tx
:event/session session}
{:db/id visit
:visit/visitAt (now)}
(merge
(when title
{:page/title title})
{:db/id page
:page/url (or uri url)
:page/visit visit})])))
(defn- third [x]
(nth x 2))
(defn <visited [db
{:keys [limit since]
:or {limit 10}}]
(let [where
(if since
'[[?visit :visit/visitAt ?time]
[(> ?time ?since)]
[?page :page/visit ?visit]
[?page :page/url ?uri]
[(get-else $ ?page :page/title "") ?title]]
'[[?page :page/visit ?visit]
[?visit :visit/visitAt ?time]
[?page :page/url ?uri]
[(get-else $ ?page :page/title "") ?title]])]
(go-pair
(let [rows (<? (d/<q
db
{:find '[?uri ?title (max ?time)]
:in (if since '[$ ?since] '[$])
:where where}
{:limit limit
:order-by [[:_max_time :desc]]
:inputs {:since since}}))]
(map (fn [[uri title lastVisited]]
{:uri uri :title title :lastVisited lastVisited})
rows)))))
(defn <find-title [db url]
(d/<q db
'[:find ?title . :in $ ?url
:where
[?page :page/url ?url]
[?page :page/title ?title]]
{:inputs {:url url}}))
;; Ensure that we can grow the schema over time.
(deftest-db test-schema-evolution conn
(<? (d/<transact! conn page-schema))
(<? (d/<transact! conn tofino-schema)))
(deftest-db test-starring conn
(<? (d/<transact! conn tofino-schema))
(let [session (<? (<start-session conn {:ancestor nil :scope "foo"}))
earliest (instant (now))]
(<? (<star-page conn {:uri "http://mozilla.org/"
:title "Mozilla"
:session session}))
(let [[moz & starred] (<? (<starred-pages (d/db conn)))]
(is (empty? starred))
(is (= "Mozilla" (:title moz)))
(is (<= earliest (:starredOn moz) (instant (now)))))))
(deftest-db test-simple-sessions conn
(<? (d/<transact! conn tofino-schema))
;; Start a session.
(let [session (<? (<start-session conn {:ancestor nil :scope "foo"}))]
(is (integer? session))
;; Now it's active.
(let [active (<? (<active-sessions (d/db conn)))]
(is (= 1 (count active)))
(is (= (first (first active))
session)))
;; There are no ended sessions yet.
(is (empty? (<? (<ended-sessions (d/db conn)))))
(let [earliest (instant (now))]
(<? (<add-visit conn {:uri "http://example.org/"
:title "Example Philanthropy Old"
:session session}))
(<? (<add-visit conn {:uri "http://example.com/"
:title "Example Commercial"
:session session}))
(<? (<add-visit conn {:uri "http://example.org/"
:title "Example Philanthropy New"
:session session}))
(let [latest (instant (now))
visited (<? (<visited (d/db conn) {:limit 3}))]
(is (= 2 (count visited)))
(is (= "http://example.org/" (:uri (first visited))))
(is (= "http://example.com/" (:uri (second visited))))
(is (<= earliest (:lastVisited (first visited)) latest))
(is (<= earliest (:lastVisited (second visited)) latest))
(is (>= (:lastVisited (first visited)) (:lastVisited (second visited))))))
(is (= "Example Philanthropy New"
(<? (<find-title (d/db conn) "http://example.org/"))))
;; Add a page with no title.
(<? (<add-visit conn {:uri "http://notitle.example.org/"
:session session}))
(is (nil? (<? (<find-title (d/db conn) "http://notitle.example.org/"))))
(let [only-one (<? (<visited (d/db conn) {:limit 1}))]
(is (= 1 (count only-one)))
(is (= (select-keys (first only-one)
[:uri :title])
{:uri "http://notitle.example.org/"
:title ""})))
;; If we end this one, then it's no longer active but is ended.
(<? (<end-session conn {:session session}))
(is (empty? (<? (<active-sessions (d/db conn)))))
(is (= 1 (count (<? (<ended-sessions (d/db conn))))))))
(deftest-db test-saved-pages conn
(<? (d/<transact! conn tofino-schema))
;; Start a session.
(let [session (<? (<start-session conn {:ancestor nil :scope "foo"}))]
(<? (<save-page conn {:uri "http://example.com/apples/1"
:title "A page about apples."
:session session
:excerpt "This page tells you things about apples."
:content "<html><head><title>A page about apples.</title></head><body><p>Fruit content goes here.</p></body></html>"}))
(<? (<save-page conn {:uri "http://example.com/apricots/1"
:title "A page about apricots."
:session session
:excerpt nil
:content "<html><head><title>A page about apricots.</title></head><body><p>Fruit content goes here.</p></body></html>"}))
(<? (<save-page conn {:uri "http://example.com/bananas/2"
:title "A page about bananas"
:session session
:excerpt nil
:content nil}))
(let [db (d/db conn)]
;; Fetch all.
(let [all (sort-by first (<? (<saved-pages db)))]
(is (= 3 (count all)))
(let [[[apple-id apple-url apple-title apple-excerpt]
[apricot-id apricot-url apricot-title apricot-excerpt]
[banana-id banana-url banana-title banana-excerpt]]
all]
(is (= apple-url "http://example.com/apples/1"))
(is (= apple-title "A page about apples."))
(is (= apple-excerpt "This page tells you things about apples."))
(is (= apricot-url "http://example.com/apricots/1"))
(is (= apricot-title "A page about apricots."))
(is (= apricot-excerpt ""))
(is (= banana-url "http://example.com/bananas/2"))
(is (= banana-title "A page about bananas"))
(is (= banana-excerpt ""))))
;; Match against title.
(let [this-page (sort-by first (<? (<saved-pages-matching-string db "about apricots")))]
(is (= 1 (count this-page)))
(let [[[apricot-id apricot-url apricot-title apricot-excerpt]]
this-page]
(is (= apricot-url "http://example.com/apricots/1"))
(is (= apricot-title "A page about apricots."))
(is (= apricot-excerpt ""))))
;; Match against excerpt.
(let [this-page (sort-by first (<? (<saved-pages-matching-string db "This page")))]
(is (= 1 (count this-page)))
(let [[[apple-id apple-url apple-title apple-excerpt]]
this-page]
(is (= apple-url "http://example.com/apples/1"))
(is (= apple-title "A page about apples."))
(is (= apple-excerpt "This page tells you things about apples."))))
;; Match against content.
(let [fruit-content (sort-by first (<? (<saved-pages-matching-string db "Fruit content")))]
(is (= 2 (count fruit-content)))
(let [[[apple-id apple-url apple-title apple-excerpt]
[apricot-id apricot-url apricot-title apricot-excerpt]]
fruit-content]
(is (= apple-url "http://example.com/apples/1"))
(is (= apple-title "A page about apples."))
(is (= apple-excerpt "This page tells you things about apples."))
(is (= apricot-url "http://example.com/apricots/1"))
(is (= apricot-title "A page about apricots."))
(is (= apricot-excerpt "")))))))
(deftest-db test-fulltext-set-attribute conn
(<? (d/<transact! conn tofino-schema))
(<? (d/<transact! conn
[{:db/id 999
:save/title "Whenever you want something"}
{:db/id 998
:save/excerpt "If there is something…"}
{:db/id 997
:save/unindexed "What something means…"}
{:db/id 996
:save/title "This is anything but."}
{:db/id 995
:save/content "There's something here that would match."}]))
(let [results
(<?
(d/<q (d/db conn)
[:find '[?save ...]
:in '$
:where [(list 'fulltext '$ #{:save/title :save/excerpt} "something")
'[[?save]]]]))]
(is (= (set results)
#{999 998}))))

287
test/datomish/transact_test.cljc
View file

@ -1,287 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
(ns datomish.transact-test
#?(:cljs
(:require-macros
[datomish.pair-chan :refer [go-pair <?]]
[datomish.node-tempfile-macros :refer [with-tempfile]]
[cljs.core.async.macros :as a :refer [go go-loop]]))
(:require
[datomish.api :as d]
[datomish.db.debug :refer [<datoms-after <datoms>= <transactions-after <shallow-entity <fulltext-values]]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
[datomish.schema :as ds]
[datomish.simple-schema]
[datomish.sqlite :as s]
[datomish.sqlite-schema]
[datomish.datom]
#?@(:clj [[datomish.jdbc-sqlite]
[datomish.pair-chan :refer [go-pair <?]]
[tempfile.core :refer [tempfile with-tempfile]]
[datomish.test-macros :refer [deftest-async deftest-db]]
[clojure.test :as t :refer [is are deftest testing]]
[clojure.core.async :as a :refer [go go-loop <! >!]]])
#?@(:cljs [[datomish.js-sqlite]
[datomish.pair-chan]
[datomish.test-macros :refer-macros [deftest-async deftest-db]]
[datomish.node-tempfile :refer [tempfile]]
[cljs.test :as t :refer-macros [is are deftest testing async]]
[cljs.core.async :as a :refer [<! >!]]]))
#?(:clj
(:import [clojure.lang ExceptionInfo]))
#?(:clj
(:import [datascript.db DB])))
#?(:cljs
(def Throwable js/Error))
(defn- tempids [tx]
(into {} (map (juxt (comp :idx first) second) (:tempids tx))))
(def test-schema
[{:db/id (d/id-literal :db.part/user)
:db/ident :x
:db/unique :db.unique/identity
:db/valueType :db.type/long
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :name
:db/unique :db.unique/identity
:db/valueType :db.type/string
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :y
:db/cardinality :db.cardinality/many
:db/valueType :db.type/long
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :aka
:db/cardinality :db.cardinality/many
:db/valueType :db.type/string
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :age
:db/valueType :db.type/long
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :email
:db/unique :db.unique/identity
:db/valueType :db.type/string
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :spouse
:db/unique :db.unique/value
:db/valueType :db.type/string
:db.install/_attribute :db.part/db}
{:db/id (d/id-literal :db.part/user)
:db/ident :friends
:db/cardinality :db.cardinality/many
:db/valueType :db.type/ref
:db.install/_attribute :db.part/db}
])
(deftest-db test-overlapping-transacts conn
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))
report0 (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1)
:name "Petr"}]))
id0 (get (tempids report0) -1)
n 5
make-t (fn [i]
;; Be aware that a go block with a parking operation here
;; can change the order of transaction evaluation, since the
;; parking operation will be unparked non-deterministically.
(d/<transact! conn [{:db/id (d/id-literal :db.part/user -1)
:name "Petr"
:email (str "@" i)}]))]
;; Wait for all transactions to complete.
(<! (a/into []
(a/merge ;; pair-chan's never stop providing values; use take to force close.
(map #(a/take 1 (make-t %)) (range n)))))
;; Transactions should be processed in order. This is an awkward way to
;; express the expected data, but it's robust in the face of changing default
;; identities, transaction numbers, and values of n.
(is (= (concat [[id0 :name "Petr" (+ 1 tx0) 1]
[id0 :email "@0" (+ 2 tx0) 1]]
(mapcat
#(-> [[id0 :email (str "@" %) (+ 3 % tx0) 0]
[id0 :email (str "@" (inc %)) (+ 3 % tx0) 1]])
(range 0 (dec n))))
(filter #(not= :db/txInstant (second %)) (<? (<transactions-after (d/db conn) tx0)))))))
(deftest-db test-listeners conn
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))
c1 (a/chan (a/dropping-buffer 5))
c2 (a/chan (a/dropping-buffer 5))]
(testing "no listeners is okay"
;; So that we can upsert to concrete entids.
(<? (d/<transact! conn [[:db/add 101 :name "Ivan"]
[:db/add 102 :name "Petr"]])))
(testing "listeners are added, not accidentally notified of events before they were added"
(d/listen-chan! conn c1)
(d/listen-chan! conn c2)
;; This is not authoritative, because in an error situation a report may
;; be put! to a listener tap outside the expected flow. We should witness
;; such an occurrence later in the test.
(is (= nil (a/poll! c1)))
(is (= nil (a/poll! c2))))
(testing "unlistening to unrecognized key is ignored"
(d/unlisten-chan! conn (a/chan)))
(testing "listeners observe reports"
(<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :name "Ivan"]]))
(is (= {-1 101}
(tempids (<! c1))))
(is (= {-1 101}
(tempids (<! c2))))
;; Again, not authoritative.
(is (= nil (a/poll! c1)))
(is (= nil (a/poll! c2))))
(testing "unlisten removes correct listener"
(d/unlisten-chan! conn c1)
(<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -2) :name "Petr"]]))
(is (= {-2 102}
(tempids (<! c2))))
;; Again, not authoritative.
(is (= nil (a/poll! c1))))
(testing "returning to no listeners is okay"
(d/unlisten-chan! conn c2)
(<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :name "Petr"]]))
;; Again, not authoritative.
(is (= nil (a/poll! c1)))
(is (= nil (a/poll! c2)))
;; This should be authoritative, however. We should be able to put! due
;; to the size of the buffer, and we should take! what we put!.
(>! c1 :token-1)
(is (= :token-1 (<! c1)))
(>! c2 :token-1)
(is (= :token-1 (<! c2))))
(testing "complains about blocking channels"
(is (thrown-with-msg?
ExceptionInfo #"unblocking buffers"
(d/listen-chan! conn (a/chan 1)))))
))
(deftest-db test-transact-in-listener conn
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))
;; So that we can see all transactions.
lc (a/chan (a/dropping-buffer 5))
;; A oneshot listener, to prevent infinite recursion.
ofl (atom false)
ol (fn [report]
(when (compare-and-set! ofl false true)
;; Asynchronously throw another transaction at the wall. This
;; upserts to the earlier one.
(d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :email "@1"}])))
]
(testing "that we can invoke <transact! from within a listener"
(d/listen-chan! conn lc)
(d/listen! conn ol)
;; Transact once to get started, and so that we can upsert against concrete ids.
(<? (d/<transact! conn [{:db/id 101 :name "Ivan"}]))
(is (= (+ 1 tx0) (:tx (<! lc))))
;; The listener should have kicked off another transaction, but we can't
;; wait for it explicitly. However, we can wait for the report to hit the
;; listening channel.
(let [r (<! lc)]
(is (= (+ 2 tx0) (:tx r)))
(is (= {-1 101}
(tempids r)))
(is (= nil (a/poll! lc)))))))
(deftest-db test-failing-transacts conn
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))]
(testing "failing transact throws"
(is (thrown-with-msg?
ExceptionInfo #"expected :db.type/string"
(<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name 1}])))))
(testing "transaction after bad transaction is applied"
(<? (d/<transact! conn [{:db/id 101 :name "Petr"}]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :name "Petr"]})))))
;; We don't use deftest-db in order to be able to close the connection ourselves.
(deftest-async test-transact-after-close
(with-tempfile [t (tempfile)]
(let [conn (<? (d/<connect t))
{tx0 :tx} (<? (d/<transact! conn test-schema))]
(try
(testing "transaction before close is applied"
(<? (d/<transact! conn [{:db/id 101 :name "Petr"}]))
(is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :name "Petr"]})))
(finally
(<? (d/<close conn))))
(testing "transact after close throws"
(is (thrown-with-msg?
ExceptionInfo #"Connection is closed"
(<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Petr"}])))))
;; Closing a closed connection is a no-op.
(<? (d/<close conn)))))
;; We don't use deftest-db in order to be able to close the connection ourselves.
(deftest-async test-transact-queued-before-close
(with-tempfile [t (tempfile)]
(let [conn (<? (d/<connect t))
{tx0 :tx} (<? (d/<transact! conn test-schema))
n 100
make-t (fn [i]
(d/<transact! conn [{:db/id (d/id-literal :db.part/user -1)
:name "Petr"
:email (str "@" i)}]))]
(try
(testing "close while outstanding transactions are pending"
;; It's not really possible to ensure that at least one of the transactions is not
;; serviced before we close, so we just start "a lot" and wait for them all to resolve.
(let [ts (mapv make-t (range n))]
;; Give a little time for some to succeed, and then wait for one, non-deterministically.
(<! (a/timeout 10))
(a/alts! ts)
(<? (d/<close conn))
;; We should have some successes and some failures.
(let [ps (a/into []
(a/merge ;; pair-chan's never stop providing values; use take to force close.
(map (partial a/take 1) ts)))
rs (group-by (comp some? second) (<! ps))
xs (get rs false)
es (get rs true)
[v e] (first es)]
(is (> (count xs) 0))
(is (> (count es) 0))
(is (= {:error :transact/connection-closed} (ex-data e))))))
(finally
;; Closing a closed connection is a no-op.
(<? (d/<close conn)))))))
#_ (time (t/run-tests))

60
test/datomish/upgrade_test.clj
View file

@ -1,60 +0,0 @@
;; Copyright 2016 Mozilla
;;
;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use
;; this file except in compliance with the License. You may obtain a copy of the
;; License at http://www.apache.org/licenses/LICENSE-2.0
;; Unless required by applicable law or agreed to in writing, software distributed
;; under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
;; CONDITIONS OF ANY KIND, either express or implied. See the License for the
;; specific language governing permissions and limitations under the License.
(ns datomish.upgrade-test
(:require
[clojure.java.io :refer [copy]]
[datomish.jdbc-sqlite :as jdbc]
[datomish.sqlite :as s]
[datomish.api :as d]
[datomish.test-macros :refer [deftest-async]]
[datomish.pair-chan :refer [go-pair <?]]
[clojure.test :as t :refer [is are deftest testing]]))
(deftest-async test-upgrade-v1-connect
;; Copy our test DB to a temporary directory.
;; Open it with Datomish. Make sure nothing untoward happened.
(let [out (java.io.File/createTempFile "someprefixstringv1" "db")]
(copy (java.io.File. "test/v1.db") out)
(let [path (.getAbsolutePath out)
conn (<? (d/<connect path))]
(is (= (d/entid (d/db conn) :db.schema/version) 36))
(d/<close conn))))
(deftest-async test-upgrade-v1
;; Copy our test DB to a temporary directory.
;;
;; Open it with SQLite. Verify that v2 features are not present, and the
;; user_version is 1.
;;
;; Open it with Datomish. Verify that bootstrapped v2 features are present,
;; and the user_version is 2.
(let [out (java.io.File/createTempFile "someprefixstringv1" "db")]
(copy (java.io.File. "test/v1.db") out)
(let [path (.getAbsolutePath out)
sqlite (<? (jdbc/open path))]
(is (= (<? (s/get-user-version sqlite))
1))
(is (= [{:idx 36}]
(<? (s/all-rows sqlite ["SELECT idx FROM parts WHERE part = ':db.part/db'"]))))
(is (empty? (<? (s/all-rows sqlite ["SELECT * FROM idents WHERE ident = ':db.schema/version'"]))))
;; This will automatically upgrade.
(let [db (<? (datomish.db-factory/<db-with-sqlite-connection sqlite))]
(is (= 2 (<? (s/get-user-version sqlite))))
(is (= [{:idx 38}]
(<? (s/all-rows sqlite ["SELECT idx FROM parts WHERE part = ':db.part/db'"]))))
(is (= [{:entid 36}]
(<? (s/all-rows sqlite ["SELECT entid FROM idents WHERE ident = ':db.schema/version'"]))))
(is (= (d/entid db :db.schema/version) 36))
(s/close sqlite)))))

68
test/datomish/util_test.cljc
View file

@ -1,68 +0,0 @@
(ns datomish.util-test
#?(:cljs
(:require-macros
[cljs.core.async.macros :as a :refer [go go-loop]]))
(:require
[datomish.util :as util]
#?@(:clj [[clojure.test :as t :refer [is are deftest testing]]
[clojure.core.async :as a :refer [go go-loop <! >!]]])
#?@(:cljs [[cljs.test :as t :refer-macros [is are deftest testing]]
[cljs.core.async :as a :refer [<! >!]]])))
(deftest test-var-translation
(is (= :x (util/var->sql-var '?x)))
(is (= :XX (util/var->sql-var '?XX))))
#?(:cljs
(deftest test-integer?-js
(is (integer? 0))
(is (integer? 5))
(is (integer? 50000000000))
(is (integer? 5.00)) ; Because JS.
(is (not (integer? 5.1)))))
#?(:clj
(deftest test-integer?-clj
(is (integer? 0))
(is (integer? 5))
(is (integer? 50000000000))
(is (not (integer? 5.00)))
(is (not (integer? 5.1)))))
#?(:cljs
(deftest test-raise
(let [caught
(try
(do
(util/raise "succeed" {:foo 1})
"fail")
(catch :default e e))]
(is (= "succeed" (aget caught "message")))
(is (= {:foo 1} (aget caught "data"))))))
(deftest test-unblocking-chan?
(is (util/unblocking-chan? (a/chan (a/dropping-buffer 10))))
(is (util/unblocking-chan? (a/chan (a/sliding-buffer 10))))
(is (util/unblocking-chan? (a/chan (util/unlimited-buffer))))
(is (not (util/unblocking-chan? (a/chan (a/buffer 10))))))
(deftest test-group-by-kvs
(are [m xs] (= m (util/group-by-kv identity xs))
{:a [1 2] :b [3]}
[[:a 1] [:a 2] [:b 3]]))
(deftest test-repeated-keys
(let [abc {:a 1 :b 2 :c 3}
def {:d 1 :e 2 :f 3}
bcd {:b 1 :c 2 :d 3}
efg {:e 1 :f 2 :g 3}
empty {}]
(is (= #{} (util/repeated-keys [])))
(is (= #{} (util/repeated-keys [empty])))
(is (= #{} (util/repeated-keys [empty empty])))
(is (= #{} (util/repeated-keys [abc empty empty])))
(is (= #{} (util/repeated-keys [abc def empty])))
(is (= #{:b :c} (util/repeated-keys [bcd abc])))
(is (= #{:b :c :d} (util/repeated-keys [abc def bcd])))
(is (= #{:b :c :d :e :f :g} (util/repeated-keys [abc efg def efg bcd])))))