From feebfd09dada7c192f42d5608eba808cbd26c3a5 Mon Sep 17 00:00:00 2001
From: Richard Newman <rnewman@twinql.com>
Date: Tue, 11 Oct 2016 19:10:34 -0700
Subject: [PATCH] Generate known type for the entity in a fulltext expression,
 and add a test. Fixes #85.

---
 src/common/datomish/query/cc.cljc        | 11 +++-
 src/common/datomish/query/clauses.cljc   |  7 ++-
 src/common/datomish/query/functions.cljc |  5 +-
 test/datomish/test/query.cljc            | 75 ++++++++++++++++++++++++
 4 files changed, 93 insertions(+), 5 deletions(-)

diff --git a/src/common/datomish/query/cc.cljc b/src/common/datomish/query/cc.cljc
index 021e9bf1..c4a4f994 100644
--- a/src/common/datomish/query/cc.cljc
+++ b/src/common/datomish/query/cc.cljc
@@ -132,10 +132,18 @@
                      [:= (sql/qualify table-alias (name :v))
                          (constant-in-source (:source cc) value)]])))
 
-(defn augment-cc [cc from bindings extracted-types wheres]
+(defn combine-known-types [left right]
+  (merge-with (fn [lt rt]
+                (if (= lt rt)
+                  lt
+                  (raise "Incompatible types: " lt " != " rt {:types [lt rt]})))
+              left right))
+
+(defn augment-cc [cc from bindings known-types extracted-types wheres]
   (assoc cc
          :from (concat (:from cc) from)
          :bindings (merge-with concat (:bindings cc) bindings)
+         :known-types (combine-known-types (:known-types cc) known-types)
          :extracted-types (merge (:extracted-types cc) extracted-types)
          :wheres (concat (:wheres cc) wheres)))
 
@@ -143,6 +151,7 @@
   (augment-cc left
               (:from right)
               (:bindings right)
+              (:known-types right)
               (:extracted-types right)
               (:wheres right)))
 
diff --git a/src/common/datomish/query/clauses.cljc b/src/common/datomish/query/clauses.cljc
index 8406dbbb..a6a6fc58 100644
--- a/src/common/datomish/query/clauses.cljc
+++ b/src/common/datomish/query/clauses.cljc
@@ -469,12 +469,15 @@
           bindings (into {} (map (fn [var]
                                    (let [sym (:symbol var)]
                                      [sym [(sql/qualify alias (util/var->sql-var sym))]]))
-                                 free-vars))]
+                                 free-vars))
+
+          known-types
+          (reduce cc/combine-known-types {} (map :known-types ccs))]
 
       (cc/map->ConjoiningClauses
         {:source source
          :from [[subqueries alias]]
-         :known-types (apply merge (map :known-types ccs))
+         :known-types known-types
          :extracted-types (apply merge (map :extracted-types ccs))
          :external-bindings {}       ; No need: caller will merge.
          :bindings bindings
diff --git a/src/common/datomish/query/functions.cljc b/src/common/datomish/query/functions.cljc
index 3c0c27e9..946e1fa2 100644
--- a/src/common/datomish/query/functions.cljc
+++ b/src/common/datomish/query/functions.cljc
@@ -146,7 +146,8 @@
         from [[fulltext-table fulltext-alias]
               [datom-table datom-alias]]
 
-        extracted-types {}    ; TODO
+        extracted-types {}                               ; TODO
+        known-types     {entity :db.type/ref}            ; All entities are refs.
 
         wheres (concat
                  [[:match match-column match-value]      ; The FTS match.
@@ -181,7 +182,7 @@
                           ;; if this is a variable rather than a placeholder.
                           [score [0]]]))]
 
-    (cc/augment-cc cc from bindings extracted-types wheres)))
+    (cc/augment-cc cc from bindings known-types extracted-types wheres)))
 
 ;; get-else is how Datalog handles optional attributes.
 ;;
diff --git a/test/datomish/test/query.cljc b/test/datomish/test/query.cljc
index c2cf5ae2..4b6688b0 100644
--- a/test/datomish/test/query.cljc
+++ b/test/datomish/test/query.cljc
@@ -824,3 +824,78 @@
                             '[?save :save/excerpt ?excerpt]]))]
       (is (or (= ["Some page title" "Some page excerpt"] result)
               (= ["A different page" "A different excerpt"] result))))))
+
+(deftest-db test-or-join-real-world conn
+  ;; This tests the simplest cause of https://github.com/mozilla/datomish/issues/84.
+  (testing "or-join with fulltext expressions doesn't leak type_tag columns."
+    (let [attrs (<? (<initialize-with-schema
+                      conn
+                      (concat save-schema schema-with-page)))]
+      (is
+        (=
+          {:select (list
+                     [:datoms6.v :url]
+                     [{:select [(sql/call :coalesce
+                                          {:select [:v]
+                                           :from [:datoms]
+                                           :where [:and
+                                                   [:= 'a 65546]
+                                                   [:= 'e :orjoin0.page]]
+                                           :limit 1}
+                                          "")]
+                       :limit 1}
+                      :title])
+           :modifiers []
+           :from (list
+                   [{:union (list
+                              {:select '([:datoms2.e :page])
+                               :from '([:fulltext_values fulltext_values1] [:datoms datoms2])
+                               :where (list :and
+                                            [:match :fulltext_values1.fulltext_values (sql/param :str)]
+                                            [:= :datoms2.v :fulltext_values1.rowid]
+                                            (list :or [:= :datoms2.a (:page/url attrs)] [:= :datoms2.a (:page/title attrs)]))}
+                              {:select '([:datoms5.e :page])
+                               :from '([:fulltext_values fulltext_values3] [:datoms datoms4] [:datoms datoms5])
+                               :where (list :and
+                                            [:match :fulltext_values3.fulltext_values (sql/param :str)]
+                                            [:= :datoms4.v :fulltext_values3.rowid]
+                                            (list :or
+                                                  [:= :datoms4.a (:save/title attrs)]
+                                                  [:= :datoms4.a (:save/content attrs)]
+                                                  [:= :datoms4.a (:save/excerpt attrs)]
+                                                  )
+                                            [:= :datoms5.a (:page/save attrs)]
+                                            [:= :datoms4.e :datoms5.v])})}
+                    'orjoin0]
+                   '[:datoms datoms6])
+           :where (list :and
+                        [:= :datoms6.a (:page/url attrs)]
+                        [:= :orjoin0.page :datoms6.e])
+           :limit 1}
+
+          (expand
+            '[:find [?url ?title]
+              :in $ ?str
+              :where
+              (or-join [?page]
+                [(fulltext $ #{:page/url :page/title} ?str) [[?page]]]
+                (and
+                  [(fulltext $ #{:save/title :save/excerpt :save/content} ?str) [[?save]]]
+                  [?page :page/save ?save]))
+              [?page :page/url ?url]
+              [(get-else $ ?page :page/title "") ?title]]
+            conn))))))
+
+;; honeysql up to 0.8.2 includes parentheses around the arms of a
+;; UNION. This isn't acceptable to SQLite.
+;; See https://github.com/jkk/honeysql/pull/142.
+(deftest test-honeysql-union
+  (testing "UNION doesn't include surplus parentheses."
+    (is (= ["SELECT x FROM (SELECT x FROM abc UNION SELECT x FROM def) foo"]
+           (sql/format {:select ['x]
+                        :from (list [{:union (list
+                                               {:select ['x]
+                                                :from [:abc]}
+                                               {:select ['x]
+                                                :from [:def]})}
+                                     :foo])})))))