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

Support more clauses; flesh out dialect and clause ordering

Browse source
This commit is contained in:
Sean Corfield 2020-09-23 12:55:02 -07:00
parent a1d90a6382
commit 1a699f18ab
2 changed files with 134 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

158
src/honey/sql.cljc
View file

@ -12,21 +12,65 @@
;; dynamic dialect handling for formatting ;; dynamic dialect handling for formatting
(def ^:private default-clause-order
"The (default) order for known clauses. Can have items added and removed."
[:intersect :union :union-all :except
:select :insert-into :update :delete :delete-from :truncate
:columns :set :from
:join :left-join :right-join :inner-join :outer-join :full-join
:cross-join
:where :group-by :having :order-by :limit :offset :values])
(defn- add-clause-before
"Low-level helper just to insert a new clause."
[order clause before]
(if before
(do
(when-not (contains? (set order) before)
(throw (ex-info (str "Unrecognized clause: " before)
{:known-clauses order})))
(reduce (fn [v k]
(if (= k before)
(conj v clause k)
(conj v k)))
[]
order))
(conj order clause)))
(def ^:private dialects (def ^:private dialects
{:ansi {:quote #(str \" % \")} {:ansi {:quote #(str \" % \")}
:mssql {:quote #(str \[ % \])} :mssql {:quote #(str \[ % \])}
:mysql {:quote #(str \` % \`)}}) :mysql {:quote #(str \` % \`)
:clause-order-fn #(add-clause-before
(filterv (complement #{:set}) %)
:set
:where)}})
; should become defonce ; should become defonce
(def ^:private default-dialect (atom (:ansi dialects))) (def ^:private default-dialect (atom (:ansi dialects)))
(def ^:private ^:dynamic *dialect* nil) (def ^:private ^:dynamic *dialect* nil)
(def ^:private ^:dynamic *clause-order* nil)
(def ^:private ^:dynamic *quoted* nil) (def ^:private ^:dynamic *quoted* nil)
;; clause helpers ;; clause helpers
;; String.toUpperCase() or `str/upper-case` for that matter converts the
;; string to uppercase for the DEFAULT LOCALE. Normally this does what you'd
;; expect but things like `inner join` get converted to `İNNER JOİN` (dot over
;; the I) when user locale is Turkish. This predictably has bad consequences
;; for people who like their SQL queries to work. The fix here is to use
;; String.toUpperCase(Locale/US) instead which always converts things the
;; way we'd expect.
;;
;; Use this instead of `str/upper-case` as it will always use Locale/US.
(def ^:private ^{:arglists '([s])} upper-case
;; TODO - not sure if there's a JavaScript equivalent here we should be using as well
#?(:clj (fn [^String s] (.. s toString (toUpperCase (java.util.Locale/US))))
:cljs str/upper-case))
(defn- sql-kw [k] (defn- sql-kw [k]
(-> k (name) (str/upper-case) (str/replace "-" " "))) (-> k (name) (upper-case) (str/replace "-" " ")))
(defn- format-entity [x] (defn- format-entity [x]
(let [q (if *quoted* (:quote *dialect*) identity) (let [q (if *quoted* (:quote *dialect*) identity)
@ -61,12 +105,15 @@
[sql & params] (if (map? s) (format-dsl s true) [(format-entity s)])] [sql & params] (if (map? s) (format-dsl s true) [(format-entity s)])]
(into [(str sql #_" AS " " " (format-entity (second x)))] params)) (into [(str sql #_" AS " " " (format-entity (second x)))] params))
(keyword? x)
[(format-entity x)]
:else :else
[(format-entity x)])) (format-expr x)))
;; primary clauses ;; primary clauses
(defn- format-union [k xs] (defn- format-on-set-op [k xs]
(let [[sqls params] (let [[sqls params]
(reduce (fn [[sql params] [sql' & params']] (reduce (fn [[sql params] [sql' & params']]
[(conj sql sql') (if params' (into params params') params)]) [(conj sql sql') (if params' (into params params') params)])
@ -107,7 +154,11 @@
(defn- format-join [k [j e]] (defn- format-join [k [j e]]
(let [[sql & params] (format-expr e)] (let [[sql & params] (format-expr e)]
(into [(str (sql-kw k) " " (format-selectable j) " ON " sql)] params))) ;; for backward compatibility, treat plain JOIN as INNER JOIN:
(into [(str (sql-kw (if (= :join k) :inner-join k)) " "
(format-selectable j) " ON "
sql)]
params)))
(defn- format-on-expr [k e] (defn- format-on-expr [k e]
(let [[sql & params] (format-expr e)] (let [[sql & params] (format-expr e)]
@ -132,25 +183,43 @@
sqls sqls
dirs)))] params))) dirs)))] params)))
(def ^:private clause-order (defn- format-values [k xs]
"The (default) order for known clauses. Can have items added and removed." (if (sequential? (first xs))
(atom [:union :union-all ;; [[1 2 3] [4 5 6]]
:select :insert-into :update :delete :delete-from :truncate :from (let [[sqls params]
:join :left-join :right-join :inner-join :outer-join :full-join (reduce (fn [[sql params] [sqls' params']]
:cross-join [(conj sql (str "(" (str/join ", " sqls') ")"))
:where :group-by :having :order-by :limit :offset])) (into params params')])
[[] []]
(map #'format-expr-list xs))]
(into [(str (sql-kw k) " " (str/join ", " sqls))] params))
;; [1 2 3]
(let [[sqls params] (format-expr-list xs)]
(into [(str (sql-kw k) " (" (str/join ", " sqls) ")")] params))))
(defn- format-set-exprs [k xs]
;; TODO: !!!
["SET a = ?, b = ?" 42 13])
(def ^:private current-clause-order
"The (current) order for known clauses. Can have items added and removed."
(atom default-clause-order))
(def ^:private clause-format (def ^:private clause-format
"The (default) behavior for each known clause. Can also have items added "The (default) behavior for each known clause. Can also have items added
and removed." and removed."
(atom {:union #'format-union (atom {:intersect #'format-on-set-op
:union-all #'format-union :union #'format-on-set-op
:union-all #'format-on-set-op
:except #'format-on-set-op
:select #'format-selector :select #'format-selector
:insert-into #'format-insert :insert-into #'format-insert
:update #'format-selector :update #'format-selector
:delete #'format-selector :delete #'format-selector
:delete-from #'format-selector :delete-from #'format-selector
:truncate #'format-selector :truncate #'format-selector
:columns #'format-selector
:set #'format-set-exprs
:from #'format-selector :from #'format-selector
:join #'format-join :join #'format-join
:left-join #'format-join :left-join #'format-join
@ -164,24 +233,25 @@
:having #'format-on-expr :having #'format-on-expr
:order-by #'format-order-by :order-by #'format-order-by
:limit #'format-on-expr :limit #'format-on-expr
:offset #'format-on-expr})) :offset #'format-on-expr
:values #'format-values}))
(assert (= (set @clause-order) (set (keys @clause-format)))) (assert (= (set @current-clause-order) (set (keys @clause-format))))
(comment :target (comment :target
{:with 20 {:with 20
:with-recursive 30 :with-recursive 30
:intersect 35 ;:intersect 35
;:union 40 ;:union 40
;:union-all 45 ;:union-all 45
:except 47 ;:except 47
;:select 50 ;:select 50
;:insert-into 60 ;:insert-into 60
;:update 70 ;:update 70
;:delete 75 ;:delete 75
;:delete-from 80 ;:delete-from 80
;:truncate 85 ;:truncate 85
:columns 90 ;:columns 90
:composite 95 :composite 95
:set0 100 ; low-priority set clause :set0 100 ; low-priority set clause
;:from 110 ;:from 110
@ -189,7 +259,7 @@
;:left-join 130 ;:left-join 130
;:right-join 140 ;:right-join 140
;:full-join 150 ;:full-join 150
:cross-join 152 ; doesn't have on clauses ;:cross-join 152 ; doesn't have on clauses
:set 155 :set 155
:set1 156 ; high-priority set clause (synonym for :set) :set1 156 ; high-priority set clause (synonym for :set)
;:where 160 ;:where 160
@ -213,13 +283,18 @@
(dissoc leftover k)]) (dissoc leftover k)])
[sql params leftover])) [sql params leftover]))
[[] [] x] [[] [] x]
@clause-order)] *clause-order*)]
(when (seq leftover) (if (seq leftover)
(throw (ex-info (str "Unknown SQL clauses: " (do
;; TODO: for testing purposes, make this less noisy
(println (str "\n-------------------\nUnknown SQL clauses: "
(str/join ", " (keys leftover))))
#_(throw (ex-info (str "Unknown SQL clauses: "
(str/join ", " (keys leftover))) (str/join ", " (keys leftover)))
leftover))) leftover))
[(str "<unknown" (str/join (keys leftover)) ">")])
(into [(cond-> (str/join " " sqls) (into [(cond-> (str/join " " sqls)
nested? (as-> s (str "(" s ")")))] params))) nested? (as-> s (str "(" s ")")))] params))))
(def ^:private infix-aliases (def ^:private infix-aliases
"Provided for backward compatibility with earlier HoneySQL versions." "Provided for backward compatibility with earlier HoneySQL versions."
@ -261,6 +336,9 @@
(cond (keyword? x) (cond (keyword? x)
[(format-entity x)] [(format-entity x)]
(map? x)
(format-dsl x true)
(sequential? x) (sequential? x)
(let [op (first x)] (let [op (first x)]
(if (keyword? op) (if (keyword? op)
@ -291,16 +369,28 @@
:else :else
["?" x])) ["?" x]))
(defn- check-dialect [dialect]
(when-not (contains? dialects dialect)
(throw (ex-info (str "Invalid dialect: " dialect)
{:valid-dialects (vec (sort (keys dialects)))})))
dialect)
(defn format (defn format
"Turn the data DSL into a vector containing a SQL string followed by "Turn the data DSL into a vector containing a SQL string followed by
any parameter values that were encountered in the DSL structure." any parameter values that were encountered in the DSL structure."
([data] (format data {})) ([data] (format data {}))
([data opts] ([data opts]
(let [dialect (get dialects (get opts :dialect :ansi))] (let [dialect? (contains? opts :dialect)
(binding [*dialect* dialect dialect (when dialect? (get dialects (check-dialect (:dialect opts))))]
(binding [*dialect* (if dialect? dialect @default-dialect)
*clause-order* (if dialect?
(if-let [f (:clause-order-fn dialect)]
(f @current-clause-order)
@current-clause-order)
@current-clause-order)
*quoted* (if (contains? opts :quoted) *quoted* (if (contains? opts :quoted)
(:quoted opts) (:quoted opts)
(contains? opts :dialect))] dialect?)]
(format-dsl data))))) (format-dsl data)))))
(defn set-dialect! (defn set-dialect!
@ -308,7 +398,17 @@
Can be: `:ansi` (the default), `:mssql`, `:mysql`." Can be: `:ansi` (the default), `:mssql`, `:mysql`."
[dialect] [dialect]
(reset! default-dialect (get dialects dialect :ansi))) (reset! default-dialect (get dialects (check-dialect dialect)))
(when-let [f (:clause-order-fn @default-dialect)]
(swap! current-clause-order f)))
(defn register-clause!
"Register a new clause formatter. If `before` is `nil`, the clause is
added to the end of the list of known clauses, otherwise it is inserted
immediately prior to that clause."
[clause formatter before]
(swap! current-clause-order add-clause-before clause before)
(swap! clause-format assoc clause formatter))
(comment (comment
(format {:truncate :foo}) (format {:truncate :foo})

14
test/honey/sql_test.cljc
View file

@ -242,15 +242,15 @@
(deftest set-before-from ; issue 235 (deftest set-before-from ; issue 235
(is (= (is (=
["UPDATE `films` `f` SET `kind` = `c`.`test` FROM (SELECT `b`.`test` FROM `bar` `b` WHERE `b`.`id` = ?) `c` WHERE `f`.`kind` = ?" 1 "drama"] ["UPDATE \"films\" \"f\" SET \"kind\" = \"c\".\"test\" FROM (SELECT \"b\".\"test\" FROM \"bar\" \"b\" WHERE \"b\".\"id\" = ?) \"c\" WHERE \"f\".\"kind\" = ?" 1 "drama"]
(-> (->
{:update [:films :f] {:update [:films :f]
:set0 {:kind :c.test} :set {:kind :c.test}
:from [[{:select [:b.test] :from [[{:select [:b.test]
:from [[:bar :b]] :from [[:bar :b]]
:where [:= :b.id 1]} :c]] :where [:= :b.id 1]} :c]]
:where [:= :f.kind "drama"]} :where [:= :f.kind "drama"]}
(format {:dialect :mysql}))))) (format)))))
(deftest set-after-join (deftest set-after-join
(is (= (is (=
@ -260,14 +260,6 @@
:join [:bar [:= :bar.id :foo.bar_id]] :join [:bar [:= :bar.id :foo.bar_id]]
:set {:a 1} :set {:a 1}
:where [:= :bar.b 42]} :where [:= :bar.b 42]}
(format {:dialect :mysql}))))
(is (=
["UPDATE `foo` INNER JOIN `bar` ON `bar`.`id` = `foo`.`bar_id` SET `a` = ? WHERE `bar`.`b` = ?" 1 42]
(->
{:update :foo
:join [:bar [:= :bar.id :foo.bar_id]]
:set1 {:a 1}
:where [:= :bar.b 42]}
(format {:dialect :mysql}))))) (format {:dialect :mysql})))))
(deftest delete-from-test (deftest delete-from-test