Get execution to a point where we can run (<?q db find args).

This commit is contained in:
Richard Newman 2016-07-21 18:59:11 -07:00
parent ae0dac2817
commit 96caadb189
7 changed files with 73 additions and 65 deletions

View file

@ -32,7 +32,8 @@
;; * Projection expressions, if only used for output. ;; * Projection expressions, if only used for output.
;; * Inline expressions? ;; * Inline expressions?
;; `not` turns into NOT EXISTS with WHERE clauses inside the subquery to ;; `not` turns into NOT EXISTS with WHERE clauses inside the subquery to
;; bind it to the outer variables. ;; bind it to the outer variables, or adds simple WHERE clauses to the outer
;; clause.
;; `not-join` is similar, but with explicit binding. ;; `not-join` is similar, but with explicit binding.
;; `or` turns into a collection of UNIONs inside a subquery. ;; `or` turns into a collection of UNIONs inside a subquery.
;; `or`'s documentation states that all clauses must include the same vars, ;; `or`'s documentation states that all clauses must include the same vars,

View file

@ -8,25 +8,63 @@
[datomish.pair-chan :refer [go-pair <?]] [datomish.pair-chan :refer [go-pair <?]]
[cljs.core.async.macros :refer [go]])) [cljs.core.async.macros :refer [go]]))
(:require (:require
[datomish.util :as util :refer [raise-str]] [datomish.context :as context]
[datomish.projection :as projection]
[datomish.query :as query]
[datomish.source :as source]
[datomish.sqlite :as s] [datomish.sqlite :as s]
[datomish.sqlite-schema :as sqlite-schema] [datomish.sqlite-schema :as sqlite-schema]
[datomish.util :as util :refer [raise-str]]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]] #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
[clojure.core.async :as a :refer [go <! >!]]]) [clojure.core.async :as a :refer [chan go <! >!]]])
#?@(:cljs [[datomish.pair-chan] #?@(:cljs [[datomish.pair-chan]
[cljs.core.async :as a :refer [<! >!]]]))) [cljs.core.async :as a :refer [chan <! >!]]])))
(defprotocol IDB (defprotocol IDB
(query-context
[db])
(close (close
[db] [db]
"Close this database. Returns a pair channel of [nil error].")) "Close this database. Returns a pair channel of [nil error]."))
(defrecord DB [sqlite-connection] (defrecord DB [sqlite-connection]
IDB IDB
(close [db] (close (.-sqlite-connection db)))) (query-context [db] (context/->Context (source/datoms-source db) nil nil))
(close [db] (s/close (.-sqlite-connection db))))
(defn <with-sqlite-connection [sqlite-connection] (defn <with-sqlite-connection [sqlite-connection]
(go-pair (go-pair
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection))) (when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
(raise-str "Could not ensure current SQLite schema version.")) (raise-str "Could not ensure current SQLite schema version."))
(->DB sqlite-connection))) (->DB sqlite-connection)))
(defn <?run
"Execute the provided query on the provided DB.
Returns a transduced channel of [result err] pairs.
Closes the channel when fully consumed."
[db find args]
(let [parsed (query/parse find)
context (-> db
query-context
(query/expand-find-into-context parsed))
row-pair-transducer (projection/row-pair-transducer context)
sql (query/context->sql-string context args)
chan (chan 50 row-pair-transducer)]
(s/<?all-rows (.-sqlite-connection db) sql chan)
chan))
(defn reduce-error-pair [f [rv re] [v e]]
(if re
[nil re]
(if e
[nil e]
[(f rv v) nil])))
(defn <?q
"Execute the provided query on the provided DB.
Returns a transduced pair-chan with one [[results] err] item."
[db find args]
(a/reduce (partial reduce-error-pair conj) [[] nil]
(<?run db find args)))

View file

@ -1,40 +0,0 @@
;; 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.exec
#?(:cljs
(:require-macros
[datomish.util :refer [while-let]]
[datomish.pair-chan :refer [go-pair <?]]
[cljs.core.async.macros :refer [go]]))
(:require
[datomish.sqlite :as s]
[datomish.sqlite-schema :as ss]
[datomish.query :as dq]
#?@(:clj
[[datomish.jdbc-sqlite]
[datomish.pair-chan :refer [go-pair <?]]
[datomish.util :refer [while-let]]
[clojure.core.async :refer
[go ; macro in cljs.
<! >! chan close! take!]]])
#?@(:cljs
[[datomish.promise-sqlite]
[datomish.pair-chan]
[datomish.util]
[cljs.core.async :as a :refer
[<! >! chan close! take!]]])))
(defn <?run
"Execute the provided query on the provided DB.
Returns a transduced channel of [result err] pairs.
Closes the channel when fully consumed."
[db find]
(let [initial-context (dq/make-context)
context (dq/expand-find-into-context initial-context (dq/parse find))
row-pair-transducer (dq/row-pair-transducer context (dq/sql-projection context))
chan (chan 50 row-pair-transducer)]
(s/<?all-rows db (dq/context->sql-string context) chan)
chan))

View file

