Smarter merge-where and merge-having

This commit is contained in:
Cam Saul 2020-10-28 17:07:22 -07:00
parent 5e08761715
commit f4545362f9
2 changed files with 202 additions and 80 deletions

View file

@ -64,39 +64,87 @@
m
(assoc m :where pred)))
(defn- prep-where [args]
(let [[m preds] (if (map? (first args))
[(first args) (rest args)]
[{} args])
[logic-op preds] (if (keyword? (first preds))
[(first preds) (rest preds)]
[:and preds])
preds (remove nil? preds)
pred (if (>= 1 (count preds))
(first preds)
(into [logic-op] preds))]
[m pred logic-op]))
(defn- merge-where-args
"Handle optional args passed to `merge-where` or similar functions. Returns tuple of
[m where-clauses conjunction-operator]"
[args]
(let [[m & args] (if (map? (first args))
args
(cons {} args))
[conjunction & clauses] (if (keyword? (first args))
args
(cons :and args))]
[m (filter some? clauses) conjunction]))
(defn- where-args
"Handle optional args passed to `where` or similar functions. Merges clauses together. Returns tuple of
[m merged-clause]"
[args]
(let [[m clauses conjunction] (merge-where-args args)]
[m (if (<= (count clauses) 1)
(first clauses)
(into [conjunction] clauses))]))
(defn- where-like
"Create a WHERE-style clause with key `k` (e.g. `:where` or `:having`)"
[k args]
(let [[m pred] (where-args args)]
(if (nil? pred)
m
(assoc m k pred))))
(defn where [& args]
(let [[m pred] (prep-where args)]
(if (nil? pred)
m
(assoc m :where pred))))
(where-like :where args))
(defmethod build-clause :merge-where [_ m pred]
(if (nil? pred)
m
(assoc m :where (if (not (nil? (:where m)))
[:and (:where m) pred]
pred))))
(defn- is-clause? [clause x]
(and (sequential? x) (= (first x) clause)))
(defn merge-where [& args]
(let [[m pred logic-op] (prep-where args)]
(if (nil? pred)
m
(assoc m :where (if (not (nil? (:where m)))
[logic-op (:where m) pred]
pred)))))
(defn- merge-where-like
"Merge a WHERE-style clause with key `k` (e.g. `:where` or `:having`)"
[k args]
(let [[m new-clauses conjunction] (merge-where-args args)]
(reduce
(fn [m new-clause]
;; combine existing clause and new clause if they're both of the specified conjunction type, e.g.
;; [:and a b] + [:and c d] -> [:and a b c d]
(update-in m [k] (fn [existing-clause]
(let [existing-subclauses (when (some? existing-clause)
(if (is-clause? conjunction existing-clause)
(rest existing-clause)
[existing-clause]))
new-subclauses (if (is-clause? conjunction new-clause)
(rest new-clause)
[new-clause])
subclauses (concat existing-subclauses new-subclauses)]
(if (> (count subclauses) 1)
(into [conjunction] subclauses)
(first subclauses))))))
m
new-clauses)))
(defn merge-where
"Merge a series of `where-clauses` together. Supports two optional args: a map to merge the results into, and a
`conjunction` to use to combine clauses (defaults to `:and`).
(merge-where [:= :x 1] [:= :y 2])
{:where [:and [:= :x 1] [:= :y 2]]}
(merge-where {:where [:= :x 1]} [:= :y 2])
;; -> {:where [:and [:= :x 1] [:= :y 2]]}
(merge-where :or [:= :x 1] [:= :y 2])
;; -> {:where [:or [:= :x 1] [:= :y 2]]}"
{:arglists '([& where-clauses]
[m-or-conjunction & where-clauses]
[m conjunction & where-clauses])}
[& args]
(merge-where-like :where args))
(defmethod build-clause :merge-where
[_ m where-clause]
(merge-where m where-clause))
(defhelper join [m clauses]
(assoc m :join clauses))
@ -146,25 +194,29 @@
(assoc m :having pred)))
(defn having [& args]
(let [[m pred] (prep-where args)]
(if (nil? pred)
m
(assoc m :having pred))))
(where-like :having args))
(defmethod build-clause :merge-having [_ m pred]
(if (nil? pred)
m
(assoc m :having (if (not (nil? (:having m)))
[:and (:having m) pred]
pred))))
(defn merge-having
"Merge a series of `having-clauses` together. Supports two optional args: a map to merge the results into, and a
`conjunction` to use to combine clauses (defaults to `:and`).
(defn merge-having [& args]
(let [[m pred logic-op] (prep-where args)]
(if (nil? pred)
m
(assoc m :having (if (not (nil? (:having m)))
[logic-op (:having m) pred]
pred)))))
(merge-having [:= :x 1] [:= :y 2])
{:having [:and [:= :x 1] [:= :y 2]]}
(merge-having {:having [:= :x 1]} [:= :y 2])
;; -> {:having [:and [:= :x 1] [:= :y 2]]}
(merge-having :or [:= :x 1] [:= :y 2])
;; -> {:having [:or [:= :x 1] [:= :y 2]]}"
{:arglists '([& having-clauses]
[m-or-conjunction & having-clauses]
[m conjunction & having-clauses])}
[& args]
(merge-where-like :having args))
(defmethod build-clause :merge-having
[_ m where-clause]
(merge-having m where-clause))
(defhelper order-by [m fields]
(assoc m :order-by (collify fields)))

View file

