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:
Richard Newman 2016-09-01 19:14:27 -07:00
parent e48f58f5f4
commit 1197764949
5 changed files with 133 additions and 41 deletions

View file

@ -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]
(<?q db find {}))
([db find options]
(a/reduce (partial reduce-error-pair conj) [[] nil] (a/reduce (partial reduce-error-pair conj) [[] nil]
(<?run db find args))) (<?run db find options))))

View file

@ -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)))
limit (:limit context)
order-by (:order-by-vars context)]
(if (:has-aggregates? context) (if (:has-aggregates? context)
(let [outer-projection (projection/sql-projection-for-aggregation context :preag)]
;; Validate the projected vars against the ordering clauses.
(merge (merge
(limit-and-order limit outer-projection order-by)
(when-not (empty? (:group-by-vars context)) (when-not (empty? (:group-by-vars context))
;; We shouldn't need to account for types here, until we account for ;; We shouldn't need to account for types here, until we account for
;; `:or` clauses that bind from different attributes. ;; `:or` clauses that bind from different attributes.
{:group-by (map util/var->sql-var (:group-by-vars context))}) {:group-by (map util/var->sql-var (:group-by-vars context))})
{:select (projection/sql-projection-for-aggregation context :preag) {:select outer-projection
:modifiers [:distinct] :modifiers [:distinct]
:from [:preag] :from [:preag]
:with {:preag inner}}) :with {:preag inner}}))
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

View file

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

View file

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

View file

@ -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}))]
(is (= 1 (count only-one)))
(is (= (select-keys (first only-one)
[:uri :title]) [:uri :title])
{:uri "http://notitle.example.org/" {:uri "http://notitle.example.org/"
:title ""})) :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}))