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

Implement type-aware querying. Fixes #14.

Browse source 
* Alter how clauses are concatenated. They now preserve order more accurately.
* Track mappings between vars and extracted type columns.
* Generate type code constraints.
* Push known types down into :not.
* Push known types down into :or.
* Tests and test fixes.
This commit is contained in:
Richard Newman 2016-08-15 14:39:39 -07:00
parent 2529378725
commit 1c6244db5b
11 changed files with 459 additions and 103 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
src/datomish/db.cljc
View file

@ -159,6 +159,7 @@
(defn datoms-source [db] (defn datoms-source [db]
(source/map->DatomsSource (source/map->DatomsSource
{:table :datoms {:table :datoms
:schema (:schema db)
:fulltext-table :fulltext_values :fulltext-table :fulltext_values
:fulltext-view :all_datoms :fulltext-view :all_datoms
:columns [:e :a :v :tx :added] :columns [:e :a :v :tx :added]

5
src/datomish/query.cljc
View file

@ -91,10 +91,11 @@
(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)
(let [external-bindings (in->bindings in)] (let [external-bindings (in->bindings in)
known-types {}]
(assoc context (assoc context
:elements (:elements find) :elements (:elements find)
:cc (clauses/patterns->cc (:default-source context) where external-bindings))))) :cc (clauses/patterns->cc (:default-source context) where known-types external-bindings)))))
(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

98
src/datomish/query/cc.cljc
View file

@ -8,6 +8,7 @@
:refer [attribute-in-source :refer [attribute-in-source
constant-in-source]] constant-in-source]]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]] [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
[honeysql.core :as sql]
[datascript.parser :as dp [datascript.parser :as dp
#?@(:cljs #?@(:cljs
[:refer [:refer
@ -52,27 +53,96 @@
;; ;;
;; `from` is a list of [source alias] pairs, suitable for passing to honeysql. ;; `from` is a list of [source alias] pairs, suitable for passing to honeysql.
;; `bindings` is a map from var to qualified columns. ;; `bindings` is a map from var to qualified columns.
;; `known-types` is a map from var to type keyword.
;; `extracted-types` is a mapping, similar to `bindings`, but used to pull
;; type tags out of the store at runtime.
;; `wheres` is a list of fragments that can be joined by `:and`. ;; `wheres` is a list of fragments that can be joined by `:and`.
(defrecord ConjoiningClauses [source from external-bindings bindings wheres]) (defrecord ConjoiningClauses
[source
from ; [[:datoms 'datoms123]]
external-bindings ; {?var0 (sql/param :foobar)}
bindings ; {?var1 :datoms123.v}
known-types ; {?var1 :db.type/integer}
extracted-types ; {?var2 :datoms123.value_type_tag}
wheres ; [[:= :datoms123.v 15]]
])
(defn bind-column-to-var [cc variable col] (defn bind-column-to-var [cc variable table position]
(let [var (:symbol variable)] (let [var (:symbol variable)
(util/conj-in cc [:bindings var] col))) col (sql/qualify table (name position))
bound (util/append-in cc [:bindings var] col)]
(if (or (not (= position :v))
(contains? (:known-types cc) var)
(contains? (:extracted-types cc) var))
;; Type known; no need to accumulate a type-binding.
bound
(let [tag-col (sql/qualify table :value_type_tag)]
(assoc-in bound [:extracted-types var] tag-col)))))
(defn constrain-column-to-constant [cc col position value] (defn constrain-column-to-constant [cc table position value]
(util/conj-in cc [:wheres] (let [col (sql/qualify table (name position))]
[:= col (if (= :a position) (util/append-in cc
(attribute-in-source (:source cc) value) [:wheres]
(constant-in-source (:source cc) value))])) [:= col (if (= :a position)
(attribute-in-source (:source cc) value)
(constant-in-source (:source cc) value))])))
(defn augment-cc [cc from bindings wheres] (defprotocol ITypeTagged (->tag-codes [x]))
(extend-protocol ITypeTagged
#?@(:cljs
[string (->tag-codes [x] #{4 10 11 12})
Keyword (->tag-codes [x] #{13}) ; TODO: what about idents?
boolean (->tag-codes [x] #{1})
number (->tag-codes [x]
(if (integer? x)
#{0 4 5} ; Could be a ref or a number or a date.
#{4 5}))]) ; Can't be a ref.
#?@(:clj
[String (->tag-codes [x] #{10})
clojure.lang.Keyword (->tag-codes [x] #{13}) ; TODO: what about idents?
Boolean (->tag-codes [x] #{1})
Integer (->tag-codes [x] #{0 5}) ; Could be a ref or a number.
Long (->tag-codes [x] #{0 5}) ; Could be a ref or a number.
Float (->tag-codes [x] #{5})
Double (->tag-codes [x] #{5})
java.util.UUID (->tag-codes [x] #{11})
java.util.Date (->tag-codes [x] #{4})
java.net.URI (->tag-codes [x] #{12})]))
(defn constrain-value-column-to-constant
"Constrain a `v` column. Note that this can contribute *two*
constraints: one for the column itself, and one for the type tag.
We don't need to do this if the attribute is known and thus
constrains the type."
[cc table-alias value]
(let [possible-type-codes (->tag-codes value)
aliased (sql/qualify table-alias (name :value_type_tag))
clauses (map
(fn [code] [:= aliased code])
possible-type-codes)]
(util/concat-in cc [:wheres]
;; Type checks then value checks.
[(case (count clauses)
0 (raise-str "Unexpected number of clauses.")
1 (first clauses)
(cons :or clauses))
[:= (sql/qualify table-alias (name :v))
(constant-in-source (:source cc) value)]])))
(defn augment-cc [cc from bindings extracted-types wheres]
(assoc cc (assoc cc
:from (concat (:from cc) from) :from (concat (:from cc) from)
:bindings (merge-with concat (:bindings cc) bindings) :bindings (merge-with concat (:bindings cc) bindings)
:extracted-types (merge (:extracted-types cc) extracted-types)
:wheres (concat (:wheres cc) wheres))) :wheres (concat (:wheres cc) wheres)))
(defn merge-ccs [left right] (defn merge-ccs [left right]
(augment-cc left (:from right) (:bindings right) (:wheres right))) (augment-cc left
(:from right)
(:bindings right)
(:extracted-types right)
(:wheres right)))
(defn- bindings->where (defn- bindings->where
"Take a bindings map like "Take a bindings map like
@ -115,9 +185,9 @@
(impose-external-bindings (impose-external-bindings
(assoc cc :wheres (assoc cc :wheres
;; Note that the order of clauses here means that cross-pattern var bindings ;; Note that the order of clauses here means that cross-pattern var bindings
;; come first. That's OK: the SQL engine considers these altogether. ;; come last That's OK: the SQL engine considers these altogether.
(concat (bindings->where (:bindings cc)) (concat (:wheres cc)
(:wheres cc))))) (bindings->where (:bindings cc))))))
(defn binding-for-symbol-or-throw [cc symbol] (defn binding-for-symbol-or-throw [cc symbol]
(let [internal-bindings (symbol (:bindings cc)) (let [internal-bindings (symbol (:bindings cc))

102
src/datomish/query/clauses.cljc
View file

@ -7,10 +7,12 @@
[datomish.query.cc :as cc] [datomish.query.cc :as cc]
[datomish.query.functions :as functions] [datomish.query.functions :as functions]
[datomish.query.source [datomish.query.source
:refer [attribute-in-source :refer [pattern->schema-value-type
attribute-in-source
constant-in-source constant-in-source
source->from source->from
source->constraints]] source->constraints]]
[datomish.schema :as schema]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]] [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
[datascript.parser :as dp [datascript.parser :as dp
#?@(:cljs #?@(:cljs
@ -50,18 +52,48 @@
Not->NotJoinClause not-join->where-fragment Not->NotJoinClause not-join->where-fragment
simple-or? simple-or->cc) simple-or? simple-or->cc)
(defn- check-or-apply-value-type [cc value-type pattern-part]
(if (nil? value-type)
cc
(condp instance? pattern-part
Placeholder
cc
Variable
(let [var-sym (:symbol pattern-part)]
(if-let [existing-type (var-sym (:known-types cc))]
(if (= existing-type value-type)
cc
(raise "Var " var-sym " already has type " existing-type "; this pattern wants " value-type
{:pattern pattern-part :value-type value-type}))
(assoc-in cc [:known-types var-sym] value-type)))
Constant
(do
(or (and (= :db.type/ref value-type)
(or (keyword? (:value pattern-part)) ; ident
(integer? (:value pattern-part)))) ; entid
(schema/ensure-value-matches-type value-type (:value pattern-part)))
cc))))
(defn- apply-pattern-clause-for-alias (defn- apply-pattern-clause-for-alias
"This helper assumes that `cc` has already established a table association "This helper assumes that `cc` has already established a table association
for the provided alias." for the provided alias."
[cc alias pattern] [cc alias pattern]
(let [places (map vector (let [pattern (:pattern pattern)
(:pattern pattern) columns (:columns (:source cc))
(:columns (:source cc)))] places (map vector pattern columns)
value-type (pattern->schema-value-type (:source cc) pattern)] ; Optional; e.g., :db.type/string
(reduce (reduce
(fn [cc (fn [cc
[pattern-part ; ?x, :foo/bar, 42 [pattern-part ; ?x, :foo/bar, 42
position]] ; :a position]] ; :a
(let [col (sql/qualify alias (name position))] ; :datoms123.a (let [cc (case position
;; TODO: we should be able to constrain :e and :a to be
;; entities... but the type checker expects that to be an int.
:v (check-or-apply-value-type cc value-type pattern-part)
:e (check-or-apply-value-type cc :db.type/ref pattern-part)
cc)]
(condp instance? pattern-part (condp instance? pattern-part
;; Placeholders don't contribute any bindings, nor do ;; Placeholders don't contribute any bindings, nor do
;; they constrain the query -- there's no need to produce ;; they constrain the query -- there's no need to produce
@ -70,10 +102,16 @@
cc cc
Variable Variable
(cc/bind-column-to-var cc pattern-part col) (cc/bind-column-to-var cc pattern-part alias position)
Constant Constant
(cc/constrain-column-to-constant cc col position (:value pattern-part)) (if (and (nil? value-type)
(= position :v))
;; If we don't know the type, but we have a constant, generate
;; a :wheres clause constraining the accompanying value_type_tag
;; column.
(cc/constrain-value-column-to-constant cc alias (:value pattern-part))
(cc/constrain-column-to-constant cc alias position (:value pattern-part)))
(raise "Unknown pattern part." {:part pattern-part :clause pattern})))) (raise "Unknown pattern part." {:part pattern-part :clause pattern}))))
@ -105,7 +143,7 @@
(apply-pattern-clause-for-alias (apply-pattern-clause-for-alias
;; Record the new table mapping. ;; Record the new table mapping.
(util/conj-in cc [:from] [table alias]) (util/append-in cc [:from] [table alias])
;; Use the new alias for columns. ;; Use the new alias for columns.
alias alias
@ -124,7 +162,7 @@
(raise-str "Unknown function " (:fn predicate))) (raise-str "Unknown function " (:fn predicate)))
(let [args (map (partial cc/argument->value cc) (:args predicate))] (let [args (map (partial cc/argument->value cc) (:args predicate))]
(util/conj-in cc [:wheres] (cons f args))))) (util/append-in cc [:wheres] (cons f args)))))
(defn apply-not-clause [cc not] (defn apply-not-clause [cc not]
(when-not (instance? Not not) (when-not (instance? Not not)
@ -136,13 +174,19 @@
;; fragment, and include the external bindings so that they match up. ;; 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: ;; Otherwise, we need to delay. Right now we're lazy, so we just fail:
;; reorder your query yourself. ;; reorder your query yourself.
(util/conj-in cc [:wheres] ;;
(not-join->where-fragment ;; Note that we don't extract and reuse any types established inside
(Not->NotJoinClause (:source cc) ;; the `not` clause: perhaps those won't make sense outside. But it's
(merge-with concat ;; a filter, so we push the external types _in_.
(:external-bindings cc) (util/append-in cc
(:bindings cc)) [:wheres]
not)))) (not-join->where-fragment
(Not->NotJoinClause (:source cc)
(:known-types cc)
(merge-with concat
(:external-bindings cc)
(:bindings cc))
not))))
(defn apply-or-clause [cc orc] (defn apply-or-clause [cc orc]
(when-not (instance? Or orc) (when-not (instance? Or orc)
@ -163,6 +207,7 @@
(if (simple-or? orc) (if (simple-or? orc)
(cc/merge-ccs cc (simple-or->cc (:source cc) (cc/merge-ccs cc (simple-or->cc (:source cc)
(:known-types cc)
(merge-with concat (merge-with concat
(:external-bindings cc) (:external-bindings cc)
(:bindings cc)) (:bindings cc))
@ -200,12 +245,14 @@
[cc patterns] [cc patterns]
(reduce apply-clause cc patterns)) (reduce apply-clause cc patterns))
(defn patterns->cc [source patterns external-bindings] (defn patterns->cc [source patterns known-types external-bindings]
(cc/expand-where-from-bindings (cc/expand-where-from-bindings
(expand-pattern-clauses (expand-pattern-clauses
(cc/map->ConjoiningClauses (cc/map->ConjoiningClauses
{:source source {:source source
:from [] :from []
:known-types (or known-types {})
:extracted-types {}
:external-bindings (or external-bindings {}) :external-bindings (or external-bindings {})
:bindings {} :bindings {}
:wheres []}) :wheres []})
@ -230,13 +277,12 @@
;; that a declared variable list is valid for the clauses given. ;; that a declared variable list is valid for the clauses given.
(defrecord NotJoinClause [unify-vars cc]) (defrecord NotJoinClause [unify-vars cc])
(defn make-not-join-clause [source external-bindings unify-vars patterns] (defn Not->NotJoinClause [source known-types external-bindings not]
(->NotJoinClause unify-vars (patterns->cc source patterns external-bindings)))
(defn Not->NotJoinClause [source external-bindings not]
(when-not (instance? DefaultSrc (:source not)) (when-not (instance? DefaultSrc (:source not))
(raise "Non-default sources are not supported in `not` clauses." {:clause not})) (raise "Non-default sources are not supported in `not` clauses." {:clause not}))
(make-not-join-clause source external-bindings (:vars not) (:clauses not))) (map->NotJoinClause
{:unify-vars (:vars not)
:cc (patterns->cc source (:clauses not) known-types external-bindings)}))
(defn not-join->where-fragment [not-join] (defn not-join->where-fragment [not-join]
[:not [:not
@ -288,15 +334,17 @@
(defn simple-or->cc (defn simple-or->cc
"The returned CC has not yet had bindings expanded." "The returned CC has not yet had bindings expanded."
[source external-bindings orc] [source known-types external-bindings orc]
(validate-or-clause orc) (validate-or-clause orc)
;; We 'fork' a CC for each pattern, then union them together. ;; We 'fork' a CC for each pattern, then union them together.
;; We need to build the first in order that the others use the same ;; We need to build the first in order that the others use the same
;; column names. ;; column names and known types.
(let [cc (cc/map->ConjoiningClauses (let [cc (cc/map->ConjoiningClauses
{:source source {:source source
:from [] :from []
:known-types (or known-types {})
:extracted-types {}
:external-bindings (or external-bindings {}) :external-bindings (or external-bindings {})
:bindings {} :bindings {}
:wheres []}) :wheres []})
@ -307,6 +355,9 @@
;; That was easy. ;; That was easy.
primary primary
;; Note that for a simple `or` clause, the same template is used for each,
;; so we can simply use the `extracted-types` bindings from `primary`.
;; A complex `or` is much harder to handle.
(let [template (assoc primary :wheres []) (let [template (assoc primary :wheres [])
alias (second (first (:from template))) alias (second (first (:from template)))
ccs (map (partial apply-pattern-clause-for-alias template alias) ccs (map (partial apply-pattern-clause-for-alias template alias)
@ -315,7 +366,8 @@
;; Because this is a simple clause, we know that the first pattern established ;; Because this is a simple clause, we know that the first pattern established
;; any necessary bindings. ;; any necessary bindings.
;; Take any new :wheres from each CC and combine them with :or. ;; Take any new :wheres from each CC and combine them with :or.
(assoc primary :wheres (assoc primary
:wheres
[(cons :or [(cons :or
(reduce (fn [acc cc] (reduce (fn [acc cc]
(let [w (:wheres cc)] (let [w (:wheres cc)]

23
src/datomish/query/projection.cljc
View file

@ -35,13 +35,26 @@
@param context A Context, containing elements. @param context A Context, containing elements.
@return a sequence of pairs." @return a sequence of pairs."
[context] [context]
(def foo context) (let [elements (:elements context)
(let [elements (:elements context)] cc (:cc context)
known-types (:known-types cc)
extracted-types (:extracted-types cc)]
(when-not (every? #(instance? Variable %1) elements) (when-not (every? #(instance? Variable %1) elements)
(raise-str "Unable to :find non-variables.")) (raise-str "Unable to :find non-variables."))
(map (fn [elem]
(let [var (:symbol elem)] ;; If the type of a variable isn't explicitly known, we also select
[(lookup-variable (:cc context) var) (util/var->sql-var var)])) ;; its type column so we can transform it.
(mapcat (fn [elem]
(let [var (:symbol elem)
lookup-var (lookup-variable cc var)
projected-var (util/var->sql-var var)
var-projection [lookup-var projected-var]]
(if (or (contains? known-types var)
(not (contains? extracted-types var)))
[var-projection]
[var-projection [(get extracted-types var)
(util/var->sql-type-var var)]])))
elements))) elements)))
(defn row-pair-transducer [context] (defn row-pair-transducer [context]

16
src/datomish/query/source.cljc
View file

@ -5,6 +5,7 @@
(ns datomish.query.source (ns datomish.query.source
(:require (:require
[datomish.query.transforms :as transforms] [datomish.query.transforms :as transforms]
[datomish.schema :as schema]
[datascript.parser [datascript.parser
#?@(:cljs #?@(:cljs
[:refer [Variable Constant Placeholder]])]) [:refer [Variable Constant Placeholder]])])
@ -39,6 +40,7 @@
(source->fulltext-from [source] (source->fulltext-from [source]
"Returns a pair, `[table alias]` for querying the source's fulltext index.") "Returns a pair, `[table alias]` for querying the source's fulltext index.")
(source->constraints [source alias]) (source->constraints [source alias])
(pattern->schema-value-type [source pattern])
(attribute-in-source [source attribute]) (attribute-in-source [source attribute])
(constant-in-source [source constant])) (constant-in-source [source constant]))
@ -48,6 +50,7 @@
fulltext-table ; Typically :fulltext_values fulltext-table ; Typically :fulltext_values
fulltext-view ; Typically :all_datoms fulltext-view ; Typically :all_datoms
columns ; e.g., [:e :a :v :tx] columns ; e.g., [:e :a :v :tx]
schema ; An ISchema instance.
;; `attribute-transform` is a function from attribute to constant value. Used to ;; `attribute-transform` is a function from attribute to constant value. Used to
;; turn, e.g., :p/attribute into an interned integer. ;; turn, e.g., :p/attribute into an interned integer.
@ -88,6 +91,19 @@
(when-let [f (:make-constraints source)] (when-let [f (:make-constraints source)]
(f alias))) (f alias)))
(pattern->schema-value-type [source pattern]
(let [[_ a v _] pattern
schema (:schema (:schema source))]
(when (instance? Constant a)
(let [val (:value a)]
(if (keyword? val)
;; We need to find the entid for the keyword attribute,
;; because the schema stores attributes by ID.
(let [id (attribute-in-source source val)]
(get-in schema [id :db/valueType]))
(when (integer? val)
(get-in schema [val :db/valueType])))))))
(attribute-in-source [source attribute] (attribute-in-source [source attribute]
((:attribute-transform source) attribute)) ((:attribute-transform source) attribute))

19
src/datomish/schema.cljc
View file

@ -105,12 +105,26 @@
:db.type/string { :valid? string? } :db.type/string { :valid? string? }
:db.type/boolean { :valid? #?(:clj #(instance? Boolean %) :cljs #(= js/Boolean (type %))) } :db.type/boolean { :valid? #?(:clj #(instance? Boolean %) :cljs #(= js/Boolean (type %))) }
:db.type/long { :valid? integer? } :db.type/long { :valid? integer? }
:db.type/uuid { :valid? #?(:clj #(instance? java.util.UUID %) :cljs string?) }
:db.type/instant { :valid? #?(:clj #(instance? java.util.Date %) :cljs #(= js/Date (type %))) }
:db.type/uri { :valid? #?(:clj #(instance? java.net.URI %) :cljs string?) }
:db.type/double { :valid? #?(:clj float? :cljs number?) } :db.type/double { :valid? #?(:clj float? :cljs number?) }
}) })
(defn #?@(:clj [^Boolean ensure-value-matches-type]
:cljs [^boolean ensure-value-matches-type]) [type value]
(if-let [valid? (get-in value-type-map [type :valid?])]
(when-not (valid? value)
(raise "Invalid value for type " type "; got " value
{:error :schema/valueType, :type type, :value value}))
(raise "Unknown valueType " type ", expected one of " (sorted-set (keys value-type-map))
{:error :schema/valueType, :type type})))
;; There's some duplication here so we get better error messages.
(defn #?@(:clj [^Boolean ensure-valid-value] (defn #?@(:clj [^Boolean ensure-valid-value]
:cljs [^boolean ensure-valid-value]) [schema attr value] :cljs [^boolean ensure-valid-value]) [schema attr value]
{:pre [(schema? schema)]} {:pre [(schema? schema)
(integer? attr)]}
(let [schema (.-schema schema)] (let [schema (.-schema schema)]
(if-let [valueType (get-in schema [attr :db/valueType])] (if-let [valueType (get-in schema [attr :db/valueType])]
(if-let [valid? (get-in value-type-map [valueType :valid?])] (if-let [valid? (get-in value-type-map [valueType :valid?])]
@ -123,7 +137,8 @@
{:error :schema/valueType, :attribute attr})))) {:error :schema/valueType, :attribute attr}))))
(defn ->SQLite [schema attr value] (defn ->SQLite [schema attr value]
{:pre [(schema? schema)]} {:pre [(schema? schema)
(integer? attr)]}
(let [schema (.-schema schema)] (let [schema (.-schema schema)]
(if-let [valueType (get-in schema [attr :db/valueType])] (if-let [valueType (get-in schema [attr :db/valueType])]
(if-let [valid? (get-in value-type-map [valueType :valid?])] (if-let [valid? (get-in value-type-map [valueType :valid?])]

2
src/datomish/sqlite_schema.cljc
View file

@ -248,7 +248,7 @@
(case tag (case tag
0 value ; ref. 0 value ; ref.
1 (= value 1) ; boolean 1 (= value 1) ; boolean
4 (new Date value) ; instant 4 (js/Date. value) ; instant
13 (keyword (subs value 1)) ; keyword 13 (keyword (subs value 1)) ; keyword
; 12 value ; URI ; 12 value ; URI
; 11 value ; UUID ; 11 value ; UUID

31
src/datomish/util.cljc
View file

@ -30,6 +30,14 @@
~expr ~expr
(cond-let ~@rest))))) (cond-let ~@rest)))))
(defn var->sql-type-var
"Turns '?xyz into :_xyz_type_tag."
[x]
(if (and (symbol? x)
(str/starts-with? (name x) "?"))
(keyword (str "_" (subs (name x) 1) "_type_tag"))
(throw (ex-info (str x " is not a Datalog var.") {}))))
(defn var->sql-var (defn var->sql-var
"Turns '?xyz into :xyz." "Turns '?xyz into :xyz."
[x] [x]
@ -38,18 +46,6 @@
(keyword (subs (name x) 1)) (keyword (subs (name x) 1))
(throw (ex-info (str x " is not a Datalog var.") {})))) (throw (ex-info (str x " is not a Datalog var.") {}))))
(defn conj-in
"Associates a value into a sequence in a nested associative structure, where
ks is a sequence of keys and v is the new value, and returns a new nested
structure.
If any levels do not exist, hash-maps will be created. If the destination
sequence does not exist, a new one is created."
{:static true}
[m [k & ks] v]
(if ks
(assoc m k (conj-in (get m k) ks v))
(assoc m k (conj (get m k) v))))
(defn concat-in (defn concat-in
{:static true} {:static true}
[m [k & ks] vs] [m [k & ks] vs]
@ -57,6 +53,17 @@
(assoc m k (concat-in (get m k) ks vs)) (assoc m k (concat-in (get m k) ks vs))
(assoc m k (concat (get m k) vs)))) (assoc m k (concat (get m k) vs))))
(defn append-in
"Associates a value into a sequence in a nested associative structure, where
ks is a sequence of keys and v is the new value, and returns a new nested
structure.
Always puts the value last.
If any levels do not exist, hash-maps will be created. If the destination
sequence does not exist, a new one is created."
{:static true}
[m path v]
(concat-in m path [v]))
(defmacro while-let [binding & forms] (defmacro while-let [binding & forms]
`(loop [] `(loop []
(when-let ~binding (when-let ~binding

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

@ -4,6 +4,7 @@
[datomish.query.source :as source] [datomish.query.source :as source]
[datomish.query.transforms :as transforms] [datomish.query.transforms :as transforms]
[datomish.query :as query] [datomish.query :as query]
[datomish.schema :as schema]
#?@(:clj #?@(:clj
[ [
[honeysql.core :as sql :refer [param]] [honeysql.core :as sql :refer [param]]
@ -12,7 +13,9 @@
[ [
[honeysql.core :as sql :refer-macros [param]] [honeysql.core :as sql :refer-macros [param]]
[cljs.test :as t :refer-macros [is are deftest testing]]]) [cljs.test :as t :refer-macros [is are deftest testing]]])
)) )
#?(:clj
(:import [clojure.lang ExceptionInfo])))
(defn- fgensym [s c] (defn- fgensym [s c]
(symbol (str s c))) (symbol (str s c)))
@ -25,7 +28,18 @@
([s] ([s]
(fgensym s (dec (swap! counter inc))))))) (fgensym s (dec (swap! counter inc)))))))
(defn mock-source [db] (def simple-schema
{:db/txInstant {:db/ident :db/txInstant
:db/valueType :long
:db/cardinality :db.cardinality/one}
:foo/int {:db/ident :foo/int
:db/valueType :db.type/integer
:db/cardinality :db.cardinality/one}
:foo/str {:db/ident :foo/str
:db/valueType :db.type/string
:db/cardinality :db.cardinality/many}})
(defn mock-source [db schema]
(source/map->DatomsSource (source/map->DatomsSource
{:table :datoms {:table :datoms
:fulltext-table :fulltext_values :fulltext-table :fulltext_values
@ -34,39 +48,105 @@
:attribute-transform transforms/attribute-transform-string :attribute-transform transforms/attribute-transform-string
:constant-transform transforms/constant-transform-default :constant-transform transforms/constant-transform-default
:table-alias (comp (make-predictable-gensym) name) :table-alias (comp (make-predictable-gensym) name)
:schema (schema/map->Schema
{:schema schema
:rschema nil})
:make-constraints nil})) :make-constraints nil}))
(defn- expand [find] (defn- expand [find schema]
(let [context (context/->Context (mock-source nil) nil nil) (let [context (context/->Context (mock-source nil schema) nil nil)
parsed (query/parse find)] parsed (query/parse find)]
(query/find->sql-clause context parsed))) (query/find->sql-clause context parsed)))
(deftest test-basic-join (defn- populate [find schema]
(is (= {:select '([:datoms1.v :timestampMicros] [:datoms0.e :page]), (let [context (context/->Context (mock-source nil schema) nil nil)
:modifiers [:distinct], parsed (query/parse find)]
:from '[[:datoms datoms0] (query/find-into-context context parsed)))
[:datoms datoms1]],
:where (list
:and
[:= :datoms1.e :datoms0.tx]
[:= :datoms0.a "page/starred"]
[:= :datoms0.v 1]
[:= :datoms1.a "db/txInstant"]
[:not
(list :and (list :> :datoms1.e (sql/param :latest)))])}
(expand
'[:find ?timestampMicros ?page :in $ ?latest :where
[?page :page/starred true ?t]
[?t :db/txInstant ?timestampMicros]
(not [(> ?t ?latest)])]))))
(deftest test-pattern-not-join (deftest test-type-extraction
(is (= '{:select ([:datoms1.v :timestampMicros] [:datoms0.e :page]), (testing "Variable entity."
(is (= (:known-types (:cc (populate '[:find ?e ?v :in $ :where [?e :foo/int ?v]] simple-schema)))
{'?v :db.type/integer
'?e :db.type/ref})))
(testing "Numeric entid."
(is (= (:known-types (:cc (populate '[:find ?v :in $ :where [6 :foo/int ?v]] simple-schema)))
{'?v :db.type/integer})))
(testing "Keyword entity."
(is (= (:known-types (:cc (populate '[:find ?v :in $ :where [:my/thing :foo/int ?v]] simple-schema)))
{'?v :db.type/integer}))))
(deftest test-value-constant-constraint-descends-into-not-and-or
(testing "Elision of types inside a join."
(is (= '{:select ([:datoms0.e :e]
[:datoms0.v :v]),
:modifiers [:distinct],
:from [[:datoms datoms0]],
:where (:and
[:= :datoms0.a "foo/int"]
[:not
[:exists
{:select [1],
:from [[:all_datoms all_datoms1]],
:where (:and
[:= :all_datoms1.e 15]
[:= :datoms0.v :all_datoms1.v])}]])}
(expand
'[:find ?e ?v :in $ :where
[?e :foo/int ?v]
(not [15 ?a ?v])]
simple-schema))))
(testing "Type collisions inside :not."
(is (thrown-with-msg?
ExceptionInfo #"\?v already has type :db\.type\/integer"
(expand
'[:find ?e ?v :in $ :where
[?e :foo/int ?v]
(not [15 :foo/str ?v])]
simple-schema))))
(testing "Type collisions inside :or"
(is (thrown-with-msg?
ExceptionInfo #"\?v already has type :db\.type\/integer"
(expand
'[:find ?e ?v :in $ :where
[?e :foo/int ?v]
(or
[15 :foo/str ?v]
[10 :foo/int ?v])]
simple-schema)))))
(deftest test-type-collision
(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\/integer"
(populate find simple-schema)))))
(deftest test-value-constant-constraint
(is (= {:select '([:all_datoms0.e :foo]),
:modifiers [:distinct],
:from '[[:all_datoms all_datoms0]],
:where (list :and
(list :or
[:= :all_datoms0.value_type_tag 0]
[:= :all_datoms0.value_type_tag 5])
[:= :all_datoms0.v 99])}
(expand
'[:find ?foo :in $ :where
[?foo _ 99]]
simple-schema))))
(deftest test-value-constant-constraint-elided-using-schema
(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], :modifiers [:distinct],
:from [[:datoms datoms0] :from [[:datoms datoms0]
[:datoms datoms1]], [:datoms datoms1]],
:where (:and :where (:and
[:= :datoms1.e :datoms0.tx] ;; We don't need a type check on the range of page/starred...
[:= :datoms0.a "page/starred"] [:= :datoms0.a "page/starred"]
[:= :datoms0.v 1] [:= :datoms0.v 1]
[:= :datoms1.a "db/txInstant"] [:= :datoms1.a "db/txInstant"]
@ -76,12 +156,65 @@
:from [[:datoms datoms2]], :from [[:datoms datoms2]],
:where (:and :where (:and
[:= :datoms2.a "foo/bar"] [:= :datoms2.a "foo/bar"]
[:= :datoms0.e :datoms2.e])}]])} [:= :datoms0.e :datoms2.e])}]]
[:= :datoms0.tx :datoms1.e])}
(expand (expand
'[:find ?timestampMicros ?page :in $ ?latest :where '[:find ?timestampMicros ?page :in $ ?latest :where
[?page :page/starred true ?t] [?page :page/starred true ?t]
[?t :db/txInstant ?timestampMicros] [?t :db/txInstant ?timestampMicros]
(not [?page :foo/bar _])])))) (not [?page :foo/bar _])]
(merge
simple-schema
{:page/starred {:db/valueType :db.type/boolean
:db/ident :page/starred
:db/cardinality :db.cardinality/one}}))))))
(deftest test-basic-join
(is (= {:select '([:datoms1.v :timestampMicros] [:datoms0.e :page]),
:modifiers [:distinct],
:from '[[:datoms datoms0]
[:datoms datoms1]],
:where (list
:and
[:= :datoms0.a "page/starred"]
[:= :datoms0.value_type_tag 1] ; boolean
[:= :datoms0.v 1]
[:= :datoms1.a "db/txInstant"]
[: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)])]
simple-schema))))
(deftest test-pattern-not-join
(is (= '{:select ([:datoms1.v :timestampMicros] [:datoms0.e :page]),
:modifiers [:distinct],
:from [[:datoms datoms0]
[:datoms datoms1]],
:where (:and
[:= :datoms0.a "page/starred"]
[:= :datoms0.value_type_tag 1] ; boolean
[:= :datoms0.v 1]
[:= :datoms1.a "db/txInstant"]
[:not
[:exists
{:select [1],
:from [[:datoms datoms2]],
:where (:and
[:= :datoms2.a "foo/bar"]
[:= :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 _])]
simple-schema))))
;; Note that clause ordering is not directly correlated to the output: cross-bindings end up ;; 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`. ;; at the front. The SQL engine will do its own analysis. See `clauses/expand-where-from-bindings`.
@ -92,17 +225,20 @@
[:datoms datoms1]], [:datoms datoms1]],
:where (list :where (list
:and :and
[:= :datoms1.e :datoms0.tx]
[:= :datoms0.a "page/starred"] [:= :datoms0.a "page/starred"]
[:= :datoms0.value_type_tag 1] ; boolean
[:= :datoms0.v 1] [:= :datoms0.v 1]
[:not [:not
(list :and (list :> :datoms0.tx (sql/param :latest)))] (list :and (list :> :datoms0.tx (sql/param :latest)))]
[:= :datoms1.a "db/txInstant"])} [:= :datoms1.a "db/txInstant"]
[:= :datoms0.tx :datoms1.e]
)}
(expand (expand
'[:find ?timestampMicros ?page :in $ ?latest :where '[:find ?timestampMicros ?page :in $ ?latest :where
[?page :page/starred true ?t] [?page :page/starred true ?t]
(not [(> ?t ?latest)]) (not [(> ?t ?latest)])
[?t :db/txInstant ?timestampMicros]])))) [?t :db/txInstant ?timestampMicros]]
simple-schema))))
(deftest test-pattern-not-join-ordering-preserved (deftest test-pattern-not-join-ordering-preserved
(is (= '{:select ([:datoms2.v :timestampMicros] [:datoms0.e :page]), (is (= '{:select ([:datoms2.v :timestampMicros] [:datoms0.e :page]),
@ -110,8 +246,8 @@
:from [[:datoms datoms0] :from [[:datoms datoms0]
[:datoms datoms2]], [:datoms datoms2]],
:where (:and :where (:and
[:= :datoms2.e :datoms0.tx]
[:= :datoms0.a "page/starred"] [:= :datoms0.a "page/starred"]
[:= :datoms0.value_type_tag 1] ; boolean
[:= :datoms0.v 1] [:= :datoms0.v 1]
[:not [:not
[:exists [:exists
@ -121,48 +257,77 @@
[:= :datoms1.a "foo/bar"] [:= :datoms1.a "foo/bar"]
[:= :datoms0.e :datoms1.e])}]] [:= :datoms0.e :datoms1.e])}]]
[:= :datoms2.a "db/txInstant"] [:= :datoms2.a "db/txInstant"]
[:= :datoms0.tx :datoms2.e]
)} )}
(expand (expand
'[:find ?timestampMicros ?page :in $ ?latest :where '[:find ?timestampMicros ?page :in $ ?latest :where
[?page :page/starred true ?t] [?page :page/starred true ?t]
(not [?page :foo/bar _]) (not [?page :foo/bar _])
[?t :db/txInstant ?timestampMicros]])))) [?t :db/txInstant ?timestampMicros]]
simple-schema))))
(deftest test-single-or (deftest test-single-or
(is (= '{:select ([:datoms1.e :page]), (is (= '{:select ([:datoms0.e :page]),
:modifiers [:distinct], :modifiers [:distinct],
:from ([:datoms datoms0] [:datoms datoms1] [:datoms datoms2]), :from ([:datoms datoms0] [:datoms datoms1] [:datoms datoms2]),
:where (:and :where (:and
[:= :datoms1.e :datoms0.e]
[:= :datoms1.e :datoms2.v]
[:= :datoms0.a "page/url"] [:= :datoms0.a "page/url"]
[:= :datoms0.value_type_tag 10]
[:= :datoms0.v "http://example.com/"] [:= :datoms0.v "http://example.com/"]
[:= :datoms1.a "page/title"] [:= :datoms1.a "page/title"]
[:= :datoms2.a "page/loves"])} [:= :datoms2.a "page/loves"]
[:= :datoms0.e :datoms1.e]
[:= :datoms0.e :datoms2.v])}
(expand (expand
'[:find ?page :in $ ?latest :where '[:find ?page :in $ ?latest :where
[?page :page/url "http://example.com/"] [?page :page/url "http://example.com/"]
[?page :page/title ?title] [?page :page/title ?title]
(or (or
[?entity :page/loves ?page])])))) [?entity :page/loves ?page])]
simple-schema))))
(deftest test-simple-or (deftest test-simple-or
(is (= '{:select ([:datoms1.e :page]), (is (= '{:select ([:datoms0.e :page]),
:modifiers [:distinct], :modifiers [:distinct],
:from ([:datoms datoms0] [:datoms datoms1] [:datoms datoms2]), :from ([:datoms datoms0] [:datoms datoms1] [:datoms datoms2]),
:where (:and :where (:and
[:= :datoms1.e :datoms0.e]
[:= :datoms1.e :datoms2.v]
[:= :datoms0.a "page/url"] [:= :datoms0.a "page/url"]
[:= :datoms0.value_type_tag 10]
[:= :datoms0.v "http://example.com/"] [:= :datoms0.v "http://example.com/"]
[:= :datoms1.a "page/title"] [:= :datoms1.a "page/title"]
(:or (:or
[:= :datoms2.a "page/likes"] [:= :datoms2.a "page/likes"]
[:= :datoms2.a "page/loves"]))} [:= :datoms2.a "page/loves"])
[:= :datoms0.e :datoms1.e]
[:= :datoms0.e :datoms2.v])}
(expand (expand
'[:find ?page :in $ ?latest :where '[:find ?page :in $ ?latest :where
[?page :page/url "http://example.com/"] [?page :page/url "http://example.com/"]
[?page :page/title ?title] [?page :page/title ?title]
(or (or
[?entity :page/likes ?page] [?entity :page/likes ?page]
[?entity :page/loves ?page])])))) [?entity :page/loves ?page])]
simple-schema))))
(deftest test-tag-projection
(is (= '{:select ([:datoms0.e :page]
[:datoms1.v :thing]
[:datoms1.value_type_tag :_thing_type_tag]),
:modifiers [:distinct],
:from ([:datoms datoms0]
[:datoms datoms1]),
:where (:and
[:= :datoms0.a "page/url"]
[:= :datoms0.value_type_tag 10]
[:= :datoms0.v "http://example.com/"]
(:or
[:= :datoms1.a "page/likes"]
[:= :datoms1.a "page/loves"])
[:= :datoms0.e :datoms1.e])}
(expand
'[:find ?page ?thing :in $ ?latest :where
[?page :page/url "http://example.com/"]
(or
[?page :page/likes ?thing]
[?page :page/loves ?thing])]
simple-schema))))

16
test/datomish/test/util.cljc
View file

@ -9,6 +9,22 @@
(is (= :x (util/var->sql-var '?x))) (is (= :x (util/var->sql-var '?x)))
(is (= :XX (util/var->sql-var '?XX)))) (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 #?(:cljs
(deftest test-raise (deftest test-raise
(let [caught (let [caught