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

Implement negation, predicates, external scalar bindings, <?q. r=nalexander

Browse source
This commit is contained in:
Richard Newman 2016-07-19 22:38:52 -07:00
parent 9ae9a0572b
commit 42361c1e5e
16 changed files with 560 additions and 275 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/datomish/core.cljs
View file

@ -1,3 +1,7 @@
;; 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.core
(:require [cljs.nodejs :as nodejs]))

48
src/datomish/db.cljc
View file

@ -8,25 +8,63 @@
[datomish.pair-chan :refer [go-pair <?]]
[cljs.core.async.macros :refer [go]]))
(:require
[datomish.util :as util :refer [raise]]
[datomish.query.context :as context]
[datomish.query.projection :as projection]
[datomish.query.source :as source]
[datomish.query :as query]
[datomish.sqlite :as s]
[datomish.sqlite-schema :as sqlite-schema]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str]]
#?@(: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.core.async :as a :refer [<! >!]]])))
[cljs.core.async :as a :refer [chan <! >!]]])))
(defprotocol IDB
(query-context
[db])
(close
[db]
"Close this database. Returns a pair channel of [nil error]."))
(defrecord DB [sqlite-connection]
IDB
(close [db] (close (.-sqlite-connection 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]
(go-pair
(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)))
(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)))

40
src/datomish/exec.cljc
View file

@ -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))

20
src/datomish/exec_repl.cljc
View file

