From e89544bebac42a4c24fc4a5cd3a94c9da1dbf7d7 Mon Sep 17 00:00:00 2001
From: Richard Newman <rnewman@twinql.com>
Date: Thu, 6 Oct 2016 18:26:40 -0700
Subject: [PATCH] Implement all four find specs. Fixes #38. r=nalexander

---
 src/common/datomish/db.cljc               |  64 ++++++----
 src/common/datomish/query.cljc            |  62 ++++++++--
 src/common/datomish/query/context.cljc    |  18 ++-
 src/common/datomish/query/projection.cljc |  55 +++++++--
 test/datomish/test/query.cljc             | 140 ++++++++++++++++++++++
 test/datomish/tofinoish_test.cljc         |  29 ++---
 6 files changed, 304 insertions(+), 64 deletions(-)

diff --git a/src/common/datomish/db.cljc b/src/common/datomish/db.cljc
index c41381a8..3fe7107d 100644
--- a/src/common/datomish/db.cljc
+++ b/src/common/datomish/db.cljc
@@ -800,29 +800,6 @@
        :schema            entid-schema
        })))
 
-;; TODO: factor this into the overall design.
-(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 options]
-  (let [unexpected (seq (clojure.set/difference (set (keys options)) #{:limit :order-by :inputs}))]
-    (when unexpected
-      (raise "Unexpected options: " unexpected {:bad-options unexpected})))
-
-  (let [{:keys [limit order-by inputs]} options
-        parsed (query/parse find)
-        context (-> db
-                    query-context
-                    (query/options-into-context limit order-by)
-                    (query/find-into-context parsed))
-        row-pair-transducer (projection/row-pair-transducer context)
-        sql (query/context->sql-string context inputs)
-        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]
@@ -830,11 +807,46 @@
       [nil e]
       [(f rv v) nil])))
 
+(def default-result-buffer-size 50)
+
 (defn <?q
   "Execute the provided query on the provided DB.
-   Returns a transduced pair-chan with one [[results] err] item."
+   Returns a transduced pair-chan with either:
+   * One [[results] err] item (for relation and collection find specs), or
+   * One [value err] item (for tuple and scalar find specs)."
   ([db find]
    (<?q db find {}))
   ([db find options]
-   (a/reduce (partial reduce-error-pair conj) [[] nil]
-             (<?run db find options))))
+   (let [unexpected (seq (clojure.set/difference (set (keys options)) #{:limit :order-by :inputs}))]
+    (when unexpected
+      (raise "Unexpected options: " unexpected {:bad-options unexpected})))
+   (let [{:keys [limit order-by inputs]} options
+         parsed (query/parse find)
+         context (-> db
+                   query-context
+                   (query/options-into-context limit order-by)
+                   (query/find-into-context parsed))
+
+         ;; We turn each row into either an array of values or an unadorned
+         ;; value. The row-pair-transducer does this work.
+         ;; The only thing to do to handle the full suite of find specs
+         ;; is to decide if we're then returning an array of transduced rows
+         ;; or just the first result.
+         row-pair-transducer (projection/row-pair-transducer context)
+         sql (query/context->sql-string context inputs)
+
+         first-only (context/scalar-or-tuple-query? context)
+         buffer-size (if first-only
+                       1
+                       default-result-buffer-size)
+         chan (chan buffer-size row-pair-transducer)]
+
+     ;; Fill the channel.
+     (s/<?all-rows (.-sqlite-connection db) sql chan)
+
+     ;; If we only want the first result, great!
+     ;; Otherwise, reduce it down.
+     (if first-only
+       chan
+       (a/reduce (partial reduce-error-pair conj) [[] nil]
+                 chan)))))
diff --git a/src/common/datomish/query.cljc b/src/common/datomish/query.cljc
index 5501ffb9..6bfb1833 100644
--- a/src/common/datomish/query.cljc
+++ b/src/common/datomish/query.cljc
@@ -15,6 +15,7 @@
             BindScalar
             Constant
             DefaultSrc
+            FindRel FindColl FindTuple FindScalar
             Pattern
             Placeholder
             SrcVar
@@ -29,6 +30,7 @@
             BindScalar
             Constant
             DefaultSrc
+            FindRel FindColl FindTuple FindScalar
             Pattern
             Placeholder
             SrcVar
@@ -63,10 +65,17 @@
   (let [inner-projection (projection/sql-projection-for-relation context)
         inner
         (merge
-          ;; Always SELECT DISTINCT, because Datalog is set-based.
+          ;; If we're finding a collection or relations, we specify
+          ;; SELECT DISTINCT, because Datalog is set-based.
+          ;; If we're only selecting one result — a scalar or a tuple —
+          ;; then we don't bother.
+          ;;
           ;; TODO: determine from schema analysis whether we can avoid
-          ;; the need to do this.
-          {:modifiers [:distinct]}
+          ;; the need to do this even in the collection/relation case.
+          {:modifiers
+           (if (= 1 (:limit context))
+             []
+             [:distinct])}
           (clauses/cc->partial-subquery inner-projection (:cc context)))
 
         limit (:limit context)
@@ -134,6 +143,19 @@
     (raise "Invalid limit " limit {:limit limit}))
   (assoc context :limit limit :order-by-vars order-by))
 
+(defn find-spec->elements [find-spec]
+  (condp instance? find-spec
+    FindRel (:elements find-spec)
+    FindTuple (:elements find-spec)
+    FindScalar [(:element find-spec)]
+    FindColl [(:element find-spec)]
+    (raise "Unable to handle find spec." {:find-spec find-spec})))
+
+(defn find-spec->limit [find-spec]
+  (when (or (instance? FindScalar find-spec)
+            (instance? FindTuple find-spec))
+    1))
+
 (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
@@ -142,15 +164,37 @@
   (let [{:keys [find in with where]} find]  ; Destructure the Datalog query.
     (validate-with with)
     (validate-in in)
+
+    ;; A find spec can be:
+    ;;
+    ;;   * FindRel containing :elements. Returns an array of arrays.
+    ;;   * FindColl containing :element. This is like mapping (fn [row] (aget row 0))
+    ;;     over the result set. Returns an array of homogeneous values.
+    ;;   * FindScalar containing :element. Returns a single value.
+    ;;   * FindTuple containing :elements. This is just like :limit 1
+    ;;     on FindColl, returning the first item of the result array. Returns an
+    ;;     array of heterogeneous values.
+    ;;
+    ;; The code to handle these is:
+    ;;   - Just above, unifying a variable list in find-spec->elements.
+    ;;   - In context.cljc, checking whether a single value or collection is returned.
+    ;;   - In projection.cljc, transducing according to whether a single column or
+    ;;     multiple columns are assembled into the output.
+    ;;   - In db.cljc, where we finally take rows and decide what to push into an
+    ;;     output channel.
+
     (let [external-bindings (in->bindings in)
-          elements (:elements find)
+          elements (find-spec->elements find)
           known-types {}
           group-by-vars (projection/extract-group-by-vars elements with)]
-      (assoc context
-             :elements elements
-             :group-by-vars group-by-vars
-             :has-aggregates? (not (nil? group-by-vars))
-             :cc (clauses/patterns->cc (:default-source context) where known-types external-bindings)))))
+      (util/assoc-if
+        (assoc context
+               :find-spec find
+               :elements elements
+               :group-by-vars group-by-vars
+               :has-aggregates? (not (nil? group-by-vars))
+               :cc (clauses/patterns->cc (:default-source context) where known-types external-bindings))
+        :limit (find-spec->limit find)))))
 
 (defn find->sql-clause
   "Take a parsed `find` expression and turn it into a structured SQL
diff --git a/src/common/datomish/query/context.cljc b/src/common/datomish/query/context.cljc
index 8a21d8cb..2d7a3e3c 100644
--- a/src/common/datomish/query/context.cljc
+++ b/src/common/datomish/query/context.cljc
@@ -4,12 +4,19 @@
 
 ;; A context, very simply, holds on to a default source and some knowledge
 ;; needed for aggregation.
-(ns datomish.query.context)
+(ns datomish.query.context
+  (:require
+     [datascript.parser :as dp
+      #?@(:cljs [:refer [FindRel FindColl FindTuple FindScalar]])])
+  #?(:clj
+       (:import
+          [datascript.parser FindRel FindColl FindTuple FindScalar])))
 
 (defrecord Context
   [
    default-source
-   elements        ; The :find list itself.
+   find-spec       ; The parsed find spec. Used to decide how to process rows.
+   elements        ; A list of Element instances, drawn from the :find-spec itself.
    has-aggregates?
    group-by-vars   ; A list of variables from :find and :with, used to generate GROUP BY.
    order-by-vars   ; A list of projected variables and directions, e.g., [:date :asc], [:_max_timestamp :desc].
@@ -17,5 +24,10 @@
    cc              ; The main conjoining clause.
    ])
 
+(defn scalar-or-tuple-query? [context]
+  (when-let [find-spec (:find-spec context)]
+    (or (instance? FindScalar find-spec)
+        (instance? FindTuple find-spec))))
+
 (defn make-context [source]
-  (->Context source nil false nil nil nil nil))
+  (->Context source nil nil false nil nil nil nil))
diff --git a/src/common/datomish/query/projection.cljc b/src/common/datomish/query/projection.cljc
index eb0978a6..1740bd66 100644
--- a/src/common/datomish/query/projection.cljc
+++ b/src/common/datomish/query/projection.cljc
@@ -9,10 +9,28 @@
    [datomish.sqlite-schema :as ss]
    [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
    [datascript.parser :as dp
-    #?@(:cljs [:refer [Aggregate Pattern DefaultSrc Variable Constant Placeholder PlainSymbol]])]
+    #?@(:cljs [:refer
+               [Aggregate
+                Constant
+                DefaultSrc
+                FindRel FindColl FindTuple FindScalar
+                Pattern
+                Placeholder
+                PlainSymbol
+                Variable
+                ]])]
    )
