Rework query.cljc to be more reductive, into a Context record.

Signed-off-by: Richard Newman <rnewman@twinql.com>

src/datomish/query.cljc

@@ -7,127 +7,163 @@
      [datomish.util :as util :refer [raise var->sql-var]]
      [datomish.transforms :as transforms]
      [datascript.parser :as dp
-      #?@(:cljs [:refer [Pattern DefaultSrc Variable Constant]])]
+      #?@(:cljs [:refer [Pattern DefaultSrc Variable Constant Placeholder]])]
      [clojure.string :as str]
      [honeysql.core :as sql]
      )
-  #?(:clj (:import [datascript.parser Pattern DefaultSrc Variable Constant]))
+  #?(:clj (:import [datascript.parser Pattern DefaultSrc Variable Constant Placeholder]))
   )
 
 ;; Setting this to something else will make your output more readable,
 ;; but not automatically safe for use.
 (def sql-quoting-style :ansi)
 
-(defn pattern->parts
+;;
+;; Context.
+;; 
+;; `attribute-transform` is a function from attribute to constant value. Used to
+;; turn, e.g., :p/attribute into an interned integer.
+;; `constant-transform` is a function from constant value to constant value. Used to
+;; turn, e.g., the literal 'true' into 1.
+;; `from` is a list of table pairs, suitable for passing to honeysql.
+;; `:bindings` is a map from var to qualified columns.
+;; `:wheres` is a list of fragments that can be joined by `:and`.
+;;
+(defrecord Context [from bindings wheres attribute-transform constant-transform])
+
+(defn attribute-in-context [context attribute]
+  ((:attribute-transform context) attribute))
+
+(defn constant-in-context [context constant]
+  ((:constant-transform context) constant))
+
+(defn bind-column-to-var [context variable col]
+  (let [var (:symbol variable)
+        existing-bindings (get-in context [:bindings var])]
+    (assoc-in context [:bindings var] (conj existing-bindings col))))
+
+(defn constrain-column-to-constant [context col position value]
+  (util/conj-in context [:wheres]
+                [:= col (if (= :a position)
+                          (attribute-in-context context value)
+                          (constant-in-context context value))]))
+
+(defn lookup-variable [context variable]
+  (or (-> context :bindings variable first)
+      (raise (str "Couldn't find variable " variable))))
+
+(defn make-context []
+  (->Context [] {} []
+             transforms/attribute-transform-string
+             transforms/constant-transform-default))
+  
+(defn apply-pattern-to-context
   "Transform a DataScript Pattern instance into the parts needed
    to build a SQL expression.
 
+  @arg context A Context instance.
   @arg pattern The pattern instance.
-  @arg attribute-transform A function from attribute to constant value. Used to
+  @return an augmented Context."
-                           turn, e.g., :p/attribute into an interned integer.
+  [context pattern]
-  @arg constant-transform A function from constant value to constant value. Used to
-                          turn, e.g., the literal 'true' into 1.
-  @return A map, `{:from, :bindings, :where}`. `:from` is a list of table pairs,
-          suitable for passing to honeysql. `:bindings` is a map from var to
-          qualified columns. `:where` is a list of fragments that can be joined by
-          `:and`."
-  [pattern attribute-transform constant-transform]
   (when-not (instance? Pattern pattern)
     (raise "Expected to be called with a Pattern instance."))
   (when-not (instance? DefaultSrc (:source pattern))
     (raise (str "Non-default sources are not supported in patterns. Pattern: "
                 (print-str pattern))))
 
-  (let [table (keyword (name (gensym "eavt")))]
+  (let [table (keyword (name (gensym "eavt")))
-
+        places (map (fn [place col] [place col])
-    (loop [places (:pattern pattern)
+                    (:pattern pattern)
-           columns [:e :a :v :t :added]
+                    [:e :a :v :t :added])]
-           bindings (transient {})         ; Maps from var to list of qualified columns.
+    (reduce
-           wheres (transient [])]          ; Fragments, each an expression.
+      (fn [context
-
+           [pattern-part                           ; ?x, :foo/bar, 42 
-      (if (empty? places)
+            position]]                             ; :a
-        ;; We're done.
+        (let [col (sql/qualify table position)]    ; :eavt.a
-        {:from [:eavt table]
-         :bindings (persistent! bindings)
-         :where (persistent! wheres)}
-
-        (let [pattern-part (first places)           ; ?x, :foo/bar, 42
-              position (first columns)              ; :a
-              col (sql/qualify table position)]     ; :eavt.a
-
           (condp instance? pattern-part
+            ;; Placeholders don't contribute any bindings, nor do
+            ;; they constrain the query -- there's no need to produce
+            ;; IS NOT NULL, because we don't store nulls in our schema.
+            Placeholder
+            context
+            
             Variable
-            ;; We might get a pattern like this:
+            (bind-column-to-var context pattern-part col)
-            ;;    [?x :foo/bar ?x]
-            ;; so we look up existing bindings, collect more than one,
-            ;; and will (outside this function) generate :=-relations
-            ;; between each position.
-            (let [var (:symbol pattern-part)
-                  existing-bindings (get bindings pattern-part)]
-              (recur (rest places) (rest columns)
-                     (assoc! bindings var (conj existing-bindings col))
-                     wheres))
 
             Constant
-            (recur (rest places) (rest columns)
+            (constrain-column-to-constant context col position (:value pattern-part))
-                   bindings
-                   (conj! wheres
-                          [:= col (if (= :a position)
-                                    (attribute-transform (:value pattern-part))
-                                    (constant-transform (:value pattern-part)))]))
 
-            (raise (str "Unknown pattern part " (print-str pattern-part)))))))))
+            (raise (str "Unknown pattern part " (print-str pattern-part))))))
 
-(defn bindings->where
+      ;; Record the new table mapping.
-  "Take a map like
+      (util/conj-in context [:from] [:eavt table])
+
+      places)))
+
+(defn- bindings->where
+  "Take a bindings map like
     {?foo [:eavt12.e :eavt13.v :eavt14.e]}
-  and produce a :where expression like
+  and produce a list of constraints expression like
-    (:and [:= :eavt12.e :eavt13.v] [:= :eavt12.e :eavt14.e])
+    [[:= :eavt12.e :eavt13.v] [:= :eavt12.e :eavt14.e]]
 
   TODO: experiment; it might be the case that producing more
   pairwise equalities we get better or worse performance."
   [bindings]
-  (let [clauses (mapcat (fn [[_ vs]]
+  (println bindings)
-                          (when (> (count vs) 1)
+  (mapcat (fn [[_ vs]]
-                            (let [root (first vs)]
+            (when (> (count vs) 1)
-                              (map (fn [v] [:= root v]) (rest vs)))))
+              (let [root (first vs)]
-                        bindings)]
+                (map (fn [v] [:= root v]) (rest vs)))))
-    (when-not (empty? clauses)
+          bindings))
-      (cons :and clauses))))
 