@ -9,6 +9,7 @@
[datomish.pair-chan :refer [go-pair <?]]
[cljs.core.async.macros :refer [go]]))
(:require
[datomish.db :as db]
[datomish.exec :as exec]
[datomish.sqlite :as s]
[datomish.sqlite-schema :as ss]
@ -41,7 +42,7 @@
[db find]
(pair-channel->lazy-seq (exec/<?run db find))))
#_(defn xxopen []
(defn xxopen []
(datomish.pair-chan/go-pair
(let [d (datomish.pair-chan/<? (s/<sqlite-connection "/tmp/foo.sqlite"))]
(clojure.core.async/<!! (ss/<ensure-current-version d))
@ -58,13 +59,10 @@
"/tmp/foo.sqlite"
'[:find ?page :in $ :where [?page :page/starred true ?t]]))
#_(defn test-run []
(datomish.pair-chan/go-pair
(let [d (datomish.pair-chan/<? (s/<sqlite-connection "/tmp/foo.sqlite"))]
(<! (ss/<ensure-current-version d))
(let [chan (exec/<?run d
'[:find ?page :in $ :where [?page :page/starred true ?t]])]
(println (datomish.pair-chan/<? chan))
(println (datomish.pair-chan/<? chan))
(println (datomish.pair-chan/<? chan))
(s/close d)))))
#_
(go-pair
(let [connection (<? (s/<sqlite-connection "/tmp/foo.sqlite"))
d (<? (db/<with-sqlite-connection connection))]
(println
"Result: "
(<! (db/<?q d '[:find ?page :in $ :where [?page :page/starred true ?t]] {})))))

292
src/datomish/query.cljc
View file

@ -4,184 +4,50 @@
(ns datomish.query
(:require
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
[datomish.transforms :as transforms]
[datomish.query.clauses :as clauses]
[datomish.query.context :as context]
[datomish.query.projection :as projection]
[datomish.query.transforms :as transforms]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise-str cond-let]]
[datascript.parser :as dp
#?@(:cljs [:refer [Pattern DefaultSrc Variable Constant Placeholder]])]
#?@(:cljs
[:refer [
BindScalar
Constant
DefaultSrc
Pattern
Placeholder
SrcVar
Variable
]])]
[clojure.string :as str]
[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,
;; but not automatically safe for use.
(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]
(merge
{:select (sql-projection context)
:from (:from context)}
(if (empty? (:wheres context))
{}
{:where (cons :and (:wheres context))})))
{:select (projection/sql-projection context)
;; Always SELECT DISTINCT, because Datalog is set-based.
;; TODO: determine from schema analysis whether we can avoid
;; the need to do this.
:modifiers [:distinct]}
(clauses/cc->partial-subquery (:cc context))))
(defn context->sql-string [context]
(->
@ -191,43 +57,65 @@
(defn- validate-with [with]
(when-not (nil? with)
(raise "`with` not supported.")))
(raise-str "`with` not supported.")))
(defn- validate-in [in]
(when-not (and (== 1 (count in))
(= "$" (name (-> in first :variable :symbol))))
(raise (str "Complex `in` not supported: " (print-str in)))))
(when (nil? in)
(raise-str ":in expression cannot be nil."))
(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]
;; 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.
(defn in->bindings
"Take an `:in` list and return a bindings map suitable for use
as external bindings in a CC."
[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.
(validate-with with)
(validate-in in)
(apply-elements-to-context
(expand-where-from-bindings
(expand-patterns-into-context context where)) ; 'where' here is the Datalog :where clause.
(:elements find))))
(let [external-bindings (in->bindings in)]
(assoc context
:elements (: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
"Take a parsed `find` expression and turn it into a structured SQL
expression that can be formatted by honeysql."
[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
(expand-find-into-context context)
(find-into-context context)
context->sql-clause))
(defn find->sql-string
"Take a parsed `find` expression and turn it into SQL."
[context find]
(->>
find
(find->sql-clause context)
(sql/format :quoting sql-quoting-style)))
[context find args]
(->
(find->sql-clause context find)
(sql/format args :quoting sql-quoting-style)))
(defn parse
"Parse a Datalog query array into a structured `find` expression."
@ -235,27 +123,13 @@
(dp/parse-query q))
(comment
(def sql-quoting-style nil)
(datomish.query/find->sql-string
(datomish.query.context/->Context (datomish.query.source/datoms-source nil) nil nil)
(datomish.query/parse
'[:find ?page :in $ :where [?page :page/starred true ?t] ])))
(comment
(datomish.query/find->prepared-context
(datomish.query/parse
'[:find ?timestampMicros ?page
:in $
:where
'[:find ?timestampMicros ?page :in $ ?latest :where
[?page :page/starred true ?t]
[?t :db/txInstant ?timestampMicros]])))
(comment
(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))
[?t :db/txInstant ?timestampMicros]
(not [(> ?t ?latest)]) ])
{:latest 5})
)

267
src/datomish/query/clauses.cljc Normal file
View file

@ -0,0 +1,267 @@
;; 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.query.clauses
(:require
[datomish.query.source
:refer [attribute-in-source
constant-in-source
source->from
source->constraints]]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise 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 ConjoiningClauses (CC) is a collection of clauses that are combined with JOIN.
;; The topmost form in a query is a ConjoiningClauses.
;;
;;---------------------------------------------------------------------------------------
;; Done:
;; - Ordinary pattern clauses turn into FROM parts and WHERE parts using :=.
;; - Predicate clauses turn into the same, but with other functions.
;; - `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.
;;
;; Not yet done:
;; - Function clauses with bindings turn into:
;; * Subqueries. Perhaps less efficient? Certainly clearer.
;; * Projection expressions, if only used for output.
;; * Inline expressions?
;; - `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 vector
(: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 "Expected to be called with a Not instance." {:clause not}))
(when-not (instance? DefaultSrc (:source not))
(raise "Non-default sources are not supported in `not` clauses." {:clause 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]
(condp instance? it
Not
(apply-not-clause cc it)
Predicate
(apply-predicate-clause cc it)
Pattern
(apply-pattern-clause cc it)
(raise "Unknown clause." {:clause 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/query/context.cljc Normal file
View 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.query.context)
(defrecord Context [default-source elements cc])

54
src/datomish/query/projection.cljc Normal file
View 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.query.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])))))

62
src/datomish/query/source.cljc Normal file
View 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.query.source
(:require
[datomish.query.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))

2
src/datomish/transforms.cljc → src/datomish/query/transforms.cljc
View file

@ -2,7 +2,7 @@
;; 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.transforms)
(ns datomish.query.transforms)
#?(:clj
(defn boolean? [x]

4
src/datomish/sqlite.cljc
View file

@ -59,7 +59,9 @@
when no more results exist. Consume with <?."
[db [sql & bindings :as rest] 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
;; channel being rejected and no further row callbacks
;; being called.

4
src/datomish/sqlite_schema.cljc
View file

@ -8,7 +8,7 @@
[datomish.pair-chan :refer [go-pair <?]]
[cljs.core.async.macros :refer [go]]))
(: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]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
[clojure.core.async :refer [go <! >!]]])
@ -42,7 +42,7 @@
{: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.
(go-pair
(raise "No migrations yet defined!")
(raise-str "No migrations yet defined!")
(<? (s/set-user-version db current-version))
(<? (s/get-user-version db))))

23
src/datomish/util.cljc
View file

@ -8,10 +8,20 @@
[clojure.string :as str]))
#?(: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)
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
(defmacro cond-let [& clauses]
@ -26,7 +36,7 @@
(if (and (symbol? x)
(str/starts-with? (name x) "?"))
(keyword (subs (name x) 1))
(raise (str x " is not a Datalog var."))))
(raise-str x " is not a Datalog var.")))
(defn conj-in
"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 (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]
`(loop []
(when-let ~binding

2
test/datomish/sqlite_user_version_test.cljc
View file

@ -9,7 +9,7 @@
[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.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
[datomish.sqlite :as s]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
[tempfile.core :refer [tempfile with-tempfile]]

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

@ -1,6 +1,6 @@
(ns datomish.test.transforms
(:require
[datomish.transforms :as transforms]
[datomish.query.transforms :as transforms]
#?(:clj [clojure.test :as t :refer [is are deftest testing]])
#?(:cljs [cljs.test :as t :refer-macros [is are deftest testing]])
))

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

@ -14,7 +14,7 @@
(let [caught
(try
(do
(util/raise "succeed")
(util/raise "succeed" {})
"fail")
(catch :default e e))]
(is (= "succeed" (aget caught "data"))))))