-  #?(:clj (:import [datascript.parser Aggregate Pattern DefaultSrc Variable Constant Placeholder PlainSymbol]))
-  )
+  #?(:clj (:import
+             [datascript.parser
+              Aggregate
+              Constant
+              DefaultSrc
+              FindRel FindColl FindTuple FindScalar
+              Pattern
+              Placeholder
+              PlainSymbol
+              Variable
+              ])))
 
 (defn lookup-variable [cc variable]
   (or (-> cc :bindings variable first)
@@ -251,18 +269,37 @@
            elements))))
 
 (defn row-pair-transducer [context]
-  (let [{:keys [elements cc]} context
+  (let [{:keys [find-spec elements cc]} context
         {:keys [source known-types extracted-types]} cc
 
         ;; We know the projection will fail above if these aren't simple variables or aggregates.
         projectors
-        (make-projectors-for-columns elements known-types extracted-types)]
+        (make-projectors-for-columns elements known-types extracted-types)
+
+        single-column-find-spec?
+        (or (instance? FindScalar find-spec)
+            (instance? FindColl find-spec))]
 
     (map
-      (fn [[row err]]
-        (if err
-          [row err]
-          [(map (fn [projector] (projector row)) projectors) nil])))))
+      (if single-column-find-spec?
+        ;; We're only grabbing one result from each row.
+        (let [projector (first projectors)]
+          (when (second projectors)
+            (raise "Single-column find spec used, but multiple projectors present."
+                   {:elements elements
+                    :projectors projectors
+                    :find-spec find-spec}))
+
+          (fn [[row err]]
+            (if err
+              [nil err]
+              [(projector row) nil])))
+
+        ;; Otherwise, collect each column into a sequence.
+        (fn [[row err]]
+          (if err
+            [nil err]
+            [(map (fn [projector] (projector row)) projectors) nil]))))))
 
 (defn extract-group-by-vars
   "Take inputs to :find and, if any aggregates exist in `elements`,
diff --git a/test/datomish/test/query.cljc b/test/datomish/test/query.cljc
index ce601bea..c2cf5ae2 100644
--- a/test/datomish/test/query.cljc
+++ b/test/datomish/test/query.cljc
@@ -684,3 +684,143 @@
                                    "something")
                              '[[?save]]]]}
                   conn)))))
