From 345cd9a023298e56e89c8da291dbf1c720ad8ee8 Mon Sep 17 00:00:00 2001 From: Richard Newman Date: Wed, 20 Jul 2016 11:01:12 -0700 Subject: [PATCH] Queries containing 'not' can now be translated to SQL. --- src/datomish/clauses.cljc | 87 +++++++++++++++++++----------------- src/datomish/context.cljc | 2 +- src/datomish/projection.cljc | 6 +-- src/datomish/query.cljc | 70 ++++++++++------------------- 4 files changed, 73 insertions(+), 92 deletions(-) diff --git a/src/datomish/clauses.cljc b/src/datomish/clauses.cljc index 9da18447..9ada6850 100644 --- a/src/datomish/clauses.cljc +++ b/src/datomish/clauses.cljc @@ -53,6 +53,30 @@ (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)) + +(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] + (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 impose-external-bindings) ;; Accumulates a pattern into the CC. Returns a new CC. @@ -104,47 +128,25 @@ (when-not (instance? DefaultSrc (:source not)) (raise-str "Non-default sources are not supported in patterns. Pattern: " not)) - (let [not-join-clause (Not->NotJoinClause (:source cc) not)] + (let [not-join-clause (Not->NotJoinClause (:source cc) not) + seen (set (keys (:bindings cc))) + to-unify (set (map :symbol (:unify-vars not-join-clause)))] + ;; 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, and we do that now by failing. - - (let [seen (set (keys (:bindings cc))) - to-unify (set (map :symbol (:unify-vars not-join-clause)))] - (println "Seen " seen " need " to-unify) - (if (clojure.set/subset? to-unify seen) - (util/conj-in cc [:wheres] (not-join->where-fragment - (impose-external-bindings not-join-clause (:bindings cc)))) - (raise-str "Haven't seen all the necessary vars for this `not` clause."))))) + ;; Otherwise, we need to delay. Right now we're lazy, so we just fail: + ;; reorder your query yourself. + (if (clojure.set/subset? to-unify seen) + (util/conj-in cc [:wheres] (not-join->where-fragment + (impose-external-bindings not-join-clause (:bindings cc)))) + (raise-str "Haven't seen all the necessary vars for this `not` clause.")))) +;; 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) (apply-pattern-clause cc it))) -(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 CC and contribute - additional where clauses. Calling this more than - once will result in duplicate clauses." - [cc] - (assoc cc :wheres (concat (bindings->where (:bindings cc)) - (:wheres cc)))) - (defn expand-pattern-clauses "Reduce a sequence of patterns into a CC." [cc patterns] @@ -156,6 +158,17 @@ (->ConjoiningClauses source [] {} []) 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 @@ -182,12 +195,6 @@ vars (clojure.set/intersection (set (keys bindings)) (set (keys ours))) pairings (map (fn [v] [:= (first (v bindings)) (first (v ours))]) vars)] (impose-external-constraints not-join-clause pairings))) - -(defn cc->partial-subquery [cc] - (merge - {:from (:from cc)} - (when-not (empty? (:wheres cc)) - {:where (cons :and (:wheres cc))}))) (defn not-join->where-fragment [not-join] - [:not [:exists (merge {:select 1} (cc->partial-subquery (:cc not-join)))]]) + [:not [:exists (merge {:select [1]} (cc->partial-subquery (:cc not-join)))]]) diff --git a/src/datomish/context.cljc b/src/datomish/context.cljc index 67ba5444..03922794 100644 --- a/src/datomish/context.cljc +++ b/src/datomish/context.cljc @@ -6,4 +6,4 @@ ;; it'll also do projection and similar transforms. (ns datomish.context) -(defrecord Context [default-source]) +(defrecord Context [default-source elements cc]) diff --git a/src/datomish/projection.cljc b/src/datomish/projection.cljc index c0bcf60f..fde5df47 100644 --- a/src/datomish/projection.cljc +++ b/src/datomish/projection.cljc @@ -12,12 +12,10 @@ ) (defn lookup-variable [cc variable] + (println "Looking up " variable " in " (:bindings cc)) (or (-> cc :bindings variable first) (raise-str "Couldn't find variable " variable))) -(defn apply-elements-to-context [context elements] - (assoc context :elements elements)) - (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 @@ -43,7 +41,7 @@ (raise-str "Unable to :find non-variables.")) (map (fn [elem] (let [var (:symbol elem)] - [(lookup-variable context var) (util/var->sql-var var)])) + [(lookup-variable (:cc context) var) (util/var->sql-var var)])) elements))) (defn row-pair-transducer [context projection] diff --git a/src/datomish/query.cljc b/src/datomish/query.cljc index c8a603c7..e157d5b7 100644 --- a/src/datomish/query.cljc +++ b/src/datomish/query.cljc @@ -4,7 +4,10 @@ (ns datomish.query (:require + [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] [datascript.parser :as dp #?@(:cljs [:refer [Pattern DefaultSrc Variable Constant Placeholder]])] @@ -20,11 +23,8 @@ (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)} + (clauses/cc->partial-subquery (:cc context)))) (defn context->sql-string [context] (-> @@ -48,10 +48,9 @@ (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)))) + (assoc context + :elements (:elements find) + :cc (clauses/patterns->cc (:default-source context) where)))) (defn find->sql-clause "Take a parsed `find` expression and turn it into a structured SQL @@ -67,9 +66,8 @@ (defn find->sql-string "Take a parsed `find` expression and turn it into SQL." [context find] - (->> - find - (find->sql-clause context) + (-> + (find->sql-clause context find) (sql/format :quoting sql-quoting-style))) (defn parse @@ -78,51 +76,29 @@ (dp/parse-query q)) (comment - (datomish.query/find->sql-string - (datomish.query/parse - '[:find ?page :in $ :where [?page :page/starred true ?t] ]))) - +(def sql-quoting-style nil)) (comment - (datomish.query/find->prepared-context + (datomish.query/find->sql-string (datomish.context/->Context (datomish.source/datoms-source nil) nil nil) (datomish.query/parse '[:find ?timestampMicros ?page :in $ :where [?page :page/starred true ?t] - [?t :db/txInstant ?timestampMicros]]))) + [?t :db/txInstant ?timestampMicros] + (not [?page :page/deleted true]) ]))) (comment (pattern->sql - (first - (:where - (datascript.parser/parse-query - '[:find (max ?timestampMicros) (pull ?page [:page/url :page/title]) ?page - :in $ - :where - [?page :page/starred true ?t] + (first + (:where + (datascript.parser/parse-query + '[:find (max ?timestampMicros) (pull ?page [:page/url :page/title]) ?page + :in $ + :where + [?page :page/starred true ?t] (not-join [?fo] [(> ?fooo 5)] [?xpage :page/starred false] ) - [?t :db/txInstant ?timestampMicros]]))) - identity)) - -(cc->partial-subquery - - (require 'datomish.clauses) - (in-ns 'datomish.clauses) -(patterns->cc (datomish.source/datoms-source nil) - (:where -(datascript.parser/parse-query - '[:find (max ?timestampMicros) (pull ?page [:page/url :page/title]) ?page - :in $ - :where - [?page :page/starred true ?t] - (not-join [?page] - [?page :page/starred false] - ) - [?t :db/txInstant ?timestampMicros]]))) - -(Not->NotJoinClause (datomish.source/datoms-source nil) -#object[datomish.clauses$Not__GT_NotJoinClause 0x6d8aa02d "datomish.clauses$Not__GT_NotJoinClause@6d8aa02d"] -datomish.clauses=> #datascript.parser.Not{:source #datascript.parser.DefaultSrc{}, :vars [#datascript.parser.Variable{:symbol ?fooo}], :clauses [#datascript.parser.Pattern{:source #datascript.parser.DefaultSrc{}, :pattern [#datascript.parser.Variable{:symbol ?xpage} #datascript.parser.Constant{:value :page/starred} #datascript.parser.Constant{:value false}]}]}) + [?t :db/txInstant ?timestampMicros]]))) + identity))