@ -9,6 +9,7 @@
[datomish.pair-chan :refer [go-pair <?]] [datomish.pair-chan :refer [go-pair <?]]
[cljs.core.async.macros :refer [go]])) [cljs.core.async.macros :refer [go]]))
(:require (:require
[datomish.db :as db]
[datomish.exec :as exec] [datomish.exec :as exec]
[datomish.sqlite :as s] [datomish.sqlite :as s]
[datomish.sqlite-schema :as ss] [datomish.sqlite-schema :as ss]
@ -41,7 +42,7 @@
[db find] [db find]
(pair-channel->lazy-seq (exec/<?run db find)))) (pair-channel->lazy-seq (exec/<?run db find))))
#_(defn xxopen [] (defn xxopen []
(datomish.pair-chan/go-pair (datomish.pair-chan/go-pair
(let [d (datomish.pair-chan/<? (s/<sqlite-connection "/tmp/foo.sqlite"))] (let [d (datomish.pair-chan/<? (s/<sqlite-connection "/tmp/foo.sqlite"))]
(clojure.core.async/<!! (ss/<ensure-current-version d)) (clojure.core.async/<!! (ss/<ensure-current-version d))
@ -58,13 +59,10 @@
"/tmp/foo.sqlite" "/tmp/foo.sqlite"
'[:find ?page :in $ :where [?page :page/starred true ?t]])) '[:find ?page :in $ :where [?page :page/starred true ?t]]))
#_(defn test-run [] #_
(datomish.pair-chan/go-pair (go-pair
(let [d (datomish.pair-chan/<? (s/<sqlite-connection "/tmp/foo.sqlite"))] (let [connection (<? (s/<sqlite-connection "/tmp/foo.sqlite"))
(<! (ss/<ensure-current-version d)) d (<? (db/<with-sqlite-connection connection))]
(let [chan (exec/<?run d (println
'[:find ?page :in $ :where [?page :page/starred true ?t]])] "Result: "
(println (datomish.pair-chan/<? chan)) (<! (db/<?q d '[:find ?page :in $ :where [?page :page/starred true ?t]] {})))))
(println (datomish.pair-chan/<? chan))
(println (datomish.pair-chan/<? chan))
(s/close d)))))

View file

@ -12,7 +12,6 @@
) )
(defn lookup-variable [cc variable] (defn lookup-variable [cc variable]
(println "Looking up " variable " in " (:bindings cc))
(or (-> cc :bindings variable first) (or (-> cc :bindings variable first)
(raise-str "Couldn't find variable " variable))) (raise-str "Couldn't find variable " variable)))
@ -36,6 +35,7 @@
@param context A Context, containing elements. @param context A Context, containing elements.
@return a sequence of pairs." @return a sequence of pairs."
[context] [context]
(def foo context)
(let [elements (:elements context)] (let [elements (:elements context)]
(when-not (every? #(instance? Variable %1) elements) (when-not (every? #(instance? Variable %1) elements)
(raise-str "Unable to :find non-variables.")) (raise-str "Unable to :find non-variables."))
@ -44,10 +44,10 @@
[(lookup-variable (:cc context) var) (util/var->sql-var var)])) [(lookup-variable (:cc context) var) (util/var->sql-var var)]))
elements))) elements)))
(defn row-pair-transducer [context projection] (defn row-pair-transducer [context]
;; For now, we only support straight var lists, so ;; For now, we only support straight var lists, so
;; our transducer is trivial. ;; our transducer is trivial.
(let [columns-in-order (map second projection)] (let [columns-in-order (map second (sql-projection context))]
(map (fn [[row err]] (map (fn [[row err]]
(if err (if err
[row err] [row err]

View file

@ -60,6 +60,8 @@
(raise-str "`with` not supported."))) (raise-str "`with` not supported.")))
(defn- validate-in [in] (defn- validate-in [in]
(when (nil? in)
(raise-str ":in expression cannot be nil."))
(when-not (= "$" (name (-> in first :variable :symbol))) (when-not (= "$" (name (-> in first :variable :symbol)))
(raise-str "Non-default sources not supported.")) (raise-str "Non-default sources not supported."))
(when-not (every? (partial instance? BindScalar) (rest in)) (when-not (every? (partial instance? BindScalar) (rest in))
@ -81,7 +83,11 @@
{} {}
in)) in))
(defn expand-find-into-context [context find] (defn find-into-context
"Take a parsed `find` expression and return a fully populated
Context. You'll want this so you can get access to the
projection, amongst other things."
[context find]
(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)
@ -90,15 +96,18 @@
:elements (:elements find) :elements (:elements find)
:cc (clauses/patterns->cc (:default-source context) where external-bindings))))) :cc (clauses/patterns->cc (:default-source context) where external-bindings)))))
(defn context->sql-string
[context args]
(-> context
context->sql-clause
(sql/format args :quoting sql-quoting-style)))
(defn find->sql-clause (defn find->sql-clause
"Take a parsed `find` expression and turn it into a structured SQL "Take a parsed `find` expression and turn it into a structured SQL
expression that can be formatted by honeysql." expression that can be formatted by honeysql."
[context find] [context 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.
(->> find (->> find
(expand-find-into-context context) (find-into-context context)
context->sql-clause)) context->sql-clause))
(defn find->sql-string (defn find->sql-string

View file

@ -59,7 +59,9 @@
when no more results exist. Consume with <?." when no more results exist. Consume with <?."
[db [sql & bindings :as rest] chan] [db [sql & bindings :as rest] chan]
(go-safely [c chan] (go-safely [c chan]
(let [result (<! (-each db sql bindings (fn [row] (put! c [row nil]))))] (let [result (<! (-each db sql bindings
(fn [row]
(put! c [row nil]))))]
;; We assume that a failure will result in the promise ;; We assume that a failure will result in the promise
;; channel being rejected and no further row callbacks ;; channel being rejected and no further row callbacks
;; being called. ;; being called.