-(defn patterns->body [patterns]
+(defn expand-where-from-bindings
-  (let [clauses
+  "Take the bindings in the context and contribute
-        (map (fn [p]
+   additional where clauses. Calling this more than
-               (pattern->parts p
+   once will result in duplicate clauses."
-                               transforms/attribute-transform-string
+  [context]
-                               transforms/constant-transform-default))
+  (assoc context :wheres (concat (bindings->where (:bindings context))
-             patterns)]
+                                 (:wheres context))))
-    {:from (map :from clauses)
+
-     :where (cons :and (mapcat :where clauses))
+(defn patterns->context
-     :bindings (apply merge-with concat (map :bindings clauses))}))
+  "Turn a sequence of patterns into a Context."
+  [patterns]
+  (reduce apply-pattern-to-context (make-context) patterns))
 
 (defn elements->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
    honeysql.
 
-   Example:
+   For example:
+
      [Variable{:symbol ?foo}, Variable{:symbol ?bar}]
+  
+   with bindings in the context:
+  
      {?foo [:eavt12.e :eavt13.v], ?bar [:eavt13.e]}
-     =>
+  
+   =>
+
      [[:eavt12.e :foo] [:eavt13.e :bar]]
 
+   @param context A Context.
    @param elements The input clause.
-   @param variable-lookup A function from symbol to column name.
    @return a sequence of pairs."
-  [elements variable-lookup]
+  [context elements]
   (when-not (every? #(instance? Variable %1) elements)
     (raise "Unable to :find non-variables."))
   (map (fn [elem]
          (let [var (:symbol elem)]
-           [(variable-lookup var) (var->sql-var var)]))
+           [(lookup-variable context var) (var->sql-var var)]))
        elements))
 
+(defn context->sql-clause [context elements]
+  {:select (elements->sql-projection context elements)
+   :from (:from context)
+   :where (if (empty? (:wheres context))
+            nil
+            (cons :and (:wheres context)))})
+
 (defn- validate-with [with]
   (when-not (nil? with)
     (raise "`with` not supported.")))
@@ -147,20 +183,10 @@
   (let [{:keys [find in with where]} find]  ; Destructure the Datalog query.
     (validate-with with)
     (validate-in in)
-
+    (context->sql-clause
-    (let [{:keys [from where bindings]}     ; 'where' here is SQL.
+      (expand-where-from-bindings
-          (patterns->body where)            ; 'where' here is the Datalog :where clause.
+        (patterns->context where))    ; 'where' here is the Datalog :where clause.
-          variable-lookup #(or (first (%1 bindings))
+      (:elements find))))
-                               (raise (str "Couldn't find variable " %1)))
-          where-from-bindings (bindings->where bindings)]
-
-      ;; Now we expand the :where clause to also include any
-      ;; repeated variable usage, as noted in `bindings`.
-      {:select (elements->sql-projection (:elements find) variable-lookup)
-       :from from
-       :where (if where-from-bindings
-                (list :and where where-from-bindings)
-                where)})))
 
 (defn find->sql-string
   "Take a parsed `find` expression and turn it into SQL."
@@ -173,16 +199,12 @@
   (dp/parse-query q))
 
 (comment
-  (find->sql-string
+  (datomish.query/find->sql-string
     (datomish.query/parse
-      '[:find ?page
+      '[:find ?page :in $ :where [?page :page/starred true ?t] ])))
-      :in $
-      :where
-      [?page :page/starred true ?t]
-     ])))
 
 (comment
-  (find->sql-string
+  (datomish.query/find->sql-string
     (datomish.query/parse
       '[:find ?timestampMicros ?page
       :in $