Get execution to a point where we can run (<?q db find args).
This commit is contained in:
parent
ae0dac2817
commit
96caadb189
7 changed files with 73 additions and 65 deletions
|
@ -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,
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
||||||
|
|
|
@ -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))
|
|
|
@ -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)))))
|
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
Loading…
Reference in a new issue