luciano/honeysql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Rework and-merge WIP (tests fail)

Browse source
This commit is contained in:
Sean Corfield 2021-03-06 18:40:23 -08:00
parent 5e2036a922
commit 06d90c174e
2 changed files with 113 additions and 90 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
src/honey/sql/helpers.cljc
View file

@ -11,20 +11,39 @@
(into (vec current) args)) (into (vec current) args))
(defn- and-merge (defn- and-merge
"Recursively merge args into the current expression."
[current args] [current args]
(let [args (remove nil? args)] (let [args (remove nil? args)]
(cond (= :and (first current)) (cond (= :and (first args))
(default-merge current args) (recur current [args])
(seq current) (= :or (first args))
(if (seq args) (recur [:or current] (rest args))
(default-merge [:and current] args)
current)
(= 1 (count args))
(vec (first args))
(seq args)
(default-merge [:and] args)
:else :else
(vec current)))) (let [arg (first args)
conj-1 (#{:and :or} (first current))
conj-2 (#{:and :or} (and (sequential? arg) (first arg)))]
(cond (empty? args)
;; nothing more to merge:
(vec current)
(and conj-1 conj-2 (= conj-1 conj-2))
;; both conjunctions and they match:
(recur (default-merge current (rest arg)) (rest args))
(and conj-1 conj-2)
;; both conjunctions but they don't match:
(if (= :and conj-1)
(recur (default-merge current [arg]) (rest args))
(recur (default-merge [:and current] (rest arg)) (rest args)))
conj-1
;; current is conjunction; arg is not
(recur (default-merge (if (= :and conj-1) current [:and current]) [arg]) (rest args))
(and conj-2 (seq current))
;; arg is conjunction; current is not
(recur (default-merge [conj-2 current] (rest arg)) (rest args))
(seq current)
;; current non-empty; neither is a conjunction
(recur (default-merge [:and current] [arg]) (rest args))
:else ; current is empty; use arg as current
(recur (if (sequential? arg) arg [arg]) (rest args)))))))
(def ^:private special-merges (def ^:private special-merges
{:where #'and-merge {:where #'and-merge

10
test/honey/sql/helpers_test.cljc
View file

@ -483,7 +483,7 @@
;; these tests are adapted from Cam Saul's PR #283 ;; these tests are adapted from Cam Saul's PR #283
#_(deftest merge-where-no-params-test (deftest merge-where-no-params-test
(doseq [[k [f merge-f]] {"WHERE" [where where] (doseq [[k [f merge-f]] {"WHERE" [where where]
"HAVING" [having having]}] "HAVING" [having having]}]
(testing "merge-where called with just the map as parameter - see #228" (testing "merge-where called with just the map as parameter - see #228"
@ -493,7 +493,7 @@
(is (= [(str "SELECT * FROM table " k " foo = bar")] (is (= [(str "SELECT * FROM table " k " foo = bar")]
(sql/format (apply merge-f sqlmap [])))))))) (sql/format (apply merge-f sqlmap []))))))))
#_(deftest merge-where-test (deftest merge-where-test
(doseq [[k sql-keyword f merge-f] [[:where "WHERE" where where] (doseq [[k sql-keyword f merge-f] [[:where "WHERE" where where]
[:having "HAVING" having having]]] [:having "HAVING" having having]]]
(is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar) AND (quuz = xyzzy)")] (is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar) AND (quuz = xyzzy)")]
@ -524,7 +524,7 @@
:or :or
[:x] nil [:y])))))) [:x] nil [:y]))))))
#_(deftest merge-where-combine-clauses-test (deftest merge-where-combine-clauses-test
(doseq [[k f] {:where where (doseq [[k f] {:where where
:having having}] :having having}]
(testing (str "Combine new " k " clauses into the existing clause when appropriate. (#282)") (testing (str "Combine new " k " clauses into the existing clause when appropriate. (#282)")
@ -563,3 +563,7 @@
(f {k [:and [:a] [:b]]} (f {k [:and [:a] [:b]]}
:or :or
[:x] [:y])))))))) [:x] [:y]))))))))
(comment
(where {:where [:and [:a] [:b]]} [:and [:x] [:y]])
.)