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

Signed-off-by: Richard Newman <rnewman@twinql.com>
This commit is contained in:
Richard Newman 2016-07-12 21:13:38 -07:00
parent 69348eb0b4
commit cb1390a36e

View file

@ -7,127 +7,163 @@
[datomish.util :as util :refer [raise var->sql-var]] [datomish.util :as util :refer [raise var->sql-var]]
[datomish.transforms :as transforms] [datomish.transforms :as transforms]
[datascript.parser :as dp [datascript.parser :as dp
#?@(:cljs [:refer [Pattern DefaultSrc Variable Constant]])] #?@(:cljs [:refer [Pattern DefaultSrc Variable Constant Placeholder]])]
[clojure.string :as str] [clojure.string :as str]
[honeysql.core :as sql] [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, ;; Setting this to something else will make your output more readable,
;; but not automatically safe for use. ;; but not automatically safe for use.
(def sql-quoting-style :ansi) (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 "Transform a DataScript Pattern instance into the parts needed
to build a SQL expression. to build a SQL expression.
@arg context A Context instance.
@arg pattern The pattern 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) (when-not (instance? Pattern pattern)
(raise "Expected to be called with a Pattern instance.")) (raise "Expected to be called with a Pattern instance."))
(when-not (instance? DefaultSrc (:source pattern)) (when-not (instance? DefaultSrc (:source pattern))
(raise (str "Non-default sources are not supported in patterns. Pattern: " (raise (str "Non-default sources are not supported in patterns. Pattern: "
(print-str 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 (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 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 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]} {?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 TODO: experiment; it might be the case that producing more
pairwise equalities we get better or worse performance." pairwise equalities we get better or worse performance."
[bindings] [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 (defn elements->sql-projection
"Take a `find` clause's `:elements` list and turn it into a SQL "Take a `find` clause's `:elements` list and turn it into a SQL
projection clause, suitable for passing as a `:select` clause to projection clause, suitable for passing as a `:select` clause to
honeysql. honeysql.
Example: For example:
[Variable{:symbol ?foo}, Variable{:symbol ?bar}] [Variable{:symbol ?foo}, Variable{:symbol ?bar}]
with bindings in the context:
{?foo [:eavt12.e :eavt13.v], ?bar [:eavt13.e]} {?foo [:eavt12.e :eavt13.v], ?bar [:eavt13.e]}
=>
=>
[[:eavt12.e :foo] [:eavt13.e :bar]] [[:eavt12.e :foo] [:eavt13.e :bar]]
@param context A Context.
@param elements The input clause. @param elements The input clause.
@param variable-lookup A function from symbol to column name.
@return a sequence of pairs." @return a sequence of pairs."
[elements variable-lookup] [context elements]
(when-not (every? #(instance? Variable %1) elements) (when-not (every? #(instance? Variable %1) elements)
(raise "Unable to :find non-variables.")) (raise "Unable to :find non-variables."))
(map (fn [elem] (map (fn [elem]
(let [var (:symbol elem)] (let [var (:symbol elem)]
[(variable-lookup var) (var->sql-var var)])) [(lookup-variable context var) (var->sql-var var)]))
elements)) 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] (defn- validate-with [with]
(when-not (nil? with) (when-not (nil? with)
(raise "`with` not supported."))) (raise "`with` not supported.")))
@ -147,20 +183,10 @@
(let [{:keys [find in with where]} find] ; Destructure the Datalog query. (let [{:keys [find in with where]} find] ; Destructure the Datalog query.
(validate-with with) (validate-with with)
(validate-in in) (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 (defn find->sql-string
"Take a parsed `find` expression and turn it into SQL." "Take a parsed `find` expression and turn it into SQL."
@ -173,16 +199,12 @@
(dp/parse-query q)) (dp/parse-query q))
(comment (comment
(find->sql-string (datomish.query/find->sql-string
(datomish.query/parse (datomish.query/parse
'[:find ?page '[:find ?page :in $ :where [?page :page/starred true ?t] ])))
:in $
:where
[?page :page/starred true ?t]
])))
(comment (comment
(find->sql-string (datomish.query/find->sql-string
(datomish.query/parse (datomish.query/parse
'[:find ?timestampMicros ?page '[:find ?timestampMicros ?page
:in $ :in $