Implement :limit and :order-by-vars. Fixes #37.
We'd like this to be part of the query syntax itself, but doing so requires extending DataScript's parser. Instead we generalize our `args` to `options`, and take `:limit` and `:order-by-vars`. The former must be an integer or nil, and the latter is an array of `[var direction]` pairs. This commit includes descriptive error messages and tests for success and failure.
This commit is contained in:
parent
e48f58f5f4
commit
1197764949
5 changed files with 133 additions and 41 deletions
|
@ -643,10 +643,12 @@
|
||||||
"Execute the provided query on the provided DB.
|
"Execute the provided query on the provided DB.
|
||||||
Returns a transduced channel of [result err] pairs.
|
Returns a transduced channel of [result err] pairs.
|
||||||
Closes the channel when fully consumed."
|
Closes the channel when fully consumed."
|
||||||
[db find args]
|
[db find options]
|
||||||
(let [parsed (query/parse find)
|
(let [{:keys [limit order-by args]} options
|
||||||
|
parsed (query/parse find)
|
||||||
context (-> db
|
context (-> db
|
||||||
query-context
|
query-context
|
||||||
|
(query/options-into-context limit order-by)
|
||||||
(query/find-into-context parsed))
|
(query/find-into-context parsed))
|
||||||
row-pair-transducer (projection/row-pair-transducer context)
|
row-pair-transducer (projection/row-pair-transducer context)
|
||||||
sql (query/context->sql-string context args)
|
sql (query/context->sql-string context args)
|
||||||
|
@ -665,6 +667,8 @@
|
||||||
(defn <?q
|
(defn <?q
|
||||||
"Execute the provided query on the provided DB.
|
"Execute the provided query on the provided DB.
|
||||||
Returns a transduced pair-chan with one [[results] err] item."
|
Returns a transduced pair-chan with one [[results] err] item."
|
||||||
[db find args]
|
([db find]
|
||||||
(a/reduce (partial reduce-error-pair conj) [[] nil]
|
(<?q db find {}))
|
||||||
(<?run db find args)))
|
([db find options]
|
||||||
|
(a/reduce (partial reduce-error-pair conj) [[] nil]
|
||||||
|
(<?run db find options))))
|
||||||
|
|
|
@ -39,27 +39,59 @@
|
||||||
;; but not automatically safe for use.
|
;; but not automatically safe for use.
|
||||||
(def sql-quoting-style :ansi)
|
(def sql-quoting-style :ansi)
|
||||||
|
|
||||||
|
(defn- validated-order-by [projection order-by]
|
||||||
|
(let [ordering-vars (set (map first order-by))
|
||||||
|
projected-vars (set (map second projection))]
|
||||||
|
|
||||||
|
(when-not (every? #{:desc :asc} (map second order-by))
|
||||||
|
(raise-str "Ordering expressions must be :asc or :desc."))
|
||||||
|
(when-not
|
||||||
|
(clojure.set/subset? ordering-vars projected-vars)
|
||||||
|
(raise "Ordering vars " ordering-vars " not a subset of projected vars " projected-vars
|
||||||
|
{:projected projected-vars
|
||||||
|
:ordering ordering-vars}))
|
||||||
|
|
||||||
|
order-by))
|
||||||
|
|
||||||
|
(defn- limit-and-order [limit projection order-by]
|
||||||
|
(when (or limit order-by)
|
||||||
|
(util/assoc-if {}
|
||||||
|
:limit limit
|
||||||
|
:order-by (validated-order-by projection order-by))))
|
||||||
|
|
||||||
(defn context->sql-clause [context]
|
(defn context->sql-clause [context]
|
||||||
(let [inner
|
(let [inner-projection (projection/sql-projection-for-relation context)
|
||||||
|
inner
|
||||||
(merge
|
(merge
|
||||||
{:select (projection/sql-projection-for-relation context)
|
{:select inner-projection
|
||||||
|
|
||||||
;; Always SELECT DISTINCT, because Datalog is set-based.
|
;; Always SELECT DISTINCT, because Datalog is set-based.
|
||||||
;; TODO: determine from schema analysis whether we can avoid
|
;; TODO: determine from schema analysis whether we can avoid
|
||||||
;; the need to do this.
|
;; the need to do this.
|
||||||
:modifiers [:distinct]}
|
:modifiers [:distinct]}
|
||||||
(clauses/cc->partial-subquery (:cc context)))]
|
(clauses/cc->partial-subquery (:cc context)))
|
||||||
(if (:has-aggregates? context)
|
|
||||||
(merge
|
limit (:limit context)
|
||||||
(when-not (empty? (:group-by-vars context))
|
order-by (:order-by-vars context)]
|
||||||
;; We shouldn't need to account for types here, until we account for
|
|
||||||
;; `:or` clauses that bind from different attributes.
|
(if (:has-aggregates? context)
|
||||||
{:group-by (map util/var->sql-var (:group-by-vars context))})
|
(let [outer-projection (projection/sql-projection-for-aggregation context :preag)]
|
||||||
{:select (projection/sql-projection-for-aggregation context :preag)
|
;; Validate the projected vars against the ordering clauses.
|
||||||
:modifiers [:distinct]
|
(merge
|
||||||
:from [:preag]
|
(limit-and-order limit outer-projection order-by)
|
||||||
:with {:preag inner}})
|
(when-not (empty? (:group-by-vars context))
|
||||||
inner)))
|
;; We shouldn't need to account for types here, until we account for
|
||||||
|
;; `:or` clauses that bind from different attributes.
|
||||||
|
{:group-by (map util/var->sql-var (:group-by-vars context))})
|
||||||
|
{:select outer-projection
|
||||||
|
:modifiers [:distinct]
|
||||||
|
:from [:preag]
|
||||||
|
:with {:preag inner}}))
|
||||||
|
|
||||||
|
;; Otherwise, validate against the inner.
|
||||||
|
(merge
|
||||||
|
(limit-and-order limit inner-projection order-by)
|
||||||
|
inner))))
|
||||||
|
|
||||||
(defn context->sql-string [context args]
|
(defn context->sql-string [context args]
|
||||||
(->
|
(->
|
||||||
|
@ -96,6 +128,14 @@
|
||||||
{}
|
{}
|
||||||
in))
|
in))
|
||||||
|
|
||||||
|
(defn options-into-context
|
||||||
|
[context limit order-by]
|
||||||
|
(when-not (or (and (integer? limit)
|
||||||
|
(pos? limit))
|
||||||
|
(nil? limit))
|
||||||
|
(raise "Invalid limit " limit {:limit limit}))
|
||||||
|
(assoc context :limit limit :order-by-vars order-by))
|
||||||
|
|
||||||
(defn find-into-context
|
(defn find-into-context
|
||||||
"Take a parsed `find` expression and return a fully populated
|
"Take a parsed `find` expression and return a fully populated
|
||||||
Context. You'll want this so you can get access to the
|
Context. You'll want this so you can get access to the
|
||||||
|
|
|
@ -12,8 +12,10 @@
|
||||||
elements ; The :find list itself.
|
elements ; The :find list itself.
|
||||||
has-aggregates?
|
has-aggregates?
|
||||||
group-by-vars ; A list of variables from :find and :with, used to generate GROUP BY.
|
group-by-vars ; A list of variables from :find and :with, used to generate GROUP BY.
|
||||||
|
order-by-vars ; A list of projected variables and directions, e.g., [:date :asc], [:_max_timestamp :desc].
|
||||||
|
limit ; The limit to apply to the final results of the query. Only makes sense with ORDER BY.
|
||||||
cc ; The main conjoining clause.
|
cc ; The main conjoining clause.
|
||||||
])
|
])
|
||||||
|
|
||||||
(defn make-context [source]
|
(defn make-context [source]
|
||||||
(->Context source nil false nil nil))
|
(->Context source nil false nil nil nil nil))
|
||||||
|
|
|
@ -517,3 +517,53 @@
|
||||||
[?page :page/url _]
|
[?page :page/url _]
|
||||||
[(get-else $ ?page :page/title "No title") ?title]]
|
[(get-else $ ?page :page/title "No title") ?title]]
|
||||||
conn)))))
|
conn)))))
|
||||||
|
|
||||||
|
(deftest-db test-limit-order conn
|
||||||
|
(let [attrs (<? (<initialize-with-schema conn aggregate-schema))
|
||||||
|
context
|
||||||
|
(populate '[:find ?date (max ?v)
|
||||||
|
:with ?e
|
||||||
|
:in $ ?then
|
||||||
|
:where
|
||||||
|
[?e :foo/visitedAt ?date]
|
||||||
|
[(> ?date ?then)]
|
||||||
|
[?e :foo/points ?v]] conn)]
|
||||||
|
(is
|
||||||
|
(thrown-with-msg?
|
||||||
|
ExceptionInfo #"Invalid limit \?x"
|
||||||
|
(query/options-into-context context '?x [[:date :asc]])))
|
||||||
|
(is
|
||||||
|
(thrown-with-msg?
|
||||||
|
ExceptionInfo #"Ordering expressions must be :asc or :desc"
|
||||||
|
(query/context->sql-clause
|
||||||
|
(query/options-into-context context 10 [[:date :upsidedown]]))))
|
||||||
|
(is
|
||||||
|
(thrown-with-msg?
|
||||||
|
ExceptionInfo #"Ordering vars \#\{:nonexistent\} not a subset"
|
||||||
|
(query/context->sql-clause
|
||||||
|
(query/options-into-context context 10 [[:nonexistent :desc]]))))
|
||||||
|
(is
|
||||||
|
(=
|
||||||
|
{:limit 10}
|
||||||
|
(select-keys
|
||||||
|
(query/context->sql-clause
|
||||||
|
(query/options-into-context context 10 nil))
|
||||||
|
[:order-by :limit]
|
||||||
|
)))
|
||||||
|
(is
|
||||||
|
(=
|
||||||
|
{:order-by [[:date :asc]]}
|
||||||
|
(select-keys
|
||||||
|
(query/context->sql-clause
|
||||||
|
(query/options-into-context context nil [[:date :asc]]))
|
||||||
|
[:order-by :limit]
|
||||||
|
)))
|
||||||
|
(is
|
||||||
|
(=
|
||||||
|
{:limit 10
|
||||||
|
:order-by [[:date :asc]]}
|
||||||
|
(select-keys
|
||||||
|
(query/context->sql-clause
|
||||||
|
(query/options-into-context context 10 [[:date :asc]]))
|
||||||
|
[:order-by :limit]
|
||||||
|
)))))
|
||||||
|
|
|
@ -176,8 +176,7 @@
|
||||||
[?id :session/startReason ?reason ?tx]
|
[?id :session/startReason ?reason ?tx]
|
||||||
[?tx :db/txInstant ?ts]
|
[?tx :db/txInstant ?ts]
|
||||||
(not-join [?id]
|
(not-join [?id]
|
||||||
[?id :session/endReason _])]
|
[?id :session/endReason _])]))
|
||||||
{}))
|
|
||||||
|
|
||||||
(defn <ended-sessions [db]
|
(defn <ended-sessions [db]
|
||||||
(d/<q
|
(d/<q
|
||||||
|
@ -185,8 +184,7 @@
|
||||||
'[:find ?id ?endReason ?ts :in $
|
'[:find ?id ?endReason ?ts :in $
|
||||||
:where
|
:where
|
||||||
[?id :session/endReason ?endReason ?tx]
|
[?id :session/endReason ?endReason ?tx]
|
||||||
[?tx :db/txInstant ?ts]]
|
[?tx :db/txInstant ?ts]]))
|
||||||
{}))
|
|
||||||
|
|
||||||
(defn <star-page [conn {:keys [url uri title session]}]
|
(defn <star-page [conn {:keys [url uri title session]}]
|
||||||
(let [page (d/id-literal :db.part/user -1)]
|
(let [page (d/id-literal :db.part/user -1)]
|
||||||
|
@ -214,8 +212,7 @@
|
||||||
[?tx :db/txInstant ?starredOn]
|
[?tx :db/txInstant ?starredOn]
|
||||||
[?page :page/url ?uri]
|
[?page :page/url ?uri]
|
||||||
[?page :page/title ?title] ; N.B., this means we will exclude pages with no title.
|
[?page :page/title ?title] ; N.B., this means we will exclude pages with no title.
|
||||||
]
|
]))
|
||||||
{}))
|
|
||||||
|
|
||||||
(map (fn [[page uri title starredOn]]
|
(map (fn [[page uri title starredOn]]
|
||||||
{:page page :uri uri :title title :starredOn starredOn})))))
|
{:page page :uri uri :title title :starredOn starredOn})))))
|
||||||
|
@ -248,8 +245,7 @@
|
||||||
[?save :save/page ?page]
|
[?save :save/page ?page]
|
||||||
[?page :page/url ?url]
|
[?page :page/url ?url]
|
||||||
[(get-else $ ?save :save/title "") ?title]
|
[(get-else $ ?save :save/title "") ?title]
|
||||||
[(get-else $ ?save :save/excerpt "") ?excerpt]]
|
[(get-else $ ?save :save/excerpt "") ?excerpt]]))
|
||||||
{}))
|
|
||||||
|
|
||||||
(defn <saved-pages-matching-string [db string]
|
(defn <saved-pages-matching-string [db string]
|
||||||
(d/<q db
|
(d/<q db
|
||||||
|
@ -259,8 +255,7 @@
|
||||||
'[?save :save/page ?page]
|
'[?save :save/page ?page]
|
||||||
'[?page :page/url ?url]
|
'[?page :page/url ?url]
|
||||||
'[(get-else $ ?save :save/title "") ?title]
|
'[(get-else $ ?save :save/title "") ?title]
|
||||||
'[(get-else $ ?save :save/excerpt "") ?excerpt]]}
|
'[(get-else $ ?save :save/excerpt "") ?excerpt]]}))
|
||||||
{}))
|
|
||||||
|
|
||||||
|
|
||||||
;; TODO: return ID?
|
;; TODO: return ID?
|
||||||
|
@ -305,13 +300,12 @@
|
||||||
{:find '[?uri ?title (max ?time)]
|
{:find '[?uri ?title (max ?time)]
|
||||||
:in (if since '[$ ?since] '[$])
|
:in (if since '[$ ?since] '[$])
|
||||||
:where where}
|
:where where}
|
||||||
{:since since}))]
|
{:limit limit
|
||||||
(->>
|
:order-by [[:_max_time :desc]]
|
||||||
rows
|
:args {:since since}}))]
|
||||||
(sort-by (comp unchecked-negate third)) ;; TODO: these should be dates!
|
|
||||||
(take limit)
|
|
||||||
(map (fn [[uri title lastVisited]]
|
(map (fn [[uri title lastVisited]]
|
||||||
{:uri uri :title title :lastVisited lastVisited})))))))
|
{:uri uri :title title :lastVisited lastVisited})
|
||||||
|
rows)))))
|
||||||
|
|
||||||
(defn <find-title [db url]
|
(defn <find-title [db url]
|
||||||
;; Until we support [:find ?title . :in…] we crunch this by hand.
|
;; Until we support [:find ?title . :in…] we crunch this by hand.
|
||||||
|
@ -324,7 +318,7 @@
|
||||||
:where
|
:where
|
||||||
[?page :page/url ?url]
|
[?page :page/url ?url]
|
||||||
[(get-else $ ?page :page/title "") ?title]]
|
[(get-else $ ?page :page/title "") ?title]]
|
||||||
{:url url}))))))
|
{:args {:url url}}))))))
|
||||||
|
|
||||||
;; Ensure that we can grow the schema over time.
|
;; Ensure that we can grow the schema over time.
|
||||||
(deftest-db test-schema-evolution conn
|
(deftest-db test-schema-evolution conn
|
||||||
|
@ -385,10 +379,12 @@
|
||||||
(<? (<add-visit conn {:uri "http://notitle.example.org/"
|
(<? (<add-visit conn {:uri "http://notitle.example.org/"
|
||||||
:session session}))
|
:session session}))
|
||||||
(is (= "" (<? (<find-title (d/db conn) "http://notitle.example.org/"))))
|
(is (= "" (<? (<find-title (d/db conn) "http://notitle.example.org/"))))
|
||||||
(is (= (select-keys (first (<? (<visited (d/db conn) {:limit 1})))
|
(let [only-one (<? (<visited (d/db conn) {:limit 1}))]
|
||||||
[:uri :title])
|
(is (= 1 (count only-one)))
|
||||||
{:uri "http://notitle.example.org/"
|
(is (= (select-keys (first only-one)
|
||||||
:title ""}))
|
[:uri :title])
|
||||||
|
{:uri "http://notitle.example.org/"
|
||||||
|
:title ""})))
|
||||||
|
|
||||||
;; If we end this one, then it's no longer active but is ended.
|
;; If we end this one, then it's no longer active but is ended.
|
||||||
(<? (<end-session conn {:session session}))
|
(<? (<end-session conn {:session session}))
|
||||||
|
|
Loading…
Reference in a new issue