Implement simple 'or' clauses. r=nalexander

src/datomish/query.cljc

@@ -8,7 +8,7 @@
    [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]]
+   [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
    [datascript.parser :as dp
     #?@(:cljs
           [:refer [
@@ -61,11 +61,11 @@
 
 (defn- validate-in [in]
   (when (nil? in)
-    (raise-str ":in expression cannot be nil."))
+    (raise ":in expression cannot be nil." {:binding in}))
   (when-not (= "$" (name (-> in first :variable :symbol)))
-    (raise-str "Non-default sources not supported."))
+    (raise "Non-default sources not supported." {:binding in}))
   (when-not (every? (partial instance? BindScalar) (rest in))
-    (raise-str "Non-scalar bindings not supported.")))
+    (raise "Non-scalar bindings not supported." {:binding in})))
 
 (defn in->bindings
   "Take an `:in` list and return a bindings map suitable for use
@@ -127,3 +127,16 @@
         (not [(> ?t ?latest)]) ])
     {:latest 5})
 )
+
+#_
+(datomish.query/find->sql-string
+  (datomish.query.context/->Context (datomish.query.source/datoms-source nil) nil nil)
+  (datomish.query/parse
+    '[:find ?page :in $ ?latest :where
+      [?page :page/url "http://example.com/"]
+      [?page :page/title ?title]
+      (or
+        [?entity :page/likes ?page]
+        [?entity :page/loves ?page])
+      ])
+  {})

src/datomish/query/clauses.cljc

@@ -13,14 +13,14 @@
      [datascript.parser :as dp
       #?@(:cljs
             [:refer
-             [PlainSymbol Predicate Not Pattern DefaultSrc Variable Constant Placeholder]])]
+             [PlainSymbol Predicate Not Or 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])))
+           PlainSymbol Predicate Not Or 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.
@@ -62,6 +62,12 @@
                           (attribute-in-source (:source cc) value)
                           (constant-in-source (:source cc) value))]))
 
+(defn merge-ccs [left right]
+  (assoc left
+         :from (concat (:from left) (:from right))
+         :bindings (merge-with concat (:bindings left) (:bindings right))
+         :wheres (concat (:wheres left) (:wheres right))))
+
 (defn- bindings->where
   "Take a bindings map like
     {?foo [:datoms12.e :datoms13.v :datoms14.e]}
@@ -108,24 +114,15 @@
                    (:wheres cc)))))
 
 ;; Pattern building is recursive, so we need forward declarations.
-(declare Not->NotJoinClause not-join->where-fragment)
+(declare
+  Not->NotJoinClause not-join->where-fragment
+  simple-or? simple-or->cc)
 
-;; Accumulates a pattern into the CC. Returns a new CC.
+(defn- apply-pattern-clause-for-alias
-(defn apply-pattern-clause
+  "This helper assumes that `cc` has already established a table association
-  "Transform a DataScript Pattern instance into the parts needed
+   for the provided alias."
-   to build a SQL expression.
+  [cc alias pattern]
-
+  (let [places (map vector
-  @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
@@ -148,10 +145,32 @@
 
             (raise-str "Unknown pattern part " pattern-part))))
 
+      cc
+      places)))
+
+;; 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]
+    (apply-pattern-clause-for-alias
+
       ;; Record the new table mapping.
       (util/conj-in cc [:from] [table alias])
 
-      places)))
+      ;; Use the new alias for columns.
+      alias
+      pattern)))
 
 (defn- plain-symbol->sql-predicate-symbol [fn]
   (when-not (instance? PlainSymbol fn)
@@ -205,18 +224,48 @@
                                                   (:bindings cc))
                                       not))))
 
