Compare commits
9 commits
master
...
rnewman/ne
Author | SHA1 | Date | |
---|---|---|---|
![]() |
3a4b687921 | ||
![]() |
513f23c45c | ||
![]() |
96caadb189 | ||
![]() |
ae0dac2817 | ||
![]() |
fbd8c0bfbb | ||
![]() |
6b4f3cb396 | ||
![]() |
cddd72e283 | ||
![]() |
345cd9a023 | ||
![]() |
e4f29ea10b |
15 changed files with 1027 additions and 276 deletions
256
src/datomish/clauses.cljc
Normal file
256
src/datomish/clauses.cljc
Normal file
|
@ -0,0 +1,256 @@
|
||||||
|
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||||
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||||
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||||
|
|
||||||
|
(ns datomish.clauses
|
||||||
|
(:require
|
||||||
|
[datomish.source
|
||||||
|
:refer [attribute-in-source
|
||||||
|
constant-in-source
|
||||||
|
source->from
|
||||||
|
source->constraints]]
|
||||||
|
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise-str cond-let]]
|
||||||
|
[datascript.parser :as dp
|
||||||
|
#?@(:cljs
|
||||||
|
[:refer
|
||||||
|
[PlainSymbol Predicate Not Pattern DefaultSrc Variable Constant Placeholder]])]
|
||||||
|
[honeysql.core :as sql]
|
||||||
|
[clojure.string :as str]
|
||||||
|
)
|
||||||
|
#?(:clj
|
||||||
|
(:import
|
||||||
|
[datascript.parser
|
||||||
|
PlainSymbol Predicate Not Pattern DefaultSrc Variable Constant Placeholder])))
|
||||||
|
|
||||||
|
;; A CC is a collection of clauses that are combined with JOIN.
|
||||||
|
;; The topmost form in a query is a ConjoiningClauses.
|
||||||
|
;;
|
||||||
|
;; Ordinary pattern clauses turn into FROM parts and WHERE parts using :=.
|
||||||
|
;; Predicate clauses turn into the same, but with other functions.
|
||||||
|
;; Function clauses with bindings turn into:
|
||||||
|
;; * Subqueries. Perhaps less efficient? Certainly clearer.
|
||||||
|
;; * Projection expressions, if only used for output.
|
||||||
|
;; * Inline expressions?
|
||||||
|
;; `not` turns into NOT EXISTS with WHERE clauses inside the subquery to
|
||||||
|
;; bind it to the outer variables, or adds simple WHERE clauses to the outer
|
||||||
|
;; clause.
|
||||||
|
;; `not-join` is similar, but with explicit binding.
|
||||||
|
;; `or` turns into a collection of UNIONs inside a subquery.
|
||||||
|
;; `or`'s documentation states that all clauses must include the same vars,
|
||||||
|
;; but that's an over-simplification: all clauses must refer to the external
|
||||||
|
;; unification vars.
|
||||||
|
;; The entire UNION-set is JOINed to any surrounding expressions per the `rule-vars`
|
||||||
|
;; clause, or the intersection of the vars in the two sides of the JOIN.
|
||||||
|
|
||||||
|
;; `from` is a list of [source alias] pairs, suitable for passing to honeysql.
|
||||||
|
;; `bindings` is a map from var to qualified columns.
|
||||||
|
;; `wheres` is a list of fragments that can be joined by `:and`.
|
||||||
|
(defrecord ConjoiningClauses [source from external-bindings bindings wheres])
|
||||||
|
|
||||||
|
(defn bind-column-to-var [cc variable col]
|
||||||
|
(let [var (:symbol variable)]
|
||||||
|
(util/conj-in cc [:bindings var] col)))
|
||||||
|
|
||||||
|
(defn constrain-column-to-constant [cc col position value]
|
||||||
|
(util/conj-in cc [:wheres]
|
||||||
|
[:= col (if (= :a position)
|
||||||
|
(attribute-in-source (:source cc) value)
|
||||||
|
(constant-in-source (:source cc) value))]))
|
||||||
|
|
||||||
|
(defn- bindings->where
|
||||||
|
"Take a bindings map like
|
||||||
|
{?foo [:datoms12.e :datoms13.v :datoms14.e]}
|
||||||
|
and produce a list of constraints expression like
|
||||||
|
[[:= :datoms12.e :datoms13.v] [:= :datoms12.e :datoms14.e]]
|
||||||
|
|
||||||
|
TODO: experiment; it might be the case that producing more
|
||||||
|
pairwise equalities we get better or worse performance."
|
||||||
|
[bindings]
|
||||||
|
(mapcat (fn [[_ vs]]
|
||||||
|
(when (> (count vs) 1)
|
||||||
|
(let [root (first vs)]
|
||||||
|
(map (fn [v] [:= root v]) (rest vs)))))
|
||||||
|
bindings))
|
||||||
|
|
||||||
|
;; This is so we can link clauses to the outside world.
|
||||||
|
(defn impose-external-bindings [cc]
|
||||||
|
(if (empty? (:external-bindings cc))
|
||||||
|
cc
|
||||||
|
(let [ours (:bindings cc)
|
||||||
|
theirs (:external-bindings cc)
|
||||||
|
vars (clojure.set/intersection (set (keys theirs)) (set (keys ours)))]
|
||||||
|
(util/concat-in
|
||||||
|
cc [:wheres]
|
||||||
|
(map
|
||||||
|
(fn [v]
|
||||||
|
(let [external (first (v theirs))
|
||||||
|
internal (first (v ours))]
|
||||||
|
(assert external)
|
||||||
|
(assert internal)
|
||||||
|
[:= external internal]))
|
||||||
|
vars)))))
|
||||||
|
|
||||||
|
(defn expand-where-from-bindings
|
||||||
|
"Take the bindings in the CC and contribute
|
||||||
|
additional where clauses. Calling this more than
|
||||||
|
once will result in duplicate clauses."
|
||||||
|
[cc]
|
||||||
|
(impose-external-bindings
|
||||||
|
(assoc cc :wheres (concat (bindings->where (:bindings cc))
|
||||||
|
(:wheres cc)))))
|
||||||
|
|
||||||
|
;; Pattern building is recursive, so we need forward declarations.
|
||||||
|
(declare Not->NotJoinClause not-join->where-fragment)
|
||||||
|
|
||||||
|
;; Accumulates a pattern into the CC. Returns a new CC.
|
||||||
|
(defn apply-pattern-clause
|
||||||
|
"Transform a DataScript Pattern instance into the parts needed
|
||||||
|
to build a SQL expression.
|
||||||
|
|
||||||
|
@arg cc A CC instance.
|
||||||
|
@arg pattern The pattern instance.
|
||||||
|
@return an augmented CC"
|
||||||
|
[cc pattern]
|
||||||
|
(when-not (instance? Pattern pattern)
|
||||||
|
(raise-str "Expected to be called with a Pattern instance." pattern))
|
||||||
|
(when-not (instance? DefaultSrc (:source pattern))
|
||||||
|
(raise-str "Non-default sources are not supported in patterns. Pattern: " pattern))
|
||||||
|
|
||||||
|
(let [[table alias] (source->from (:source cc)) ; e.g., [:datoms :datoms123]
|
||||||
|
places (map (fn [place col] [place col])
|
||||||
|
(:pattern pattern)
|
||||||
|
(:columns (:source cc)))]
|
||||||
|
(reduce
|
||||||
|
(fn [cc
|
||||||
|
[pattern-part ; ?x, :foo/bar, 42
|
||||||
|
position]] ; :a
|
||||||
|
(let [col (sql/qualify alias (name position))] ; :datoms123.a
|
||||||
|
(condp instance? pattern-part
|
||||||
|
;; Placeholders don't contribute any bindings, nor do
|
||||||
|
;; they constrain the query -- there's no need to produce
|
||||||
|
;; IS NOT NULL, because we don't store nulls in our schema.
|
||||||
|
Placeholder
|
||||||
|
cc
|
||||||
|
|
||||||
|
Variable
|
||||||
|
(bind-column-to-var cc pattern-part col)
|
||||||
|
|
||||||
|
Constant
|
||||||
|
(constrain-column-to-constant cc col position (:value pattern-part))
|
||||||
|
|
||||||
|
(raise-str "Unknown pattern part " pattern-part))))
|
||||||
|
|
||||||
|
;; Record the new table mapping.
|
||||||
|
(util/conj-in cc [:from] [table alias])
|
||||||
|
|
||||||
|
places)))
|
||||||
|
|
||||||
|
(defn- plain-symbol->sql-predicate-symbol [fn]
|
||||||
|
(when-not (instance? PlainSymbol fn)
|
||||||
|
(raise-str "Predicate functions must be named by plain symbols." fn))
|
||||||
|
(#{:> :< :=} (keyword (name (:symbol fn)))))
|
||||||
|
|
||||||
|
(defn apply-predicate-clause [cc predicate]
|
||||||
|
(when-not (instance? Predicate predicate)
|
||||||
|
(raise-str "Expected to be called with a Predicate instance." predicate))
|
||||||
|
(let [f (plain-symbol->sql-predicate-symbol (:fn predicate))]
|
||||||
|
(when-not f
|
||||||
|
(raise-str "Unknown function " (:fn predicate)))
|
||||||
|
|
||||||
|
(let [args (map
|
||||||
|
(fn [arg]
|
||||||
|
(condp instance? arg
|
||||||
|
Placeholder
|
||||||
|
(raise-str "Can't use a placeholder in a predicate.")
|
||||||
|
|
||||||
|
Variable
|
||||||
|
(let [v (:symbol arg)
|
||||||
|
internal-bindings (v (:bindings cc))
|
||||||
|
external-bindings (v (:external-bindings cc))]
|
||||||
|
(or (first internal-bindings)
|
||||||
|
(first external-bindings)
|
||||||
|
(raise-str "No bindings yet for " v)))
|
||||||
|
|
||||||
|
Constant
|
||||||
|
(constant-in-source (:source cc) (:value arg))
|
||||||
|
|
||||||
|
(raise-str "Unknown predicate argument " arg)))
|
||||||
|
|
||||||
|
(:args predicate))]
|
||||||
|
(util/conj-in cc [:wheres] (cons f args)))))
|
||||||
|
|
||||||
|
(defn apply-not-clause [cc not]
|
||||||
|
(when-not (instance? Not not)
|
||||||
|
(raise-str "Expected to be called with a Not instance." not))
|
||||||
|
(when-not (instance? DefaultSrc (:source not))
|
||||||
|
(raise-str "Non-default sources are not supported in patterns. Pattern: " not))
|
||||||
|
|
||||||
|
;; If our bindings are already available, great -- emit a :wheres
|
||||||
|
;; fragment, and include the external bindings so that they match up.
|
||||||
|
;; Otherwise, we need to delay. Right now we're lazy, so we just fail:
|
||||||
|
;; reorder your query yourself.
|
||||||
|
(util/conj-in cc [:wheres]
|
||||||
|
(not-join->where-fragment
|
||||||
|
(Not->NotJoinClause (:source cc)
|
||||||
|
(merge-with concat
|
||||||
|
(:external-bindings cc)
|
||||||
|
(:bindings cc))
|
||||||
|
not))))
|
||||||
|
|
||||||
|
;; We're keeping this simple for now: a straightforward type switch.
|
||||||
|
(defn apply-clause [cc it]
|
||||||
|
(if (instance? Not it)
|
||||||
|
(apply-not-clause cc it)
|
||||||
|
(if (instance? Predicate it)
|
||||||
|
(apply-predicate-clause cc it)
|
||||||
|
(apply-pattern-clause cc it))))
|
||||||
|
|
||||||
|
(defn expand-pattern-clauses
|
||||||
|
"Reduce a sequence of patterns into a CC."
|
||||||
|
[cc patterns]
|
||||||
|
(reduce apply-clause cc patterns))
|
||||||
|
|
||||||
|
(defn patterns->cc [source patterns external-bindings]
|
||||||
|
(expand-where-from-bindings
|
||||||
|
(expand-pattern-clauses
|
||||||
|
(->ConjoiningClauses source [] (or external-bindings {}) {} [])
|
||||||
|
patterns)))
|
||||||
|
|
||||||
|
(defn cc->partial-subquery
|
||||||
|
"Build part of a honeysql query map from a CC: the `:from` and `:where` parts.
|
||||||
|
This allows for reuse both in top-level query generation and also for
|
||||||
|
subqueries and NOT EXISTS clauses."
|
||||||
|
[cc]
|
||||||
|
(merge
|
||||||
|
{:from (:from cc)}
|
||||||
|
(when-not (empty? (:wheres cc))
|
||||||
|
{:where (cons :and (:wheres cc))})))
|
||||||
|
|
||||||
|
|
||||||
|
;; A `not-join` clause is a filter. It takes bindings from the enclosing query
|
||||||
|
;; and runs as a subquery with `NOT EXISTS`.
|
||||||
|
;; The only difference between `not` and `not-join` is that `not` computes
|
||||||
|
;; its varlist by recursively walking the provided patterns.
|
||||||
|
;; DataScript's parser does variable extraction for us, and also verifies
|
||||||
|
;; that a declared variable list is valid for the clauses given.
|
||||||
|
(defrecord NotJoinClause [unify-vars cc])
|
||||||
|
|
||||||
|
(defn make-not-join-clause [source external-bindings unify-vars patterns]
|
||||||
|
(->NotJoinClause unify-vars (patterns->cc source patterns external-bindings)))
|
||||||
|
|
||||||
|
(defn Not->NotJoinClause [source external-bindings not]
|
||||||
|
(when-not (instance? DefaultSrc (:source not))
|
||||||
|
(raise-str "Non-default sources are not supported in patterns. Pattern: "
|
||||||
|
not))
|
||||||
|
(make-not-join-clause source external-bindings (:vars not) (:clauses not)))
|
||||||
|
|
||||||
|
(defn not-join->where-fragment [not-join]
|
||||||
|
[:not
|
||||||
|
(if (empty? (:bindings (:cc not-join)))
|
||||||
|
;; If the `not` doesn't establish any bindings, it means it only contains
|
||||||
|
;; expressions that constrain variables established outside itself.
|
||||||
|
;; We can just return an expression.
|
||||||
|
(cons :and (:wheres (:cc not-join)))
|
||||||
|
|
||||||
|
;; If it does establish bindings, then it has to be a subquery.
|
||||||
|
[:exists (merge {:select [1]} (cc->partial-subquery (:cc not-join)))])])
|
9
src/datomish/context.cljc
Normal file
9
src/datomish/context.cljc
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||||
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||||
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||||
|
|
||||||
|
;; A context, very simply, holds on to a default source. Eventually
|
||||||
|
;; it'll also do projection and similar transforms.
|
||||||
|
(ns datomish.context)
|
||||||
|
|
||||||
|
(defrecord Context [default-source elements cc])
|
|
@ -8,25 +8,139 @@
|
||||||
[datomish.pair-chan :refer [go-pair <?]]
|
[datomish.pair-chan :refer [go-pair <?]]
|
||||||
[cljs.core.async.macros :refer [go]]))
|
[cljs.core.async.macros :refer [go]]))
|
||||||
(:require
|
(:require
|
||||||
[datomish.util :as util :refer [raise]]
|
[datomish.context :as context]
|
||||||
|
[datomish.projection :as projection]
|
||||||
|
[datomish.query :as query]
|
||||||
|
[datomish.source :as source]
|
||||||
[datomish.sqlite :as s]
|
[datomish.sqlite :as s]
|
||||||
[datomish.sqlite-schema :as sqlite-schema]
|
[datomish.sqlite-schema :as sqlite-schema]
|
||||||
|
[datomish.util :as util :refer [raise raise-str]]
|
||||||
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
|
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
|
||||||
[clojure.core.async :as a :refer [go <! >!]]])
|
[clojure.core.async :as a :refer [chan go <! >!]]])
|
||||||
#?@(:cljs [[datomish.pair-chan]
|
#?@(:cljs [[datomish.pair-chan]
|
||||||
[cljs.core.async :as a :refer [<! >!]]])))
|
[cljs.core.async :as a :refer [chan <! >!]]])))
|
||||||
|
|
||||||
(defprotocol IDB
|
(defprotocol IDB
|
||||||
|
(idents
|
||||||
|
[db]
|
||||||
|
"Return map {ident -> entid} if known idents. See http://docs.datomic.com/identity.html#idents.")
|
||||||
|
|
||||||
|
(query-context
|
||||||
|
[db])
|
||||||
|
|
||||||
(close
|
(close
|
||||||
[db]
|
[db]
|
||||||
"Close this database. Returns a pair channel of [nil error]."))
|
"Close this database. Returns a pair channel of [nil error]."))
|
||||||
|
|
||||||
(defrecord DB [sqlite-connection]
|
(defn db? [x]
|
||||||
|
(and (satisfies? IDB x)))
|
||||||
|
|
||||||
|
;; TODO: implement support for DB parts?
|
||||||
|
(def tx0 0x2000000)
|
||||||
|
|
||||||
|
;; TODO: write tx-meta to transaction.
|
||||||
|
(defrecord TxReport [tx-data tempids tx-meta])
|
||||||
|
|
||||||
|
;; TODO: persist max-tx and max-eid in SQLite.
|
||||||
|
(defn <allocate-tx [db]
|
||||||
|
(go-pair
|
||||||
|
(swap! (:current-tx db) inc)))
|
||||||
|
|
||||||
|
;; TODO: add fancy destructuring.
|
||||||
|
;; TODO: handle reading.
|
||||||
|
(deftype Datom [e a v tx added])
|
||||||
|
|
||||||
|
(defn datom? [x] (instance? Datom x))
|
||||||
|
|
||||||
|
(defrecord DB [sqlite-connection idents max-tx]
|
||||||
IDB
|
IDB
|
||||||
(close [db] (close (.-sqlite-connection db))))
|
(idents [db] @(:idents db))
|
||||||
|
(query-context [db] (context/->Context (source/datoms-source db) nil nil))
|
||||||
|
(close [db] (s/close (.-sqlite-connection db))))
|
||||||
|
|
||||||
(defn <with-sqlite-connection [sqlite-connection]
|
(defn <with-sqlite-connection [sqlite-connection]
|
||||||
(go-pair
|
(go-pair
|
||||||
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
|
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
|
||||||
(raise "Could not ensure current SQLite schema version."))
|
(raise-str "Could not ensure current SQLite schema version."))
|
||||||
(->DB sqlite-connection)))
|
(map->DB {:sqlite-connection sqlite-connection
|
||||||
|
:idents (atom {:db/txInstant 100 :x 101 :y 102}) ;; TODO: pre-populate idents and SQLite tables?
|
||||||
|
:current-tx (atom (dec tx0))}))) ;; TODO: get rid of dec.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
#?(:clj
|
||||||
|
(defmethod print-method Datom [^Datom d, ^java.io.Writer w]
|
||||||
|
(.write w (str "#datomish/Datom "))
|
||||||
|
(binding [*out* w]
|
||||||
|
(pr [(.-e d) (.-a d) (.-v d) (.-tx d) (.-added d)]))))
|
||||||
|
|
||||||
|
;; TODO: implement schemas.
|
||||||
|
(defn multival? [db attr] false)
|
||||||
|
|
||||||
|
;; TODO: implement schemas.
|
||||||
|
(defn ref? [db attr] false)
|
||||||
|
|
||||||
|
(defn <entid [db eid]
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(cond
|
||||||
|
(number? eid)
|
||||||
|
eid
|
||||||
|
|
||||||
|
(keyword? eid)
|
||||||
|
;; Turn ident into entid if possible.
|
||||||
|
(get (idents db) eid eid)
|
||||||
|
|
||||||
|
(sequential? eid)
|
||||||
|
(raise "Lookup ref for entity id not yet supported, got " eid
|
||||||
|
{:error :entity-id/syntax
|
||||||
|
:entity-id eid})
|
||||||
|
|
||||||
|
:else
|
||||||
|
(raise "Expected number or lookup ref for entity id, got " eid
|
||||||
|
{:error :entity-id/syntax
|
||||||
|
:entity-id eid}))))
|
||||||
|
|
||||||
|
(defn <entid-strict [db eid]
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(or (<? (<entid db eid))
|
||||||
|
(raise "Nothing found for entity id " eid
|
||||||
|
{:error :entity-id/missing
|
||||||
|
:entity-id eid}))))
|
||||||
|
|
||||||
|
(defn <entid-some [db eid]
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(when eid
|
||||||
|
(<? (<entid-strict db eid)))))
|
||||||
|
|
||||||
|
(defn <?run
|
||||||
|
"Execute the provided query on the provided DB.
|
||||||
|
Returns a transduced channel of [result err] pairs.
|
||||||
|
Closes the channel when fully consumed."
|
||||||
|
[db find args]
|
||||||
|
(let [parsed (query/parse find)
|
||||||
|
context (-> db
|
||||||
|
query-context
|
||||||
|
(query/find-into-context parsed))
|
||||||
|
row-pair-transducer (projection/row-pair-transducer context)
|
||||||
|
sql (query/context->sql-string context args)
|
||||||
|
chan (chan 50 row-pair-transducer)]
|
||||||
|
|
||||||
|
(s/<?all-rows (.-sqlite-connection db) sql chan)
|
||||||
|
chan))
|
||||||
|
|
||||||
|
(defn reduce-error-pair [f [rv re] [v e]]
|
||||||
|
(if re
|
||||||
|
[nil re]
|
||||||
|
(if e
|
||||||
|
[nil e]
|
||||||
|
[(f rv v) nil])))
|
||||||
|
|
||||||
|
(defn <?q
|
||||||
|
"Execute the provided query on the provided DB.
|
||||||
|
Returns a transduced pair-chan with one [[results] err] item."
|
||||||
|
[db find args]
|
||||||
|
(a/reduce (partial reduce-error-pair conj) [[] nil]
|
||||||
|
(<?run db find args)))
|
||||||
|
|
|
@ -1,40 +0,0 @@
|
||||||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
|
||||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
||||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
||||||
|
|
||||||
(ns datomish.exec
|
|
||||||
#?(:cljs
|
|
||||||
(:require-macros
|
|
||||||
[datomish.util :refer [while-let]]
|
|
||||||
[datomish.pair-chan :refer [go-pair <?]]
|
|
||||||
[cljs.core.async.macros :refer [go]]))
|
|
||||||
(:require
|
|
||||||
[datomish.sqlite :as s]
|
|
||||||
[datomish.sqlite-schema :as ss]
|
|
||||||
[datomish.query :as dq]
|
|
||||||
#?@(:clj
|
|
||||||
[[datomish.jdbc-sqlite]
|
|
||||||
[datomish.pair-chan :refer [go-pair <?]]
|
|
||||||
[datomish.util :refer [while-let]]
|
|
||||||
[clojure.core.async :refer
|
|
||||||
[go ; macro in cljs.
|
|
||||||
<! >! chan close! take!]]])
|
|
||||||
#?@(:cljs
|
|
||||||
[[datomish.promise-sqlite]
|
|
||||||
[datomish.pair-chan]
|
|
||||||
[datomish.util]
|
|
||||||
[cljs.core.async :as a :refer
|
|
||||||
[<! >! chan close! take!]]])))
|
|
||||||
|
|
||||||
(defn <?run
|
|
||||||
"Execute the provided query on the provided DB.
|
|
||||||
Returns a transduced channel of [result err] pairs.
|
|
||||||
Closes the channel when fully consumed."
|
|
||||||
[db find]
|
|
||||||
(let [initial-context (dq/make-context)
|
|
||||||
context (dq/expand-find-into-context initial-context (dq/parse find))
|
|
||||||
row-pair-transducer (dq/row-pair-transducer context (dq/sql-projection context))
|
|
||||||
chan (chan 50 row-pair-transducer)]
|
|
||||||
|
|
||||||
(s/<?all-rows db (dq/context->sql-string context) chan)
|
|
||||||
chan))
|
|
|
@ -9,10 +9,11 @@
|
||||||
[datomish.pair-chan :refer [go-pair <?]]
|
[datomish.pair-chan :refer [go-pair <?]]
|
||||||
[cljs.core.async.macros :refer [go]]))
|
[cljs.core.async.macros :refer [go]]))
|
||||||
(:require
|
(:require
|
||||||
[datomish.exec :as exec]
|
[datomish.db :as db]
|
||||||
[datomish.sqlite :as s]
|
[datomish.sqlite :as s]
|
||||||
[datomish.sqlite-schema :as ss]
|
[datomish.sqlite-schema :as ss]
|
||||||
[datomish.query :as dq]
|
[datomish.query :as dq]
|
||||||
|
[datomish.transact :as transact]
|
||||||
#?@(:clj
|
#?@(:clj
|
||||||
[[datomish.jdbc-sqlite]
|
[[datomish.jdbc-sqlite]
|
||||||
[datomish.pair-chan :refer [go-pair <?]]
|
[datomish.pair-chan :refer [go-pair <?]]
|
||||||
|
@ -39,16 +40,16 @@
|
||||||
"Given an open database, returns a lazy sequence of results.
|
"Given an open database, returns a lazy sequence of results.
|
||||||
When fully consumed, underlying resources will be released."
|
When fully consumed, underlying resources will be released."
|
||||||
[db find]
|
[db find]
|
||||||
(pair-channel->lazy-seq (exec/<?run db find))))
|
(pair-channel->lazy-seq (db/<?run db find))))
|
||||||
|
|
||||||
#_(defn xxopen []
|
(defn xxopen []
|
||||||
(datomish.pair-chan/go-pair
|
(datomish.pair-chan/go-pair
|
||||||
(let [d (datomish.pair-chan/<? (s/<sqlite-connection "/tmp/foo.sqlite"))]
|
(let [d (datomish.pair-chan/<? (s/<sqlite-connection "/tmp/foo.sqlite"))]
|
||||||
(clojure.core.async/<!! (ss/<ensure-current-version d))
|
(clojure.core.async/<!! (ss/<ensure-current-version d))
|
||||||
(def db d))))
|
(def db d))))
|
||||||
|
|
||||||
;; With an open DB…
|
;; With an open DB…
|
||||||
#_(datomish.exec/run-to-pair-seq
|
#_(run-to-pair-seq
|
||||||
db
|
db
|
||||||
'[:find ?page :in $ :where [?page :page/starred true ?t]])
|
'[:find ?page :in $ :where [?page :page/starred true ?t]])
|
||||||
|
|
||||||
|
@ -58,13 +59,39 @@
|
||||||
"/tmp/foo.sqlite"
|
"/tmp/foo.sqlite"
|
||||||
'[:find ?page :in $ :where [?page :page/starred true ?t]]))
|
'[:find ?page :in $ :where [?page :page/starred true ?t]]))
|
||||||
|
|
||||||
#_(defn test-run []
|
#_
|
||||||
(datomish.pair-chan/go-pair
|
(go-pair
|
||||||
(let [d (datomish.pair-chan/<? (s/<sqlite-connection "/tmp/foo.sqlite"))]
|
(let [connection (<? (s/<sqlite-connection "/tmp/foo.sqlite"))
|
||||||
(<! (ss/<ensure-current-version d))
|
d (<? (db/<with-sqlite-connection connection))]
|
||||||
(let [chan (exec/<?run d
|
(println
|
||||||
'[:find ?page :in $ :where [?page :page/starred true ?t]])]
|
"Result: "
|
||||||
(println (datomish.pair-chan/<? chan))
|
(<! (db/<?q d '[:find ?page :in $ :where [?page :page/starred true ?t]] {})))))
|
||||||
(println (datomish.pair-chan/<? chan))
|
|
||||||
(println (datomish.pair-chan/<? chan))
|
|
||||||
(s/close d)))))
|
#_
|
||||||
|
(go-pair
|
||||||
|
(let [connection (<? (s/<sqlite-connection "/tmp/foo.sqlite"))
|
||||||
|
dd (<? (db/<with-sqlite-connection connection))]
|
||||||
|
(def *db* dd)))
|
||||||
|
#_
|
||||||
|
(clojure.core.async/<!!
|
||||||
|
(go-pair
|
||||||
|
(let [now -1
|
||||||
|
forms (mapcat (fn [i]
|
||||||
|
(map (fn [j]
|
||||||
|
[:db/add i :x j true])
|
||||||
|
(range 1000 (* i 2000) i)))
|
||||||
|
(range 1 10))]
|
||||||
|
(println "Adding" (count forms) "forms")
|
||||||
|
(<? (transact/<transact! *db* forms nil now)))))
|
||||||
|
|
||||||
|
#_
|
||||||
|
(go-pair
|
||||||
|
(let [connection (<? (s/<sqlite-connection "/tmp/foo.sqlite"))
|
||||||
|
dd (<? (db/<with-sqlite-connection connection))]
|
||||||
|
(println
|
||||||
|
(count
|
||||||
|
(<? (db/<?q dd
|
||||||
|
'[:find ?e ?v :in $ :where
|
||||||
|
[?e :x ?v]
|
||||||
|
#_[(> ?v 1000)]] {}))))))
|
||||||
|
|
54
src/datomish/projection.cljc
Normal file
54
src/datomish/projection.cljc
Normal file
|
@ -0,0 +1,54 @@
|
||||||
|
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||||
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||||
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||||
|
|
||||||
|
(ns datomish.projection
|
||||||
|
(:require
|
||||||
|
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise-str cond-let]]
|
||||||
|
[datascript.parser :as dp
|
||||||
|
#?@(:cljs [:refer [Pattern DefaultSrc Variable Constant Placeholder]])]
|
||||||
|
)
|
||||||
|
#?(:clj (:import [datascript.parser Pattern DefaultSrc Variable Constant Placeholder]))
|
||||||
|
)
|
||||||
|
|
||||||
|
(defn lookup-variable [cc variable]
|
||||||
|
(or (-> cc :bindings variable first)
|
||||||
|
(raise-str "Couldn't find variable " variable)))
|
||||||
|
|
||||||
|
(defn sql-projection
|
||||||
|
"Take a `find` clause's `:elements` list and turn it into a SQL
|
||||||
|
projection clause, suitable for passing as a `:select` clause to
|
||||||
|
honeysql.
|
||||||
|
|
||||||
|
For example:
|
||||||
|
|
||||||
|
[Variable{:symbol ?foo}, Variable{:symbol ?bar}]
|
||||||
|
|
||||||
|
with bindings in the context:
|
||||||
|
|
||||||
|
{?foo [:datoms12.e :datoms13.v], ?bar [:datoms13.e]}
|
||||||
|
|
||||||
|
=>
|
||||||
|
|
||||||
|
[[:datoms12.e :foo] [:datoms13.e :bar]]
|
||||||
|
|
||||||
|
@param context A Context, containing elements.
|
||||||
|
@return a sequence of pairs."
|
||||||
|
[context]
|
||||||
|
(def foo context)
|
||||||
|
(let [elements (:elements context)]
|
||||||
|
(when-not (every? #(instance? Variable %1) elements)
|
||||||
|
(raise-str "Unable to :find non-variables."))
|
||||||
|
(map (fn [elem]
|
||||||
|
(let [var (:symbol elem)]
|
||||||
|
[(lookup-variable (:cc context) var) (util/var->sql-var var)]))
|
||||||
|
elements)))
|
||||||
|
|
||||||
|
(defn row-pair-transducer [context]
|
||||||
|
;; For now, we only support straight var lists, so
|
||||||
|
;; our transducer is trivial.
|
||||||
|
(let [columns-in-order (map second (sql-projection context))]
|
||||||
|
(map (fn [[row err]]
|
||||||
|
(if err
|
||||||
|
[row err]
|
||||||
|
[(map row columns-in-order) nil])))))
|
|
@ -4,184 +4,50 @@
|
||||||
|
|
||||||
(ns datomish.query
|
(ns datomish.query
|
||||||
(:require
|
(:require
|
||||||
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
|
[datomish.clauses :as clauses]
|
||||||
|
[datomish.context :as context]
|
||||||
|
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise-str cond-let]]
|
||||||
|
[datomish.projection :as projection]
|
||||||
[datomish.transforms :as transforms]
|
[datomish.transforms :as transforms]
|
||||||
[datascript.parser :as dp
|
[datascript.parser :as dp
|
||||||
#?@(:cljs [:refer [Pattern DefaultSrc Variable Constant Placeholder]])]
|
#?@(:cljs
|
||||||
|
[:refer [
|
||||||
|
BindScalar
|
||||||
|
Constant
|
||||||
|
DefaultSrc
|
||||||
|
Pattern
|
||||||
|
Placeholder
|
||||||
|
SrcVar
|
||||||
|
Variable
|
||||||
|
]])]
|
||||||
[clojure.string :as str]
|
[clojure.string :as str]
|
||||||
[honeysql.core :as sql]
|
[honeysql.core :as sql]
|
||||||
)
|
)
|
||||||
#?(:clj (:import [datascript.parser Pattern DefaultSrc Variable Constant Placeholder]))
|
#?(:clj
|
||||||
)
|
(:import
|
||||||
|
[datascript.parser
|
||||||
|
BindScalar
|
||||||
|
Constant
|
||||||
|
DefaultSrc
|
||||||
|
Pattern
|
||||||
|
Placeholder
|
||||||
|
SrcVar
|
||||||
|
Variable
|
||||||
|
])))
|
||||||
|
|
||||||
;; Setting this to something else will make your output more readable,
|
;; Setting this to something else will make your output more readable,
|
||||||
;; but not automatically safe for use.
|
;; but not automatically safe for use.
|
||||||
(def sql-quoting-style :ansi)
|
(def sql-quoting-style :ansi)
|
||||||
|
|
||||||
;;
|
|
||||||
;; Context.
|
|
||||||
;;
|
|
||||||
;; `attribute-transform` is a function from attribute to constant value. Used to
|
|
||||||
;; turn, e.g., :p/attribute into an interned integer.
|
|
||||||
;; `constant-transform` is a function from constant value to constant value. Used to
|
|
||||||
;; turn, e.g., the literal 'true' into 1.
|
|
||||||
;; `from` is a list of table pairs, suitable for passing to honeysql.
|
|
||||||
;; `:bindings` is a map from var to qualified columns.
|
|
||||||
;; `:wheres` is a list of fragments that can be joined by `:and`.
|
|
||||||
;;
|
|
||||||
(defrecord Context [from bindings wheres elements attribute-transform constant-transform])
|
|
||||||
|
|
||||||
(defn attribute-in-context [context attribute]
|
|
||||||
((:attribute-transform context) attribute))
|
|
||||||
|
|
||||||
(defn constant-in-context [context constant]
|
|
||||||
((:constant-transform context) constant))
|
|
||||||
|
|
||||||
(defn bind-column-to-var [context variable col]
|
|
||||||
(let [var (:symbol variable)
|
|
||||||
existing-bindings (get-in context [:bindings var])]
|
|
||||||
(assoc-in context [:bindings var] (conj existing-bindings col))))
|
|
||||||
|
|
||||||
(defn constrain-column-to-constant [context col position value]
|
|
||||||
(util/conj-in context [:wheres]
|
|
||||||
[:= col (if (= :a position)
|
|
||||||
(attribute-in-context context value)
|
|
||||||
(constant-in-context context value))]))
|
|
||||||
|
|
||||||
(defn lookup-variable [context variable]
|
|
||||||
(or (-> context :bindings variable first)
|
|
||||||
(raise (str "Couldn't find variable " variable))))
|
|
||||||
|
|
||||||
(defn make-context
|
|
||||||
([]
|
|
||||||
(make-context transforms/attribute-transform-string transforms/constant-transform-default))
|
|
||||||
([attribute-transform constant-transform]
|
|
||||||
(map->Context {:from []
|
|
||||||
:bindings {}
|
|
||||||
:wheres []
|
|
||||||
:elements []
|
|
||||||
:attribute-transform attribute-transform
|
|
||||||
:constant-transform constant-transform})))
|
|
||||||
|
|
||||||
(defn apply-pattern-to-context
|
|
||||||
"Transform a DataScript Pattern instance into the parts needed
|
|
||||||
to build a SQL expression.
|
|
||||||
|
|
||||||
@arg context A Context instance.
|
|
||||||
@arg pattern The pattern instance.
|
|
||||||
@return an augmented Context."
|
|
||||||
[context pattern]
|
|
||||||
(when-not (instance? Pattern pattern)
|
|
||||||
(raise "Expected to be called with a Pattern instance."))
|
|
||||||
(when-not (instance? DefaultSrc (:source pattern))
|
|
||||||
(raise (str "Non-default sources are not supported in patterns. Pattern: "
|
|
||||||
(print-str pattern))))
|
|
||||||
|
|
||||||
(let [table :datoms
|
|
||||||
alias (gensym (name table))
|
|
||||||
places (map (fn [place col] [place col])
|
|
||||||
(:pattern pattern)
|
|
||||||
[:e :a :v :tx])]
|
|
||||||
(reduce
|
|
||||||
(fn [context
|
|
||||||
[pattern-part ; ?x, :foo/bar, 42
|
|
||||||
position]] ; :a
|
|
||||||
(let [col (sql/qualify alias (name position))] ; :datoms123.a
|
|
||||||
(condp instance? pattern-part
|
|
||||||
;; Placeholders don't contribute any bindings, nor do
|
|
||||||
;; they constrain the query -- there's no need to produce
|
|
||||||
;; IS NOT NULL, because we don't store nulls in our schema.
|
|
||||||
Placeholder
|
|
||||||
context
|
|
||||||
|
|
||||||
Variable
|
|
||||||
(bind-column-to-var context pattern-part col)
|
|
||||||
|
|
||||||
Constant
|
|
||||||
(constrain-column-to-constant context col position (:value pattern-part))
|
|
||||||
|
|
||||||
(raise (str "Unknown pattern part " (print-str pattern-part))))))
|
|
||||||
|
|
||||||
;; Record the new table mapping.
|
|
||||||
(util/conj-in context [:from] [table alias])
|
|
||||||
|
|
||||||
places)))
|
|
||||||
|
|
||||||
(defn- bindings->where
|
|
||||||
"Take a bindings map like
|
|
||||||
{?foo [:datoms12.e :datoms13.v :datoms14.e]}
|
|
||||||
and produce a list of constraints expression like
|
|
||||||
[[:= :datoms12.e :datoms13.v] [:= :datoms12.e :datoms14.e]]
|
|
||||||
|
|
||||||
TODO: experiment; it might be the case that producing more
|
|
||||||
pairwise equalities we get better or worse performance."
|
|
||||||
[bindings]
|
|
||||||
(mapcat (fn [[_ vs]]
|
|
||||||
(when (> (count vs) 1)
|
|
||||||
(let [root (first vs)]
|
|
||||||
(map (fn [v] [:= root v]) (rest vs)))))
|
|
||||||
bindings))
|
|
||||||
|
|
||||||
(defn expand-where-from-bindings
|
|
||||||
"Take the bindings in the context and contribute
|
|
||||||
additional where clauses. Calling this more than
|
|
||||||
once will result in duplicate clauses."
|
|
||||||
[context]
|
|
||||||
(assoc context :wheres (concat (bindings->where (:bindings context))
|
|
||||||
(:wheres context))))
|
|
||||||
|
|
||||||
(defn apply-elements-to-context [context elements]
|
|
||||||
(assoc context :elements elements))
|
|
||||||
|
|
||||||
(defn expand-patterns-into-context
|
|
||||||
"Reduce a sequence of patterns into a Context."
|
|
||||||
[context patterns]
|
|
||||||
(reduce apply-pattern-to-context context patterns))
|
|
||||||
|
|
||||||
(defn sql-projection
|
|
||||||
"Take a `find` clause's `:elements` list and turn it into a SQL
|
|
||||||
projection clause, suitable for passing as a `:select` clause to
|
|
||||||
honeysql.
|
|
||||||
|
|
||||||
For example:
|
|
||||||
|
|
||||||
[Variable{:symbol ?foo}, Variable{:symbol ?bar}]
|
|
||||||
|
|
||||||
with bindings in the context:
|
|
||||||
|
|
||||||
{?foo [:datoms12.e :datoms13.v], ?bar [:datoms13.e]}
|
|
||||||
|
|
||||||
=>
|
|
||||||
|
|
||||||
[[:datoms12.e :foo] [:datoms13.e :bar]]
|
|
||||||
|
|
||||||
@param context A Context, containing elements.
|
|
||||||
@return a sequence of pairs."
|
|
||||||
[context]
|
|
||||||
(let [elements (:elements context)]
|
|
||||||
(when-not (every? #(instance? Variable %1) elements)
|
|
||||||
(raise "Unable to :find non-variables."))
|
|
||||||
(map (fn [elem]
|
|
||||||
(let [var (:symbol elem)]
|
|
||||||
[(lookup-variable context var) (util/var->sql-var var)]))
|
|
||||||
elements)))
|
|
||||||
|
|
||||||
(defn row-pair-transducer [context projection]
|
|
||||||
;; For now, we only support straight var lists, so
|
|
||||||
;; our transducer is trivial.
|
|
||||||
(let [columns-in-order (map second projection)]
|
|
||||||
(map (fn [[row err]]
|
|
||||||
(if err
|
|
||||||
[row err]
|
|
||||||
[(map row columns-in-order) nil])))))
|
|
||||||
|
|
||||||
(defn context->sql-clause [context]
|
(defn context->sql-clause [context]
|
||||||
(merge
|
(merge
|
||||||
{:select (sql-projection context)
|
{:select (projection/sql-projection context)
|
||||||
:from (:from context)}
|
|
||||||
(if (empty? (:wheres context))
|
;; Always SELECT DISTINCT, because Datalog is set-based.
|
||||||
{}
|
;; TODO: determine from schema analysis whether we can avoid
|
||||||
{:where (cons :and (:wheres context))})))
|
;; the need to do this.
|
||||||
|
:modifiers [:distinct]}
|
||||||
|
(clauses/cc->partial-subquery (:cc context))))
|
||||||
|
|
||||||
(defn context->sql-string [context]
|
(defn context->sql-string [context]
|
||||||
(->
|
(->
|
||||||
|
@ -191,43 +57,65 @@
|
||||||
|
|
||||||
(defn- validate-with [with]
|
(defn- validate-with [with]
|
||||||
(when-not (nil? with)
|
(when-not (nil? with)
|
||||||
(raise "`with` not supported.")))
|
(raise-str "`with` not supported.")))
|
||||||
|
|
||||||
(defn- validate-in [in]
|
(defn- validate-in [in]
|
||||||
(when-not (and (== 1 (count in))
|
(when (nil? in)
|
||||||
(= "$" (name (-> in first :variable :symbol))))
|
(raise-str ":in expression cannot be nil."))
|
||||||
(raise (str "Complex `in` not supported: " (print-str in)))))
|
(when-not (= "$" (name (-> in first :variable :symbol)))
|
||||||
|
(raise-str "Non-default sources not supported."))
|
||||||
|
(when-not (every? (partial instance? BindScalar) (rest in))
|
||||||
|
(raise-str "Non-scalar bindings not supported.")))
|
||||||
|
|
||||||
(defn expand-find-into-context [context find]
|
(defn in->bindings
|
||||||
;; There's some confusing use of 'where' and friends here. That's because
|
"Take an `:in` list and return a bindings map suitable for use
|
||||||
;; the parsed Datalog includes :where, and it's also input to honeysql's
|
as external bindings in a CC."
|
||||||
;; SQL formatter.
|
[in]
|
||||||
|
(reduce
|
||||||
|
(fn [m b]
|
||||||
|
(or
|
||||||
|
(when (instance? BindScalar b)
|
||||||
|
(let [var (:variable b)]
|
||||||
|
(when (instance? Variable var)
|
||||||
|
(let [v (:symbol var)]
|
||||||
|
(assoc m v [(sql/param (util/var->sql-var v))])))))
|
||||||
|
m))
|
||||||
|
{}
|
||||||
|
in))
|
||||||
|
|
||||||
|
(defn find-into-context
|
||||||
|
"Take a parsed `find` expression and return a fully populated
|
||||||
|
Context. You'll want this so you can get access to the
|
||||||
|
projection, amongst other things."
|
||||||
|
[context find]
|
||||||
(let [{:keys [find in with where]} find] ; Destructure the Datalog query.
|
(let [{:keys [find in with where]} find] ; Destructure the Datalog query.
|
||||||
(validate-with with)
|
(validate-with with)
|
||||||
(validate-in in)
|
(validate-in in)
|
||||||
(apply-elements-to-context
|
(let [external-bindings (in->bindings in)]
|
||||||
(expand-where-from-bindings
|
(assoc context
|
||||||
(expand-patterns-into-context context where)) ; 'where' here is the Datalog :where clause.
|
:elements (:elements find)
|
||||||
(:elements find))))
|
:cc (clauses/patterns->cc (:default-source context) where external-bindings)))))
|
||||||
|
|
||||||
|
(defn context->sql-string
|
||||||
|
[context args]
|
||||||
|
(-> context
|
||||||
|
context->sql-clause
|
||||||
|
(sql/format args :quoting sql-quoting-style)))
|
||||||
|
|
||||||
(defn find->sql-clause
|
(defn find->sql-clause
|
||||||
"Take a parsed `find` expression and turn it into a structured SQL
|
"Take a parsed `find` expression and turn it into a structured SQL
|
||||||
expression that can be formatted by honeysql."
|
expression that can be formatted by honeysql."
|
||||||
[context find]
|
[context find]
|
||||||
;; There's some confusing use of 'where' and friends here. That's because
|
|
||||||
;; the parsed Datalog includes :where, and it's also input to honeysql's
|
|
||||||
;; SQL formatter.
|
|
||||||
(->> find
|
(->> find
|
||||||
(expand-find-into-context context)
|
(find-into-context context)
|
||||||
context->sql-clause))
|
context->sql-clause))
|
||||||
|
|
||||||
(defn find->sql-string
|
(defn find->sql-string
|
||||||
"Take a parsed `find` expression and turn it into SQL."
|
"Take a parsed `find` expression and turn it into SQL."
|
||||||
[context find]
|
[context find args]
|
||||||
(->>
|
(->
|
||||||
find
|
(find->sql-clause context find)
|
||||||
(find->sql-clause context)
|
(sql/format args :quoting sql-quoting-style)))
|
||||||
(sql/format :quoting sql-quoting-style)))
|
|
||||||
|
|
||||||
(defn parse
|
(defn parse
|
||||||
"Parse a Datalog query array into a structured `find` expression."
|
"Parse a Datalog query array into a structured `find` expression."
|
||||||
|
@ -235,27 +123,13 @@
|
||||||
(dp/parse-query q))
|
(dp/parse-query q))
|
||||||
|
|
||||||
(comment
|
(comment
|
||||||
|
(def sql-quoting-style nil)
|
||||||
(datomish.query/find->sql-string
|
(datomish.query/find->sql-string
|
||||||
|
(datomish.context/->Context (datomish.source/datoms-source nil) nil nil)
|
||||||
(datomish.query/parse
|
(datomish.query/parse
|
||||||
'[:find ?page :in $ :where [?page :page/starred true ?t] ])))
|
'[:find ?timestampMicros ?page :in $ ?latest :where
|
||||||
|
|
||||||
(comment
|
|
||||||
(datomish.query/find->prepared-context
|
|
||||||
(datomish.query/parse
|
|
||||||
'[:find ?timestampMicros ?page
|
|
||||||
:in $
|
|
||||||
:where
|
|
||||||
[?page :page/starred true ?t]
|
[?page :page/starred true ?t]
|
||||||
[?t :db/txInstant ?timestampMicros]])))
|
[?t :db/txInstant ?timestampMicros]
|
||||||
|
(not [(> ?t ?latest)]) ])
|
||||||
(comment
|
{:latest 5})
|
||||||
(pattern->sql
|
)
|
||||||
(first
|
|
||||||
(:where
|
|
||||||
(datomish.query/parse
|
|
||||||
'[:find (max ?timestampMicros) (pull ?page [:page/url :page/title]) ?page
|
|
||||||
:in $
|
|
||||||
:where
|
|
||||||
[?page :page/starred true ?t]
|
|
||||||
[?t :db/txInstant ?timestampMicros]])))
|
|
||||||
identity))
|
|
||||||
|
|
62
src/datomish/source.cljc
Normal file
62
src/datomish/source.cljc
Normal file
|
@ -0,0 +1,62 @@
|
||||||
|
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||||
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||||
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||||
|
|
||||||
|
(ns datomish.source
|
||||||
|
(:require
|
||||||
|
[datomish.transforms :as transforms]))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; A source is something that can match patterns. For example:
|
||||||
|
;;;
|
||||||
|
;;; * The database itself.
|
||||||
|
;;; * The history of the database.
|
||||||
|
;;; * A filtered version of the database or the history.
|
||||||
|
;;;
|
||||||
|
;;; We model this in a SQL context as something that can:
|
||||||
|
;;;
|
||||||
|
;;; * Give us a table name.
|
||||||
|
;;; * Give us a new alias for the table name.
|
||||||
|
;;; * Provide us with a list of columns to match, positionally,
|
||||||
|
;;; against patterns.
|
||||||
|
;;; * Provide us with a set of WHERE fragments that, in combination
|
||||||
|
;;; with the table name, denote the source.
|
||||||
|
;;; * Transform constants and attributes into something usable
|
||||||
|
;;; by the source.
|
||||||
|
|
||||||
|
(defrecord
|
||||||
|
Source
|
||||||
|
[table ; e.g., :datoms
|
||||||
|
columns ; e.g., [:e :a :v :tx]
|
||||||
|
|
||||||
|
;; `attribute-transform` is a function from attribute to constant value. Used to
|
||||||
|
;; turn, e.g., :p/attribute into an interned integer.
|
||||||
|
;; `constant-transform` is a function from constant value to constant value. Used to
|
||||||
|
;; turn, e.g., the literal 'true' into 1.
|
||||||
|
attribute-transform
|
||||||
|
constant-transform
|
||||||
|
|
||||||
|
;; Not currently used.
|
||||||
|
make-constraints ; ?fn [source alias] => [where-clauses]
|
||||||
|
])
|
||||||
|
|
||||||
|
(defn datoms-source [db]
|
||||||
|
(->Source :datoms
|
||||||
|
[:e :a :v :tx :added]
|
||||||
|
transforms/attribute-transform-string
|
||||||
|
transforms/constant-transform-default
|
||||||
|
nil))
|
||||||
|
|
||||||
|
(defn source->from [source]
|
||||||
|
(let [table (:table source)]
|
||||||
|
[table (gensym (name table))]))
|
||||||
|
|
||||||
|
(defn source->constraints [source alias]
|
||||||
|
(when-let [f (:make-constraints source)]
|
||||||
|
(f alias)))
|
||||||
|
|
||||||
|
(defn attribute-in-source [source attribute]
|
||||||
|
((:attribute-transform source) attribute))
|
||||||
|
|
||||||
|
(defn constant-in-source [source constant]
|
||||||
|
((:constant-transform source) constant))
|
|
@ -59,7 +59,9 @@
|
||||||
when no more results exist. Consume with <?."
|
when no more results exist. Consume with <?."
|
||||||
[db [sql & bindings :as rest] chan]
|
[db [sql & bindings :as rest] chan]
|
||||||
(go-safely [c chan]
|
(go-safely [c chan]
|
||||||
(let [result (<! (-each db sql bindings (fn [row] (put! c [row nil]))))]
|
(let [result (<! (-each db sql bindings
|
||||||
|
(fn [row]
|
||||||
|
(put! c [row nil]))))]
|
||||||
;; We assume that a failure will result in the promise
|
;; We assume that a failure will result in the promise
|
||||||
;; channel being rejected and no further row callbacks
|
;; channel being rejected and no further row callbacks
|
||||||
;; being called.
|
;; being called.
|
||||||
|
|
|
@ -8,7 +8,7 @@
|
||||||
[datomish.pair-chan :refer [go-pair <?]]
|
[datomish.pair-chan :refer [go-pair <?]]
|
||||||
[cljs.core.async.macros :refer [go]]))
|
[cljs.core.async.macros :refer [go]]))
|
||||||
(:require
|
(:require
|
||||||
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
|
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise-str cond-let]]
|
||||||
[datomish.sqlite :as s]
|
[datomish.sqlite :as s]
|
||||||
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
|
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
|
||||||
[clojure.core.async :refer [go <! >!]]])
|
[clojure.core.async :refer [go <! >!]]])
|
||||||
|
@ -42,7 +42,7 @@
|
||||||
{:pre [(> from-version 0)]} ;; Or we'd create-current-version instead.
|
{:pre [(> from-version 0)]} ;; Or we'd create-current-version instead.
|
||||||
{:pre [(< from-version current-version)]} ;; Or we wouldn't need to update-from-version.
|
{:pre [(< from-version current-version)]} ;; Or we wouldn't need to update-from-version.
|
||||||
(go-pair
|
(go-pair
|
||||||
(raise "No migrations yet defined!")
|
(raise-str "No migrations yet defined!")
|
||||||
(<? (s/set-user-version db current-version))
|
(<? (s/set-user-version db current-version))
|
||||||
(<? (s/get-user-version db))))
|
(<? (s/get-user-version db))))
|
||||||
|
|
||||||
|
|
243
src/datomish/transact.cljc
Normal file
243
src/datomish/transact.cljc
Normal file
|
@ -0,0 +1,243 @@
|
||||||
|
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||||
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||||
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||||
|
|
||||||
|
(ns datomish.transact
|
||||||
|
#?(:cljs
|
||||||
|
(:require-macros
|
||||||
|
[datomish.pair-chan :refer [go-pair <?]]
|
||||||
|
[cljs.core.async.macros :refer [go]]))
|
||||||
|
#?(:clj (:import [datomish.db Datom TxReport]))
|
||||||
|
(:require
|
||||||
|
[datomish.context :as context]
|
||||||
|
[datomish.db :as db :refer [#?@(:cljs [Datom TxReport]) db?]]
|
||||||
|
[datomish.projection :as projection]
|
||||||
|
[datomish.query :as query]
|
||||||
|
[datomish.source :as source]
|
||||||
|
[datomish.sqlite :as s]
|
||||||
|
[datomish.sqlite-schema :as sqlite-schema]
|
||||||
|
[datomish.util :as util :refer [raise raise-str]]
|
||||||
|
[honeysql.core :as sql]
|
||||||
|
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
|
||||||
|
[clojure.core.async :as a :refer [chan go <! >!]]])
|
||||||
|
#?@(:cljs [[datomish.pair-chan]
|
||||||
|
[cljs.core.async :as a :refer [chan <! >!]]])))
|
||||||
|
|
||||||
|
(defn- tx-id? [e]
|
||||||
|
(= e :db/current-tx))
|
||||||
|
|
||||||
|
(defn- validate-eid [eid at]
|
||||||
|
(when-not (number? eid)
|
||||||
|
(raise "Bad entity id " eid " at " at ", expected number"
|
||||||
|
{:error :transact/syntax, :entity-id eid, :context at})))
|
||||||
|
|
||||||
|
(defn- validate-attr [attr at]
|
||||||
|
(when-not (number? attr)
|
||||||
|
(raise "Bad entity attribute " attr " at " at ", expected number"
|
||||||
|
{:error :transact/syntax, :attribute attr, :context at})))
|
||||||
|
|
||||||
|
(defn- validate-val [v at]
|
||||||
|
(when (nil? v)
|
||||||
|
(raise "Cannot store nil as a value at " at
|
||||||
|
{:error :transact/syntax, :value v, :context at})))
|
||||||
|
|
||||||
|
;; TODO: handle _?
|
||||||
|
(defn search->sql-clause [pattern]
|
||||||
|
(merge
|
||||||
|
{:select [:*] ;; e :a :v :tx] ;; TODO: generalize columns.
|
||||||
|
:from [:datoms]}
|
||||||
|
(if-not (empty? pattern)
|
||||||
|
{:where (cons :and (map #(vector := %1 %2) [:e :a :v :tx] pattern))} ;; TODO: use schema to v.
|
||||||
|
{})))
|
||||||
|
|
||||||
|
(defn <search [db pattern]
|
||||||
|
{:pre [(db/db? db)]}
|
||||||
|
(go-pair
|
||||||
|
;; TODO: find a better expression of this pattern.
|
||||||
|
(let [rows (<? (->>
|
||||||
|
(search->sql-clause pattern)
|
||||||
|
(sql/format)
|
||||||
|
(s/all-rows (:sqlite-connection db))))]
|
||||||
|
(mapv #(Datom. (:e %) (:a %) (:v %) (:tx %) true) rows))))
|
||||||
|
|
||||||
|
(defn- <transact-report [db report datom]
|
||||||
|
{:pre [(db/db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(let [exec (partial s/execute! (:sqlite-connection db))
|
||||||
|
[e a v tx added] [(.-e datom) (.-a datom) (.-v datom) (.-tx datom) (.-added datom)]] ;; TODO: destructuring.
|
||||||
|
(validate-eid e [e a v tx added]) ;; TODO: track original vs. transformed?
|
||||||
|
;; Append to transaction log.
|
||||||
|
(<? (exec
|
||||||
|
["INSERT INTO transactions VALUES (?, ?, ?, ?, ?)" e a v tx added]))
|
||||||
|
;; Update materialized datom view.
|
||||||
|
(if (.-added datom)
|
||||||
|
(<? (exec
|
||||||
|
;; TODO: use schema to insert correct indexing flags.
|
||||||
|
["INSERT INTO datoms VALUES (?, ?, ?, ?, 0, 0)" e a v tx]))
|
||||||
|
(<? (exec
|
||||||
|
;; TODO: verify this is correct.
|
||||||
|
["DELETE FROM datoms WHERE (e = ? AND a = ? AND v = ?)" e a v])))
|
||||||
|
(-> report
|
||||||
|
(update-in [:tx-data] conj datom)))))
|
||||||
|
|
||||||
|
(defn- <transact-add [db report [_ e a v tx :as entity]]
|
||||||
|
{:pre [(db/db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(validate-attr a entity)
|
||||||
|
(validate-val v entity)
|
||||||
|
(let [tx (or tx (:current-tx report))
|
||||||
|
e (<? (db/<entid-strict db e))
|
||||||
|
v (if (db/ref? db a) (<? (db/<entid-strict db v)) v)
|
||||||
|
datom (Datom. e a v tx true)]
|
||||||
|
(if (db/multival? db a)
|
||||||
|
;; TODO: consider adding a UNIQUE CONSTRAINT and using INSERT OR IGNORE.
|
||||||
|
(if (empty? (<? (<search db [e a v])))
|
||||||
|
(<? (<transact-report db report datom))
|
||||||
|
report)
|
||||||
|
(if-let [^Datom old-datom (first (<? (<search db [e a])))]
|
||||||
|
(if (= (.-v old-datom) v)
|
||||||
|
report
|
||||||
|
(let [ra (<? (<transact-report db report (Datom. e a (.-v old-datom) tx false)))
|
||||||
|
rb (<? (<transact-report db ra datom))]
|
||||||
|
rb)) ;; TODO: express this better.
|
||||||
|
(<? (<transact-report db report datom)))))))
|
||||||
|
|
||||||
|
(defn- <transact-retract [db report [_ e a v _ :as entity]] ;; TODO: think about retracting with tx.
|
||||||
|
{:pre [(db/db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(let [tx (:current-tx report)]
|
||||||
|
(if-let [e (<? (db/<entid db e))]
|
||||||
|
(let [v (if (db/ref? db a) (<? (db/<entid-strict db v)) v)]
|
||||||
|
(validate-attr a entity)
|
||||||
|
(validate-val v entity)
|
||||||
|
(if-let [old-datom (first (<? (<search db [e a v])))]
|
||||||
|
(<? (<transact-report db report (Datom. e a v tx false)))
|
||||||
|
report))
|
||||||
|
report))))
|
||||||
|
(defn- #?@(:clj [^Boolean neg-number?]
|
||||||
|
:cljs [^boolean neg-number?])
|
||||||
|
[x]
|
||||||
|
(and (number? x) (neg? x)))
|
||||||
|
|
||||||
|
(defn <transact-tx-data
|
||||||
|
[db now initial-report initial-es]
|
||||||
|
{:pre [(db/db? db)]}
|
||||||
|
(go-pair
|
||||||
|
(when-not (or (nil? initial-es)
|
||||||
|
(sequential? initial-es))
|
||||||
|
(raise "Bad transaction data " initial-es ", expected sequential collection"
|
||||||
|
{:error :transact/syntax, :tx-data initial-es}))
|
||||||
|
(loop [report initial-report
|
||||||
|
es initial-es]
|
||||||
|
(let [[entity & entities] es
|
||||||
|
current-tx (:current-tx report)]
|
||||||
|
(cond
|
||||||
|
(nil? entity)
|
||||||
|
;; We're done! Add transaction datom to the report.
|
||||||
|
(do
|
||||||
|
;; TODO: don't special case :db/txInstant attribute.
|
||||||
|
(<? (<transact-report db report (Datom. current-tx (get (db/idents db) :db/txInstant) now current-tx true)))
|
||||||
|
(-> report
|
||||||
|
(assoc-in [:tempids :db/current-tx] current-tx)))
|
||||||
|
|
||||||
|
(map? entity)
|
||||||
|
(raise "Map entities are not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
(sequential? entity)
|
||||||
|
(let [[op e a v] entity]
|
||||||
|
(cond
|
||||||
|
(keyword? a)
|
||||||
|
(if-let [entid (get (db/idents db) a)]
|
||||||
|
(recur report (cons [op e entid v] entities))
|
||||||
|
(raise "No entid found for ident " a
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity}))
|
||||||
|
|
||||||
|
(= op :db.fn/call)
|
||||||
|
(raise "DataScript's transactor functions are not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
(= op :db.fn/cas)
|
||||||
|
(raise "Datomic's compare-and-swap is not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
(tx-id? e)
|
||||||
|
(recur report (cons [op current-tx a v] entities))
|
||||||
|
|
||||||
|
(and (db/ref? db a) (tx-id? v))
|
||||||
|
(recur report (cons [op e a current-tx] entities))
|
||||||
|
|
||||||
|
(neg-number? e)
|
||||||
|
(if (not= op :db/add)
|
||||||
|
(raise "Negative entity ids are resolved for :db/add only"
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
(raise "Negative entity ids are not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity }))
|
||||||
|
|
||||||
|
(and (db/ref? db a) (neg-number? v))
|
||||||
|
(raise "Negative entity ids are not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
(= op :db/add)
|
||||||
|
(recur (<? (<transact-add db report entity)) entities)
|
||||||
|
|
||||||
|
(= op :db/retract)
|
||||||
|
(recur (<? (<transact-retract db report entity)) entities)
|
||||||
|
|
||||||
|
(= op :db.fn/retractAttribute)
|
||||||
|
(raise "DataScript's :db.fn/retractAttribute shortcut is not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
(= op :db.fn/retractEntity)
|
||||||
|
(raise "Datomic's :db.fn/retractEntity shortcut is not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
:else
|
||||||
|
(raise "Unknown operation at " entity ", expected :db/add, :db/retract, :db.fn/call, :db.fn/retractAttribute or :db.fn/retractEntity"
|
||||||
|
{:error :transact/syntax, :operation op, :tx-data entity})))
|
||||||
|
|
||||||
|
(db/datom? entity)
|
||||||
|
(raise "Datom entities are not yet supported, got " entity
|
||||||
|
{:error :transact/syntax
|
||||||
|
:op entity })
|
||||||
|
|
||||||
|
:else
|
||||||
|
(raise "Bad entity type at " entity ", expected map or vector"
|
||||||
|
{:error :transact/syntax, :tx-data entity})
|
||||||
|
)))))
|
||||||
|
|
||||||
|
(defn <process-db-part
|
||||||
|
"Transactions may add idents, install new partitions, and install new schema attributes. Handle
|
||||||
|
them, atomically, here."
|
||||||
|
[db report]
|
||||||
|
(go-pair
|
||||||
|
nil))
|
||||||
|
|
||||||
|
(defn <transact!
|
||||||
|
([db tx-data]
|
||||||
|
(<transact! db tx-data nil 0xdeadbeef)) ;; TODO: timestamp!
|
||||||
|
([db tx-data tx-meta now]
|
||||||
|
{:pre [(db? db)]}
|
||||||
|
(s/in-transaction!
|
||||||
|
(:sqlite-connection db)
|
||||||
|
#(go-pair
|
||||||
|
(let [current-tx (<? (db/<allocate-tx db))
|
||||||
|
report (<? (<transact-tx-data db now
|
||||||
|
(db/map->TxReport
|
||||||
|
{:current-tx current-tx
|
||||||
|
:tx-data []
|
||||||
|
:tempids {}
|
||||||
|
:tx-meta tx-meta}) tx-data))]
|
||||||
|
(<? (<process-db-part db report))
|
||||||
|
report)))))
|
||||||
|
|
||||||
|
|
|
@ -8,10 +8,20 @@
|
||||||
[clojure.string :as str]))
|
[clojure.string :as str]))
|
||||||
|
|
||||||
#?(:clj
|
#?(:clj
|
||||||
(defmacro raise [& fragments]
|
(defmacro raise-str
|
||||||
|
"Like `raise`, but doesn't require a data argument."
|
||||||
|
[& fragments]
|
||||||
|
`(throw (ex-info (str ~@(map (fn [m#] (if (string? m#) m# (list 'pr-str m#))) fragments)) {}))))
|
||||||
|
|
||||||
|
#?(:clj
|
||||||
|
(defmacro raise
|
||||||
|
"The last argument must be a map."
|
||||||
|
[& fragments]
|
||||||
(let [msgs (butlast fragments)
|
(let [msgs (butlast fragments)
|
||||||
data (last fragments)]
|
data (last fragments)]
|
||||||
`(throw (ex-info (str ~@(map (fn [m#] (if (string? m#) m# (list 'pr-str m#))) msgs)) ~data)))))
|
`(throw
|
||||||
|
(ex-info
|
||||||
|
(str ~@(map (fn [m#] (if (string? m#) m# (list 'pr-str m#))) msgs)) ~data)))))
|
||||||
|
|
||||||
#?(:clj
|
#?(:clj
|
||||||
(defmacro cond-let [& clauses]
|
(defmacro cond-let [& clauses]
|
||||||
|
@ -26,7 +36,7 @@
|
||||||
(if (and (symbol? x)
|
(if (and (symbol? x)
|
||||||
(str/starts-with? (name x) "?"))
|
(str/starts-with? (name x) "?"))
|
||||||
(keyword (subs (name x) 1))
|
(keyword (subs (name x) 1))
|
||||||
(raise (str x " is not a Datalog var."))))
|
(raise-str x " is not a Datalog var.")))
|
||||||
|
|
||||||
(defn conj-in
|
(defn conj-in
|
||||||
"Associates a value into a sequence in a nested associative structure, where
|
"Associates a value into a sequence in a nested associative structure, where
|
||||||
|
@ -40,6 +50,13 @@
|
||||||
(assoc m k (conj-in (get m k) ks v))
|
(assoc m k (conj-in (get m k) ks v))
|
||||||
(assoc m k (conj (get m k) v))))
|
(assoc m k (conj (get m k) v))))
|
||||||
|
|
||||||
|
(defn concat-in
|
||||||
|
{:static true}
|
||||||
|
[m [k & ks] vs]
|
||||||
|
(if ks
|
||||||
|
(assoc m k (concat-in (get m k) ks vs))
|
||||||
|
(assoc m k (concat (get m k) vs))))
|
||||||
|
|
||||||
(defmacro while-let [binding & forms]
|
(defmacro while-let [binding & forms]
|
||||||
`(loop []
|
`(loop []
|
||||||
(when-let ~binding
|
(when-let ~binding
|
||||||
|
|
131
test/datomish/db_test.cljc
Normal file
131
test/datomish/db_test.cljc
Normal file
|
@ -0,0 +1,131 @@
|
||||||
|
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||||
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||||
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||||
|
|
||||||
|
(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.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
|
||||||
|
[datomish.sqlite :as s]
|
||||||
|
[datomish.db :as db]
|
||||||
|
[datomish.transact :as transact]
|
||||||
|
#?@(: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 [<! >!]]])))
|
||||||
|
|
||||||
|
(defn <datoms [db]
|
||||||
|
(go-pair
|
||||||
|
(->>
|
||||||
|
(<? (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms ORDER BY tx ASC, e, a, v"]))
|
||||||
|
(mapv #(vector (:e %) (:a %) (:v %) (:tx %) true)))))
|
||||||
|
|
||||||
|
(defn <transactions [db]
|
||||||
|
(go-pair
|
||||||
|
(->>
|
||||||
|
(<? (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx, added FROM transactions ORDER BY tx ASC, e, a, v, added"]))
|
||||||
|
(mapv #(vector (:e %) (:a %) (:v %) (:tx %) (:added %))))))
|
||||||
|
|
||||||
|
(deftest-async test-add-one
|
||||||
|
(with-tempfile [t (tempfile)]
|
||||||
|
(let [c (<? (s/<sqlite-connection t))
|
||||||
|
db (<? (db/<with-sqlite-connection c))]
|
||||||
|
(try
|
||||||
|
(let [now -1
|
||||||
|
txInstant (<? (db/<entid db :db/txInstant)) ;; TODO: convert entids to idents on egress.
|
||||||
|
x (<? (db/<entid db :x)) ;; TODO: convert entids to idents on egress.
|
||||||
|
report (<? (transact/<transact! db [[:db/add 0 :x "valuex"]] nil now))
|
||||||
|
current-tx (:current-tx report)]
|
||||||
|
(is (= current-tx db/tx0))
|
||||||
|
(is (= (<? (<datoms db))
|
||||||
|
[[0 x "valuex" db/tx0 true]
|
||||||
|
[db/tx0 txInstant now db/tx0 true]]))
|
||||||
|
(is (= (<? (<transactions db))
|
||||||
|
[[0 x "valuex" db/tx0 1] ;; TODO: true, not 1.
|
||||||
|
[db/tx0 txInstant now db/tx0 1]])))
|
||||||
|
(finally
|
||||||
|
(<? (db/close db)))))))
|
||||||
|
|
||||||
|
(deftest-async test-add-two
|
||||||
|
(with-tempfile [t (tempfile)]
|
||||||
|
(let [c (<? (s/<sqlite-connection t))
|
||||||
|
db (<? (db/<with-sqlite-connection c))]
|
||||||
|
(try
|
||||||
|
(let [now -1
|
||||||
|
txInstant (<? (db/<entid db :db/txInstant)) ;; TODO: convert entids to idents on egress.
|
||||||
|
x (<? (db/<entid db :x)) ;; TODO: convert entids to idents on egress.
|
||||||
|
y (<? (db/<entid db :y)) ;; TODO: convert entids to idents on egress.
|
||||||
|
report (<? (transact/<transact! db [[:db/add 0 :x "valuex"] [:db/add 1 :y "valuey"]] nil now))
|
||||||
|
current-tx (:current-tx report)]
|
||||||
|
(is (= current-tx db/tx0))
|
||||||
|
(is (= (<? (<datoms db))
|
||||||
|
[[0 x "valuex" db/tx0 true]
|
||||||
|
[1 y "valuey" db/tx0 true]
|
||||||
|
[db/tx0 txInstant now db/tx0 true]]))
|
||||||
|
(is (= (<? (<transactions db))
|
||||||
|
[[0 x "valuex" db/tx0 1] ;; TODO: true, not 1.
|
||||||
|
[1 y "valuey" db/tx0 1]
|
||||||
|
[db/tx0 txInstant now db/tx0 1]])))
|
||||||
|
(finally
|
||||||
|
(<? (db/close db)))))))
|
||||||
|
|
||||||
|
;; TODO: test multipe :add and :retract of the same datom in the same transaction.
|
||||||
|
(deftest-async test-retract
|
||||||
|
(with-tempfile [t (tempfile)]
|
||||||
|
(let [c (<? (s/<sqlite-connection t))
|
||||||
|
db (<? (db/<with-sqlite-connection c))]
|
||||||
|
(try
|
||||||
|
(let [now -1
|
||||||
|
txInstant (<? (db/<entid db :db/txInstant)) ;; TODO: convert entids to idents on egress.
|
||||||
|
x (<? (db/<entid db :x)) ;; TODO: convert entids to idents on egress.
|
||||||
|
ra (<? (transact/<transact! db [[:db/add 0 :x "valuex"]] nil now))
|
||||||
|
rb (<? (transact/<transact! db [[:db/retract 0 :x "valuex"]] nil now))
|
||||||
|
txa (:current-tx ra)
|
||||||
|
txb (:current-tx rb)]
|
||||||
|
(is (= (<? (<datoms db))
|
||||||
|
[[txa txInstant now txa true]
|
||||||
|
[txb txInstant now txb true]]))
|
||||||
|
(is (= (<? (<transactions db))
|
||||||
|
[[0 x "valuex" txa 1] ;; TODO: true, not 1.
|
||||||
|
[txa txInstant -1 txa 1]
|
||||||
|
[0 x "valuex" txb 0]
|
||||||
|
[txb txInstant -1 txb 1]])))
|
||||||
|
(finally
|
||||||
|
(<? (db/close db)))))))
|
||||||
|
|
||||||
|
(defn result=
|
||||||
|
"Query results are unordered. Do a set-wise comparison instead."
|
||||||
|
[expected actual]
|
||||||
|
(= (set expected)
|
||||||
|
(set actual)))
|
||||||
|
|
||||||
|
(deftest-async test-q
|
||||||
|
(with-tempfile [t (tempfile)]
|
||||||
|
(let [c (<? (s/<sqlite-connection t))
|
||||||
|
db (<? (db/<with-sqlite-connection c))]
|
||||||
|
(try
|
||||||
|
(let [now -1
|
||||||
|
txInstant (<? (db/<entid db :db/txInstant)) ;; TODO: convert entids to idents on egress.
|
||||||
|
x (<? (db/<entid db :x)) ;; TODO: convert entids to idents on egress.
|
||||||
|
report (<? (transact/<transact! db [[:db/add 0 :x "valuex"]] nil now))
|
||||||
|
current-tx (:current-tx report)]
|
||||||
|
(is (= current-tx db/tx0))
|
||||||
|
(is (= (<? (<datoms db))
|
||||||
|
[[0 x "valuex" db/tx0 true]
|
||||||
|
[db/tx0 txInstant now db/tx0 true]]))
|
||||||
|
(is (result=
|
||||||
|
[[0 x "valuex" db/tx0] ;; TODO: include added.
|
||||||
|
[db/tx0 txInstant now db/tx0]]
|
||||||
|
(<? (db/<?q db '[:find ?e ?a ?v ?tx :in $ :where [?e ?a ?v ?tx]] {})))))
|
||||||
|
(finally
|
||||||
|
(<? (db/close db)))))))
|
|
@ -3,6 +3,7 @@
|
||||||
[doo.runner :refer-macros [doo-tests doo-all-tests]]
|
[doo.runner :refer-macros [doo-tests doo-all-tests]]
|
||||||
[cljs.test :as t :refer-macros [is are deftest testing]]
|
[cljs.test :as t :refer-macros [is are deftest testing]]
|
||||||
datomish.promise-sqlite-test
|
datomish.promise-sqlite-test
|
||||||
|
datomish.db-test
|
||||||
datomish.sqlite-user-version-test
|
datomish.sqlite-user-version-test
|
||||||
datomish.test.util
|
datomish.test.util
|
||||||
datomish.test.transforms
|
datomish.test.transforms
|
||||||
|
@ -11,6 +12,7 @@
|
||||||
|
|
||||||
(doo-tests
|
(doo-tests
|
||||||
'datomish.promise-sqlite-test
|
'datomish.promise-sqlite-test
|
||||||
|
'datomish.db-test
|
||||||
'datomish.sqlite-user-version-test
|
'datomish.sqlite-user-version-test
|
||||||
'datomish.test.util
|
'datomish.test.util
|
||||||
'datomish.test.transforms
|
'datomish.test.transforms
|
||||||
|
|
|
@ -14,7 +14,7 @@
|
||||||
(let [caught
|
(let [caught
|
||||||
(try
|
(try
|
||||||
(do
|
(do
|
||||||
(util/raise "succeed")
|
(util/raise "succeed" {})
|
||||||
"fail")
|
"fail")
|
||||||
(catch :default e e))]
|
(catch :default e e))]
|
||||||
(is (= "succeed" (aget caught "data"))))))
|
(is (= "succeed" (aget caught "data"))))))
|
||||||
|
|
Loading…
Reference in a new issue