Queries containing 'not' can now be translated to SQL.

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.
+    ;; Otherwise, we need to delay. Right now we're lazy, so we just fail:
-    
+    ;; reorder your query yourself.
-    (let [seen (set (keys (:bindings cc)))
+    (if (clojure.set/subset? to-unify seen)
-          to-unify (set (map :symbol (:unify-vars not-join-clause)))]
+      (util/conj-in cc [:wheres] (not-join->where-fragment
-    (println "Seen " seen " need " to-unify)
+                                   (impose-external-bindings not-join-clause (:bindings cc))))
-      (if (clojure.set/subset? to-unify seen)
+      (raise-str "Haven't seen all the necessary vars for this `not` clause."))))
-        (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
@@ -183,11 +196,5 @@
         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)))]])

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

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]

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)
+    {:select (projection/sql-projection context)}
-     :from (:from context)}
+    (clauses/cc->partial-subquery (:cc context))))
-    (if (empty? (:wheres context))
-      {}
-      {:where (cons :and (:wheres 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
+    (assoc context
-      (expand-where-from-bindings
+           :elements (:elements find)
-        (expand-patterns-into-context context where))    ; 'where' here is the Datalog :where clause.
+           :cc (clauses/patterns->cc (:default-source context) where))))
-      (:elements find))))
 
 (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)
-    (find->sql-clause context)
     (sql/format :quoting sql-quoting-style)))
 
 (defn parse
@@ -78,51 +76,29 @@
   (dp/parse-query q))
 
 (comment
-  (datomish.query/find->sql-string
+(def sql-quoting-style nil))
-    (datomish.query/parse
-      '[:find ?page :in $ :where [?page :page/starred true ?t] ])))
-
 (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
+  (first
-      (:where
+  (:where
-        (datascript.parser/parse-query
+  (datascript.parser/parse-query
-          '[:find (max ?timestampMicros) (pull ?page [:page/url :page/title]) ?page
+  '[:find (max ?timestampMicros) (pull ?page [:page/url :page/title]) ?page
-          :in $
+  :in $
-          :where
+  :where
-          [?page :page/starred true ?t]
+  [?page :page/starred true ?t]
   (not-join [?fo]
   [(> ?fooo 5)]
   [?xpage :page/starred false]
   )
-          [?t :db/txInstant ?timestampMicros]])))
+  [?t :db/txInstant ?timestampMicros]])))
-    identity))
+  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}]}]})