+(defn apply-or-clause [cc orc]
+  (when-not (instance? Or orc)
+    (raise "Expected to be called with a Or instance." {:clause orc}))
+  (when-not (instance? DefaultSrc (:source orc))
+    (raise "Non-default sources are not supported in `or` clauses." {:clause orc}))
+
+  ;; A simple `or` is something like:
+  ;;
+  ;; (or [?foo :foo/bar ?baz]
+  ;;     [?foo :foo/noo ?baz])
+  ;;
+  ;; This can be converted into a single join and an `or` :where expression.
+  ;;
+  ;; Otherwise -- perhaps each leg of the `or` binds different variables, which
+  ;; is acceptable for an `or-join` form -- we need to turn this into a joined
+  ;; subquery.
+
+  (if (simple-or? orc)
+    (merge-ccs cc (simple-or->cc (:source cc)
+                                 (merge-with concat
+                                             (:external-bindings cc)
+                                             (:bindings cc))
+                                 orc))
+
+    ;; TODO: handle And within the Or patterns.
+    (raise "Non-simple `or` clauses not yet supported." {:clause orc})))
+
 ;; We're keeping this simple for now: a straightforward type switch.
 (defn apply-clause [cc it]
   (condp instance? it
+    Or
+    (apply-or-clause cc 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
@@ -227,7 +276,12 @@
 (defn patterns->cc [source patterns external-bindings]
   (expand-where-from-bindings
     (expand-pattern-clauses
-      (->ConjoiningClauses source [] (or external-bindings {}) {} [])
+      (map->ConjoiningClauses
+        {:source source
+         :from []
+         :external-bindings (or external-bindings {})
+         :bindings {}
+         :wheres []})
       patterns)))
 
 (defn cc->partial-subquery
@@ -254,8 +308,7 @@
 
 (defn Not->NotJoinClause [source external-bindings not]
   (when-not (instance? DefaultSrc (:source not))
-    (raise-str "Non-default sources are not supported in patterns. Pattern: "
+    (raise "Non-default sources are not supported in `not` clauses." {:clause not}))
-           not))
   (make-not-join-clause source external-bindings (:vars not) (:clauses not)))
 
 (defn not-join->where-fragment [not-join]
@@ -268,3 +321,81 @@
 
       ;; If it does establish bindings, then it has to be a subquery.
       [:exists (merge {:select [1]} (cc->partial-subquery (:cc not-join)))])])
+
+
+;; A simple Or clause is one in which each branch can be evaluated against
+;; a single pattern match. That means that all the variables are in the same places.
+;; We can produce a ConjoiningClauses in that case -- the :wheres will suffice
+;; for alternation.
+
+(defn validate-or-clause [orc]
+  (when-not (instance? DefaultSrc (:source orc))
+    (raise "Non-default sources are not supported in `or` clauses." {:clause orc}))
+  (when-not (nil? (:required (:rule-vars orc)))
+    (raise "We've never seen required rule-vars before." {:clause orc})))
+
+(defn simple-or? [orc]
+  (let [clauses (:clauses orc)]
+    (and
+      ;; Every pattern is a Pattern.
+      (every? (partial instance? Pattern) clauses)
+
+      (or
+        (= 1 (count clauses))
+
+        ;; Every pattern has the same source, and every place is either the
+        ;; same var or a fixed value. We ignore placeholders for now.
+        (let [template (first clauses)
+              template-source (:source template)]
+          (every? (fn [c]
+                    (and (= (:source c) template-source)
+                         (util/every-pair?
+                           (fn [left right]
+                             (condp instance? left
+                               Variable (= left right)
+                               Constant (instance? Constant right)
+
+                               false))
+                           (:pattern c) (:pattern template))))
+                  (rest clauses)))))))
+
+(defn simple-or->cc
+  "The returned CC has not yet had bindings expanded."
+  [source external-bindings orc]
+  (validate-or-clause orc)
+
+  ;; 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
+  ;; column names.
+  (let [cc (map->ConjoiningClauses
+             {:source source
+              :from []
+              :external-bindings (or external-bindings {})
+              :bindings {}
+              :wheres []})
+        primary (apply-pattern-clause cc (first (:clauses orc)))
+        remainder (rest (:clauses orc))]
+
+    (if (empty? remainder)
+      ;; That was easy.
+      primary
+
+      (let [template (assoc primary :wheres [])
+            alias (second (first (:from template)))
+            ccs (map (partial apply-pattern-clause-for-alias template alias)
+                     remainder)]
+
+        ;; Because this is a simple clause, we know that the first pattern established
+        ;; any necessary bindings.
+        ;; Take any new :wheres from each CC and combine them with :or.
+        (assoc primary :wheres
+               [(cons :or
+                     (reduce (fn [acc cc]
+                               (let [w (:wheres cc)]
+                                 (case (count w)
+                                       0 acc
+                                       1 (conj acc (first w))
+
+                                       (conj acc (cons :and w)))))
+                             []
+                             (cons primary ccs)))])))))

src/datomish/util.cljc

@@ -62,3 +62,11 @@
      (when-let ~binding
        ~@forms
        (recur))))
+
+(defn every-pair? [f xs ys]
+  (or (and (empty? xs) (empty? ys))
+      (and (not (empty? xs))
+           (not (empty? ys))
+           (f (first xs) (first ys))
+           (recur f (rest xs) (rest ys)))))
+

test/datomish/test/query.cljc

@@ -125,3 +125,42 @@
              [?page :page/starred true ?t]
              (not [?page :foo/bar _])
              [?t :db/txInstant ?timestampMicros]]))))
+
+(deftest test-single-or
+  (is (= '{:select ([:datoms1.e :page]),
+           :modifiers [:distinct],
+           :from ([:datoms datoms0] [:datoms datoms1] [:datoms datoms2]),
+           :where (:and
+                     [:= :datoms1.e :datoms0.e]
+                     [:= :datoms1.e :datoms2.v]
+                     [:= :datoms0.a "page/url"]
+                     [:= :datoms0.v "http://example.com/"]
+                     [:= :datoms1.a "page/title"]
+                     [:= :datoms2.a "page/loves"])}
+         (expand
+           '[:find ?page :in $ ?latest :where
+             [?page :page/url "http://example.com/"]
+             [?page :page/title ?title]
+             (or
+               [?entity :page/loves ?page])]))))
+
+(deftest test-simple-or
+  (is (= '{:select ([:datoms1.e :page]),
+           :modifiers [:distinct],
+           :from ([:datoms datoms0] [:datoms datoms1] [:datoms datoms2]),
+           :where (:and
+                     [:= :datoms1.e :datoms0.e]
+                     [:= :datoms1.e :datoms2.v]
+                     [:= :datoms0.a "page/url"]
+                     [:= :datoms0.v "http://example.com/"]
+                     [:= :datoms1.a "page/title"]
+                     (:or
+                        [:= :datoms2.a "page/likes"]
+                        [:= :datoms2.a "page/loves"]))}
+         (expand
+           '[:find ?page :in $ ?latest :where
+             [?page :page/url "http://example.com/"]
+             [?page :page/title ?title]
+             (or
+               [?entity :page/likes ?page]
+               [?entity :page/loves ?page])]))))