First pass at translating Datalog queries into SQL. r=nalexander

Signed-off-by: Richard Newman <rnewman@twinql.com>
This commit is contained in:
Richard Newman 2016-07-06 16:55:12 -07:00
parent 75810b924e
commit db68a714f6
7 changed files with 339 additions and 0 deletions

225
src/datomish/query.cljc Normal file
View file

@ -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))

View file

@ -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)))

31
src/datomish/util.cljc Normal file
View file

@ -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))))

View file

@ -3,8 +3,15 @@
[doo.runner :refer-macros [doo-tests doo-all-tests]] [doo.runner :refer-macros [doo-tests doo-all-tests]]
[cljs.test :as t :refer-macros [is are deftest testing]] [cljs.test :as t :refer-macros [is are deftest testing]]
datomish.promise-sqlite-test datomish.promise-sqlite-test
datomish.test.util
datomish.test.transforms
datomish.test.query
datomish.test.core
datomish.test-macros-test)) datomish.test-macros-test))
(doo-tests (doo-tests
'datomish.promise-sqlite-test 'datomish.promise-sqlite-test
'datomish.test.util
'datomish.test.transforms
'datomish.test.query
'datomish.test-macros-test) 'datomish.test-macros-test)

View file

@ -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)))

View file

@ -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"))))

View file

@ -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"))))))