From 0832396071bd3dc944a1f3ac0c8c17ca7fdadc01 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. Signed-off-by: Richard Newman --- src/datomish/query.cljc | 182 +++++++++++++++++++++++++++++ src/datomish/transforms.cljc | 17 +++ src/datomish/util.cljc | 15 +++ test/datomish/test.cljs | 7 ++ test/datomish/test/query.cljs | 7 ++ test/datomish/test/transforms.cljs | 23 ++++ test/datomish/test/util.cljs | 17 +++ 7 files changed, 268 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.cljs create mode 100644 test/datomish/test/transforms.cljs create mode 100644 test/datomish/test/util.cljs diff --git a/src/datomish/query.cljc b/src/datomish/query.cljc new file mode 100644 index 00000000..22c452bb --- /dev/null +++ b/src/datomish/query.cljc @@ -0,0 +1,182 @@ +(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]])] + [clojure.string :as str] + [honeysql.core :as sql] + ) + #?(:clj (:import [datascript.parser Pattern DefaultSrc Variable Constant])) + ) + +;; Setting this to something else will make your output more readable, +;; but not automatically safe for use. +(def quote-style :ansi) + +(defn pattern->parts + "Transform a DataScript Pattern instance into the parts needed + to build a SQL expression. + + @arg pattern The pattern instance. + @arg attribute-transform A function from attribute to constant value. Used to + turn, e.g., :p/attribute into an interned integer. + @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")))] + + (loop [places (:pattern pattern) + columns [:e :a :v :t :added] + bindings (transient {}) ; Maps from var to list of qualified columns. + wheres (transient [])] ; Fragments, each an expression. + + (if (empty? places) + ;; We're done. + {: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 + Variable + ;; We might get a pattern like this: + ;; [?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) + 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))))))))) + +(defn bindings->where + "Take a map like + {?foo [:eavt12.e :eavt13.v :eavt14.e]} + and produce a :where expression like + (:and [:= :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] + (cons :and + (mapcat (fn [[k vs]] + (when (> (count vs) 1) + (let [root (first vs)] + (map (fn [v] [:= root v]) (rest vs))))) + bindings))) + +(defn patterns->body [patterns] + (let [clauses + (map (fn [p] + (pattern->parts p + transforms/attribute-transform-string + transforms/constant-transform-default)) + patterns)] + {:from (map :from clauses) + :where (cons :and (mapcat :where clauses)) + :bindings (apply merge-with concat (map :bindings clauses))})) + +(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. + + @param elements The input clause. + @param variable-lookup A function from symbol to column name. + @return a sequence of pairs." + [elements variable-lookup] + (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)])) + elements)) + +(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) + + (let [{:keys [from where bindings]} ; 'where' here is SQL. + (patterns->body where) ; 'where' here is the Datalog :where clause. + variable-lookup #(or (first (%1 bindings)) + (raise (str "Couldn't find variable " %1)))] + + ;; 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 (list :and + where + (bindings->where bindings))}))) + +(defn find->sql-string + "Take a parsed `find` expression and turn it into SQL." + [find] + (-> find find->sql-clause (sql/format :quoting quote-style))) + +(defn parse + "Parse a Datalog query array into a structured `find` expression." + [q] + (dp/parse-query q)) + +(comment + (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..95525c5c --- /dev/null +++ b/src/datomish/transforms.cljc @@ -0,0 +1,17 @@ +(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..6829d68f --- /dev/null +++ b/src/datomish/util.cljc @@ -0,0 +1,15 @@ +(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] + (when-not (and (symbol? x) + (str/starts-with? (name x) "?")) + (raise (str x " is not a Datalog var."))) + (keyword (subs (name x) 1))) 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.cljs b/test/datomish/test/query.cljs new file mode 100644 index 00000000..edc7e4ef --- /dev/null +++ b/test/datomish/test/query.cljs @@ -0,0 +1,7 @@ +(ns datomish.test.query + (:require + [cljs.test :as t :refer-macros [is are deftest testing]] + [datomish.query :as dq])) + +(deftest test-query + (is (= 1 1))) diff --git a/test/datomish/test/transforms.cljs b/test/datomish/test/transforms.cljs new file mode 100644 index 00000000..578ca644 --- /dev/null +++ b/test/datomish/test/transforms.cljs @@ -0,0 +1,23 @@ +(ns datomish.test.transforms + (:require + [cljs.test :as t :refer-macros [is are deftest testing]] + [datomish.transforms :as transforms])) + +(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. + (is (= 1 (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.cljs b/test/datomish/test/util.cljs new file mode 100644 index 00000000..bc4bdef2 --- /dev/null +++ b/test/datomish/test/util.cljs @@ -0,0 +1,17 @@ +(ns datomish.test.util + (:require + [cljs.test :as t :refer-macros [is are deftest testing]] + [datomish.util :as util])) + +(deftest test-var-translation + (is (= :x (util/var->sql-var '?x))) + (is (= :XX (util/var->sql-var '?XX)))) + +(deftest test-raise + (let [caught + (try + (do + (util/raise "succeed") + "fail") + (catch :default e e))] + (is (= "succeed" (aget caught "message")))))