@ -7,7 +7,7 @@
right-join full-join cross-join
where group having
order-by limit offset values columns
insert-into with merge-where]]
insert-into with merge-where merge-having]]
honeysql.format-test))
;; TODO: more tests
@ -217,43 +217,113 @@
sql/format))))
(deftest merge-where-no-params-test
(testing "merge-where called with just the map as parameter - see #228"
(let [sqlmap (-> (select :*)
(from :table)
(where [:= :foo :bar]))]
(is (= ["SELECT * FROM table WHERE foo = bar"]
(sql/format (apply merge-where sqlmap [])))))))
(doseq [[k [f merge-f]] {"WHERE" [where merge-where]
"HAVING" [having merge-having]}]
(testing "merge-where called with just the map as parameter - see #228"
(let [sqlmap (-> (select :*)
(from :table)
(f [:= :foo :bar]))]
(is (= [(str "SELECT * FROM table " k " foo = bar")]
(sql/format (apply merge-f sqlmap []))))))))
(deftest merge-where-test
(is (= ["SELECT * FROM table WHERE (foo = bar AND quuz = xyzzy)"]
(-> (select :*)
(from :table)
(where [:= :foo :bar] [:= :quuz :xyzzy])
sql/format)))
(is (= ["SELECT * FROM table WHERE (foo = bar AND quuz = xyzzy)"]
(-> (select :*)
(from :table)
(where [:= :foo :bar])
(merge-where [:= :quuz :xyzzy])
sql/format))))
(doseq [[k sql-keyword f merge-f] [[:where "WHERE" where merge-where]
[:having "HAVING" having merge-having]]]
(is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar AND quuz = xyzzy)")]
(-> (select :*)
(from :table)
(f [:= :foo :bar] [:= :quuz :xyzzy])
sql/format)))
(is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar AND quuz = xyzzy)")]
(-> (select :*)
(from :table)
(f [:= :foo :bar])
(merge-f [:= :quuz :xyzzy])
sql/format)))
(testing "Should work when first arg isn't a map"
(is (= {k [:and [:x] [:y]]}
(merge-f [:x] [:y]))))
(testing "Shouldn't use conjunction if there is only one clause in the result"
(is (= {k [:x]}
(merge-f {} [:x]))))
(testing "Should be able to specify the conjunction type"
(is (= {k [:or [:x] [:y]]}
(merge-f {}
:or
[:x] [:y]))))
(testing "Should ignore nil clauses"
(is (= {k [:or [:x] [:y]]}
(merge-f {}
:or
[:x] nil [:y]))))))
(deftest merge-where-build-clause-test
(doseq [k [:where :having]]
(testing (str "Should be able to build a " k " clause with sql/build")
(is (= {k [:and [:a] [:x] [:y]]}
(sql/build
k [:a]
(keyword (str "merge-" (name k))) [:and [:x] [:y]]))))))
(deftest merge-where-combine-clauses-test
(doseq [[k f] {:where merge-where
:having merge-having}]
(testing (str "Combine new " k " clauses into the existing clause when appropriate. (#282)")
(testing "No existing clause"
(is (= {k [:and [:x] [:y]]}
(f {}
[:x] [:y]))))
(testing "Existing clause is not a conjunction."
(is (= {k [:and [:a] [:x] [:y]]}
(f {k [:a]}
[:x] [:y]))))
(testing "Existing clause IS a conjunction."
(testing "New clause(s) are not conjunctions"
(is (= {k [:and [:a] [:b] [:x] [:y]]}
(f {k [:and [:a] [:b]]}
[:x] [:y]))))
(testing "New clauses(s) ARE conjunction(s)"
(is (= {k [:and [:a] [:b] [:x] [:y]]}
(f {k [:and [:a] [:b]]}
[:and [:x] [:y]])))
(is (= {k [:and [:a] [:b] [:x] [:y]]}
(f {k [:and [:a] [:b]]}
[:and [:x]]
[:y])))
(is (= {k [:and [:a] [:b] [:x] [:y]]}
(f {k [:and [:a] [:b]]}
[:and [:x]]
[:and [:y]])))))
(testing "if existing clause isn't the same conjunction, don't merge into it"
(testing "existing conjunction is `:or`"
(is (= {k [:and [:or [:a] [:b]] [:x] [:y]]}
(f {k [:or [:a] [:b]]}
[:x] [:y]))))
(testing "pass conjunction type as a param (override default of :and)"
(is (= {k [:or [:and [:a] [:b]] [:x] [:y]]}
(f {k [:and [:a] [:b]]}
:or
[:x] [:y]))))))))
(deftest where-nil-params-test
(testing "where called with nil parameters - see #246"
(is (= ["SELECT * FROM table WHERE (foo = bar AND quuz = xyzzy)"]
(-> (select :*)
(from :table)
(where nil [:= :foo :bar] nil [:= :quuz :xyzzy] nil)
sql/format)))
(is (= ["SELECT * FROM table"]
(-> (select :*)
(from :table)
(where)
sql/format)))
(is (= ["SELECT * FROM table"]
(-> (select :*)
(from :table)
(where nil nil nil nil)
sql/format)))))
(doseq [[k sql-keyword f] [[:where "WHERE" where]
[:having "HAVING" having]]]
(testing (str sql-keyword " called with nil parameters - see #246")
(is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar AND quuz = xyzzy)")]
(-> (select :*)
(from :table)
(f nil [:= :foo :bar] nil [:= :quuz :xyzzy] nil)
sql/format)))
(is (= ["SELECT * FROM table"]
(-> (select :*)
(from :table)
(f)
sql/format)))
(is (= ["SELECT * FROM table"]
(-> (select :*)
(from :table)
(f nil nil nil nil)
sql/format))))))
(deftest cross-join-test
(is (= ["SELECT * FROM foo CROSS JOIN bar"]