From db68a714f6620c8c9cd080b74622bd66929cf50e Mon Sep 17 00:00:00 2001 From: Richard Newman Date: Wed, 6 Jul 2016 16:55:12 -0700 Subject: [PATCH] First pass at translating Datalog queries into SQL. r=nalexander Signed-off-by: Richard Newman --- src/datomish/query.cljc | 225 +++++++++++++++++++++++++++++ src/datomish/transforms.cljc | 21 +++ src/datomish/util.cljc | 31 ++++ test/datomish/test.cljs | 7 + test/datomish/test/query.cljc | 9 ++ test/datomish/test/transforms.cljc | 26 ++++ test/datomish/test/util.cljc | 20 +++ 7 files changed, 339 insertions(+) create mode 100644 src/datomish/query.cljc create mode 100644 src/datomish/transforms.cljc create mode 100644 src/datomish/util.cljc create mode 100644 test/datomish/test/query.cljc create mode 100644 test/datomish/test/transforms.cljc create mode 100644 test/datomish/test/util.cljc diff --git a/src/datomish/query.cljc b/src/datomish/query.cljc new file mode 100644 index 00000000..7d976303 --- /dev/null +++ b/src/datomish/query.cljc @@ -0,0 +1,225 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. + +(ns datomish.query + (:require + [datomish.util :as util :refer [raise var->sql-var]] + [datomish.transforms :as transforms] + [datascript.parser :as dp + #?@(:cljs [:refer [Pattern DefaultSrc Variable Constant Placeholder]])] + [clojure.string :as str] + [honeysql.core :as sql] + ) + #?(: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) + +;; +;; 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. + @return an augmented Context." + [context pattern] + (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"))) + places (map (fn [place col] [place col]) + (:pattern pattern) + [:e :a :v :t :added])] + (reduce + (fn [context + [pattern-part ; ?x, :foo/bar, 42 + position]] ; :a + (let [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 + (bind-column-to-var context pattern-part col) + + Constant + (constrain-column-to-constant context col position (:value pattern-part)) + + (raise (str "Unknown pattern part " (print-str pattern-part)))))) + + ;; Record the new table mapping. + (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 list of constraints expression like + [[:= :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] + (println bindings) + (mapcat (fn [[_ vs]] + (when (> (count vs) 1) + (let [root (first vs)] + (map (fn [v] [:= root v]) (rest vs))))) + bindings)) + +(defn expand-where-from-bindings + "Take the bindings in the context and contribute + additional where clauses. Calling this more than + once will result in duplicate clauses." + [context] + (assoc context :wheres (concat (bindings->where (:bindings context)) + (:wheres context)))) + +(defn patterns->context + "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. + + 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. + @return a sequence of pairs." + [context elements] + (when-not (every? #(instance? Variable %1) elements) + (raise "Unable to :find non-variables.")) + (map (fn [elem] + (let [var (:symbol elem)] + [(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."))) + +(defn- validate-in [in] + (when-not (and (== 1 (count in)) + (= "$" (name (-> in first :variable :symbol)))) + (raise (str "Complex `in` not supported: " (print-str in))))) + +(defn find->sql-clause + "Take a parsed `find` expression and turn it into a structured SQL + expression that can be formatted by honeysql." + [find] + ;; There's some confusing use of 'where' and friends here. That's because + ;; the parsed Datalog includes :where, and it's also input to honeysql's + ;; SQL formatter. + (let [{:keys [find in with where]} find] ; Destructure the Datalog query. + (validate-with with) + (validate-in in) + (context->sql-clause + (expand-where-from-bindings + (patterns->context where)) ; 'where' here is the Datalog :where clause. + (:elements find)))) + +(defn find->sql-string + "Take a parsed `find` expression and turn it into SQL." + [find] + (-> find find->sql-clause (sql/format :quoting sql-quoting-style))) + +(defn parse + "Parse a Datalog query array into a structured `find` expression." + [q] + (dp/parse-query q)) + +(comment + (datomish.query/find->sql-string + (datomish.query/parse + '[:find ?page :in $ :where [?page :page/starred true ?t] ]))) + +(comment + (datomish.query/find->sql-string + (datomish.query/parse + '[:find ?timestampMicros ?page + :in $ + :where + [?page :page/starred true ?t] + [?t :db/txInstant ?timestampMicros]]))) + +(comment + (pattern->sql + (first + (:where + (datomish.query/parse + '[:find (max ?timestampMicros) (pull ?page [:page/url :page/title]) ?page + :in $ + :where + [?page :page/starred true ?t] + [?t :db/txInstant ?timestampMicros]]))) + identity)) diff --git a/src/datomish/transforms.cljc b/src/datomish/transforms.cljc new file mode 100644 index 00000000..3b48ae5b --- /dev/null +++ b/src/datomish/transforms.cljc @@ -0,0 +1,21 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. + +(ns datomish.transforms) + +#?(:clj + (defn boolean? [x] + (instance? Boolean x))) + +(defn attribute-transform-string + "Turns :p/foo into \"p/foo\". Adequate for testing, but this depends on the storage schema." + [x] + (str (namespace x) "/" (name x))) + +(defn constant-transform-default [x] + (if (boolean? x) + (if x 1 0) + (if (keyword? x) + (attribute-transform-string x) + x))) diff --git a/src/datomish/util.cljc b/src/datomish/util.cljc new file mode 100644 index 00000000..36099535 --- /dev/null +++ b/src/datomish/util.cljc @@ -0,0 +1,31 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. + +(ns datomish.util + (:require + [clojure.string :as str])) + +(defn raise [s] + #?(:clj (throw (Exception. s))) + #?(:cljs (throw (js/Error s)))) + +(defn var->sql-var + "Turns '?xyz into :xyz." + [x] + (if (and (symbol? x) + (str/starts-with? (name x) "?")) + (keyword (subs (name x) 1)) + (raise (str x " is not a Datalog var.")))) + +(defn conj-in + "Associates a value into a sequence in a nested associative structure, where + ks is a sequence of keys and v is the new value, and returns a new nested + structure. + If any levels do not exist, hash-maps will be created. If the destination + sequence does not exist, a new one is created." + {:static true} + [m [k & ks] v] + (if ks + (assoc m k (conj-in (get m k) ks v)) + (assoc m k (conj (get m k) v)))) diff --git a/test/datomish/test.cljs b/test/datomish/test.cljs index 66c36cdb..5be93fa1 100644 --- a/test/datomish/test.cljs +++ b/test/datomish/test.cljs @@ -3,8 +3,15 @@ [doo.runner :refer-macros [doo-tests doo-all-tests]] [cljs.test :as t :refer-macros [is are deftest testing]] datomish.promise-sqlite-test + datomish.test.util + datomish.test.transforms + datomish.test.query + datomish.test.core datomish.test-macros-test)) (doo-tests 'datomish.promise-sqlite-test + 'datomish.test.util + 'datomish.test.transforms + 'datomish.test.query 'datomish.test-macros-test) diff --git a/test/datomish/test/query.cljc b/test/datomish/test/query.cljc new file mode 100644 index 00000000..6f18e6e4 --- /dev/null +++ b/test/datomish/test/query.cljc @@ -0,0 +1,9 @@ +(ns datomish.test.query + (:require + [datomish.query :as dq] + #?(:clj [clojure.test :as t :refer [is are deftest testing]]) + #?(:cljs [cljs.test :as t :refer-macros [is are deftest testing]]) + )) + +(deftest test-query + (is (= 1 1))) diff --git a/test/datomish/test/transforms.cljc b/test/datomish/test/transforms.cljc new file mode 100644 index 00000000..2abdd0e2 --- /dev/null +++ b/test/datomish/test/transforms.cljc @@ -0,0 +1,26 @@ +(ns datomish.test.transforms + (:require + [datomish.transforms :as transforms] + #?(:clj [clojure.test :as t :refer [is are deftest testing]]) + #?(:cljs [cljs.test :as t :refer-macros [is are deftest testing]]) + )) + +(deftest test-attribute-transform-string + (is (= "p/foo" + (transforms/attribute-transform-string :p/foo)))) + +(deftest test-constant-transform-default + ;; Keywords. + (is (= "p/foo" (transforms/constant-transform-default :p/foo))) ; For now. + + ;; Booleans. + (is (= 1 (transforms/constant-transform-default true))) + (is (= 0 (transforms/constant-transform-default false))) + + ;; Numbers and strings. + #?(:cljs (is (= 1 (transforms/constant-transform-default 1.0)))) + #?(:clj (is (= 1.0 (transforms/constant-transform-default 1.0)))) + (is (= -1 (transforms/constant-transform-default -1))) + (is (= 42 (transforms/constant-transform-default 42))) + (is (= "" (transforms/constant-transform-default ""))) + (is (= "foo" (transforms/constant-transform-default "foo")))) diff --git a/test/datomish/test/util.cljc b/test/datomish/test/util.cljc new file mode 100644 index 00000000..291f6761 --- /dev/null +++ b/test/datomish/test/util.cljc @@ -0,0 +1,20 @@ +(ns datomish.test.util + (:require + [datomish.util :as util] + #?(:clj [clojure.test :as t :refer [is are deftest testing]]) + #?(:cljs [cljs.test :as t :refer-macros [is are deftest testing]]) + )) + +(deftest test-var-translation + (is (= :x (util/var->sql-var '?x))) + (is (= :XX (util/var->sql-var '?XX)))) + +#?(:cljs + (deftest test-raise + (let [caught + (try + (do + (util/raise "succeed") + "fail") + (catch :default e e))] + (is (= "succeed" (aget caught "message"))))))