+
+(deftest-db test-find-specs-expansion conn
+  (let [attrs (<? (<initialize-with-schema conn save-schema))]
+    ;; Relation.
+    (is (= {:select (list [:fulltext_datoms0.v :title])
+            :modifiers [:distinct]
+            :from (list [:fulltext_datoms 'fulltext_datoms0])
+            :where (list :and [:= :fulltext_datoms0.a (:save/title attrs)])}
+           (expand [:find '?title
+                    :in '$
+                    :where '[?save :save/title ?title]]
+                   conn)))
+
+    ;; Tuple. We expect only one result, and indeed we only take one.
+    ;; No need for :distinct in this case!
+    (is (= {:select (list [:fulltext_datoms0.v :title])
+            :modifiers []
+            :limit 1
+            :from (list [:fulltext_datoms 'fulltext_datoms0])
+            :where (list :and [:= :fulltext_datoms0.a (:save/title attrs)])}
+           (expand [:find '[?title]
+                    :in '$
+                    :where '[?save :save/title ?title]]
+                   conn)))
+
+    ;; Scalar. As with the tuple form, we expect only one result.
+    (is (= {:select (list [:fulltext_datoms0.v :title])
+            :modifiers []
+            :limit 1
+            :from (list [:fulltext_datoms 'fulltext_datoms0])
+            :where (list :and [:= :fulltext_datoms0.a (:save/title attrs)])}
+           (expand [:find '?title '.
+                    :in '$
+                    :where '[?save :save/title ?title]]
+                   conn)))
+
+    ;; Collection.
+    (is (= {:select (list [:fulltext_datoms0.v :title])
+            :modifiers [:distinct]
+            :from (list [:fulltext_datoms 'fulltext_datoms0])
+            :where (list :and [:= :fulltext_datoms0.a (:save/title attrs)])}
+           (expand [:find '[?title ...]
+                    :in '$
+                    :where '[?save :save/title ?title]]
+                   conn)))))
+
+(defn orderless=
+  "Compare two arrays regardless of order."
+  [a b]
+  (= (set a) (set b)))
+
+(deftest-db test-find-specs-empty-results conn
+  (let [attrs (<? (<initialize-with-schema conn save-schema))]
+    ;; Relation.
+    (is (= []
+           (<? (d/<q (d/db conn)
+                     [:find '?title
+                      :in '$
+                      :where '[?save :save/title ?title]]))))
+
+    ;; Tuple.
+    (is (nil? (<? (d/<q (d/db conn)
+                        [:find '[?title]
+                         :in '$
+                         :where '[?save :save/title ?title]]))))
+
+    ;; Scalar.
+    (is (nil? (<? (d/<q (d/db conn)
+                        [:find '?title '.
+                         :in '$
+                         :where '[?save :save/title ?title]]))))
+
+    ;; Collection.
+    (is (= []
+           (<? (d/<q (d/db conn)
+                     [:find '[?title ...]
+                      :in '$
+                      :where '[?save :save/title ?title]]))))))
+
+(deftest-db test-find-specs-result-shape conn
+  (let [attrs (<? (<initialize-with-schema conn save-schema))]
+    ;; Add some data.
+    (<? (d/<transact! conn
+                      [{:db/id (d/id-literal :db.part/user -1)
+                        :save/title "Some page title"}
+                       {:db/id (d/id-literal :db.part/user -2)
+                        :save/title "A different page"}]))
+
+    ;; Relation.
+    (is (orderless=
+          [["A different page"]["Some page title"]]
+          (<? (d/<q (d/db conn)
+                    [:find '?title
+                     :in '$
+                     :where '[?save :save/title ?title]]
+                    {:order-by [[:title :asc]]}))))
+
+    ;; Tuple. We expect only one result, and indeed we only take one.
+    ;; No need for :distinct in this case!
+    (let [result (<? (d/<q (d/db conn)
+                           [:find '[?title]
+                            :in '$
+                            :where '[?save :save/title ?title]]
+                           {:order-by [[:title :asc]]}))]
+      (is (= ["A different page"] result)))
+
+    ;; Scalar. As with the tuple form, we expect only one result.
+    (let [result (<? (d/<q (d/db conn)
+                           [:find '?title '.
+                            :in '$
+                            :where '[?save :save/title ?title]]
+                           {:order-by [[:title :asc]]}))]
+      (is (= "A different page" result)))
+
+    ;; Collection.
+    (is (orderless=
+          ["Some page title" "A different page"]
+          (<? (d/<q (d/db conn)
+                    [:find '[?title ...]
+                     :in '$
+                     :where '[?save :save/title ?title]]
+                    {:order-by [[:title :desc]]}))))))
+
+(deftest-db test-tuple conn
+  (let [attrs (<? (<initialize-with-schema conn save-schema))]
+    (<? (d/<transact! conn
+                      [{:db/id (d/id-literal :db.part/user -1)
+                        :save/title "Some page title"
+                        :save/excerpt "Some page excerpt"}
+                       {:db/id (d/id-literal :db.part/user -2)
+                        :save/title "A different page"
+                        :save/excerpt "A different excerpt"}]))
+    (let [result (<? (d/<q (d/db conn)
+                           [:find '[?title ?excerpt]
+                            :in '$
+                            :where
+                            '[?save :save/title ?title]
+                            '[?save :save/excerpt ?excerpt]]))]
+      (is (or (= ["Some page title" "Some page excerpt"] result)
+              (= ["A different page" "A different excerpt"] result))))))
diff --git a/test/datomish/tofinoish_test.cljc b/test/datomish/tofinoish_test.cljc
index f974fd41..0b2143f1 100644
--- a/test/datomish/tofinoish_test.cljc
+++ b/test/datomish/tofinoish_test.cljc
@@ -314,17 +314,12 @@
              rows)))))
 
 (defn <find-title [db url]
-  ;; Until we support [:find ?title . :in…] we crunch this by hand.
-  (go-pair
-    (first
-      (first
-        (<?
-          (d/<q db
-                '[:find ?title :in $ ?url
-                  :where
-                  [?page :page/url ?url]
-                  [(get-else $ ?page :page/title "") ?title]]
-                {:inputs {:url url}}))))))
+  (d/<q db
+        '[:find ?title . :in $ ?url
+          :where
+          [?page :page/url ?url]
+          [?page :page/title ?title]]
+        {:inputs {:url url}}))
 
 ;; Ensure that we can grow the schema over time.
 (deftest-db test-schema-evolution conn
@@ -384,7 +379,7 @@
     ;; Add a page with no title.
     (<? (<add-visit conn {:uri "http://notitle.example.org/"
                           :session session}))
-    (is (= "" (<? (<find-title (d/db conn) "http://notitle.example.org/"))))
+    (is (nil? (<? (<find-title (d/db conn) "http://notitle.example.org/"))))
     (let [only-one (<? (<visited (d/db conn) {:limit 1}))]
       (is (= 1 (count only-one)))
       (is (= (select-keys (first only-one)
@@ -483,9 +478,9 @@
   (let [results
         (<?
           (d/<q (d/db conn)
-                {:find '[?save]
-                 :in '[$]
-                 :where [[(list 'fulltext '$ #{:save/title :save/excerpt} "something")
-                          '[[?save]]]]}))]
-    (is (= (set (map first results))
+                [:find '[?save ...]
+                 :in '$
+                 :where [(list 'fulltext '$ #{:save/title :save/excerpt} "something")
+                         '[[?save]]]]))]
+    (is (= (set results)
            #{999 998}))))