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

Merge pull request #560 from alexander-yakushev/opt

Browse source 
More optimizations
This commit is contained in:
Sean Corfield 2025-01-01 11:00:18 -08:00 committed by GitHub
commit 94fae3437f
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
3 changed files with 88 additions and 78 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

120
src/honey/sql.cljc
View file

@ -31,7 +31,7 @@
(:require [clojure.string :as str] (:require [clojure.string :as str]
#?(:clj [clojure.template]) #?(:clj [clojure.template])
[honey.sql.protocols :as p] [honey.sql.protocols :as p]
[honey.sql.util :refer [str join]])) [honey.sql.util :refer [str join split-by-separator into*]]))
;; default formatting for known clauses ;; default formatting for known clauses
@ -316,7 +316,7 @@
[n %] [n %]
(if aliased (if aliased
[%] [%]
(str/split % #"\.")))) (split-by-separator % "."))))
parts (parts-fn col-e) parts (parts-fn col-e)
entity (join "." (map #(cond-> % (not= "*" %) (quote-fn))) parts)] entity (join "." (map #(cond-> % (not= "*" %) (quote-fn))) parts)]
(suspicious-entity-check entity) (suspicious-entity-check entity)
@ -457,7 +457,7 @@
:default (subs (str x) 1)) :default (subs (str x) 1))
(str x))] (str x))]
(cond (str/starts-with? c "%") (cond (str/starts-with? c "%")
(let [[f & args] (str/split (subs c 1) #"\.")] (let [[f & args] (split-by-separator (subs c 1) ".")]
[(str (format-fn-name f) "(" [(str (format-fn-name f) "("
(join ", " (map #(format-entity (keyword %) opts)) args) (join ", " (map #(format-entity (keyword %) opts)) args)
")")]) ")")])
@ -525,14 +525,10 @@
:else :else
(throw (ex-info "bigquery * only supports except and replace" (throw (ex-info "bigquery * only supports except and replace"
{:clause k :arg arg})))] {:clause k :arg arg})))]
(-> [(cond->> sql' sql (str sql " "))] (into* [(cond->> sql' sql (str sql " "))] params params')))
(into params)
(into params'))))
[] []
(partition-all 2 x))] (partition-all 2 x))]
(-> [(str sql " " sql')] (into* [(str sql " " sql')] params params')))
(into params)
(into params'))))
(comment (comment
(bigquery-*-except-replace? [:* :except [:a :b :c]]) (bigquery-*-except-replace? [:* :except [:a :b :c]])
@ -676,9 +672,7 @@
sql')) sql'))
(when hints (when hints
(str " WITH (" hints ")")))] (str " WITH (" hints ")")))]
(into params) (into* params params' params'')))))
(into params')
(into params'')))))
(defn- format-selectable-dsl (defn- format-selectable-dsl
([x] (format-selectable-dsl x {})) ([x] (format-selectable-dsl x {}))
@ -752,9 +746,8 @@
(let [[cur & params] (peek result) (let [[cur & params] (peek result)
[sql & params'] (first exprs)] [sql & params'] (first exprs)]
(recur (rest exprs) args' false (conj (pop result) (recur (rest exprs) args' false (conj (pop result)
(-> [(str cur " " sql)] (into* [(str cur " " sql)]
(into params) params params'))))
(into params')))))
(recur (rest exprs) args' false (conj result (first exprs)))))) (recur (rest exprs) args' false (conj result (first exprs))))))
(reduce-sql result))))) (reduce-sql result)))))
@ -836,7 +829,7 @@
(str (sql-kw :select) " " sql) (str (sql-kw :select) " " sql)
true true
cols)] cols)]
(-> [sql'] (into params) (into params')))) (into* [sql'] params params')))
(defn- format-select-top [k xs] (defn- format-select-top [k xs]
(let [[top & cols] xs (let [[top & cols] xs
@ -864,7 +857,7 @@
(join " " (map sql-kw) parts)) (join " " (map sql-kw) parts))
true true
cols)] cols)]
(-> [sql'] (into params) (into params')))) (into* [sql'] params params')))
(defn- format-select-into [k xs] (defn- format-select-into [k xs]
(let [[v e] (ensure-sequential xs) (let [[v e] (ensure-sequential xs)
@ -956,19 +949,14 @@
(format-dsl expr)) (format-dsl expr))
[sql'' & params'' :as sql-params''] [sql'' & params'' :as sql-params'']
(if non-query-expr? (if non-query-expr?
(cond-> [(str sql' " AS " sql)] (into* [(str sql' " AS " sql)] params' params)
params' (into params')
params (into params))
;; according to docs, CTE should _always_ be wrapped: ;; according to docs, CTE should _always_ be wrapped:
(cond-> [(str sql " " (as-fn with) " " (str "(" sql' ")"))] (into* [(str sql " " (as-fn with) " " (str "(" sql' ")"))]
params (into params) params params'))
params' (into params')))
[tail-sql & tail-params] [tail-sql & tail-params]
(format-with-query-tail tail)] (format-with-query-tail tail)]
(if (seq tail-sql) (if (seq tail-sql)
(cond-> [(str sql'' " " tail-sql)] (into* [(str sql'' " " tail-sql)] params'' tail-params)
params'' (into params'')
tail-params (into tail-params))
sql-params'')))) sql-params''))))
xs)] xs)]
(into [(str (sql-kw k) " " (join ", " sqls))] params))) (into [(str (sql-kw k) " " (join ", " sqls))] params)))
@ -1012,10 +1000,7 @@
(str cols-sql' " ")) (str cols-sql' " "))
overriding overriding
sql)] sql)]
(into t-params) (into* t-params c-params cols-params' params)))
(into c-params)
(into cols-params')
(into params)))
(sequential? (second table)) (sequential? (second table))
(let [[table cols] table (let [[table cols] table
[t-sql & t-params] (format-entity-alias table) [t-sql & t-params] (format-entity-alias table)
@ -1025,23 +1010,20 @@
(join ", " c-sqls) (join ", " c-sqls)
")" ")"
overriding)] overriding)]
(into t-params) (into* t-params c-params)))
(into c-params)))
:else :else
(let [[sql & params] (format-entity-alias table)] (let [[sql & params] (format-entity-alias table)]
(-> [(str (sql-kw k) " " sql (-> [(str (sql-kw k) " " sql
(when (seq cols') (when (seq cols')
(str " " cols-sql')) (str " " cols-sql'))
overriding)] overriding)]
(into cols-params') (into* cols-params' params))))
(into params))))
(let [[sql & params] (format-entity-alias table)] (let [[sql & params] (format-entity-alias table)]
(-> [(str (sql-kw k) " " sql (-> [(str (sql-kw k) " " sql
(when (seq cols') (when (seq cols')
(str " " cols-sql')) (str " " cols-sql'))
overriding)] overriding)]
(into cols-params') (into* cols-params' params))))))
(into params))))))
(comment (comment
(format-insert :insert-into [[[:raw ":foo"]] {:select :bar}]) (format-insert :insert-into [[[:raw ":foo"]] {:select :bar}])
@ -1069,12 +1051,10 @@
(str "(" (str "("
(join ", " u-sqls) (join ", " u-sqls)
")")) ")"))
(-> params (into params-j) (into u-params))]) (into* params params-j u-params)])
(let [[sql & params'] (when e (format-expr e))] (let [[sql & params'] (when e (format-expr e))]
[(cond-> sqls e (conj "ON" sql)) [(cond-> sqls e (conj "ON" sql))
(-> params (into* params params-j params')])))))
(into params-j)
(into params'))])))))
[[] []] [[] []]
clauses)] clauses)]
(into [(join " " sqls)] params))) (into [(join " " sqls)] params)))
@ -1282,8 +1262,7 @@
(str " (" (join ", " sqls) ")")) (str " (" (join ", " sqls) ")"))
(when sql (when sql
(str " " sql)))] (str " " sql)))]
(into expr-params) (into* expr-params clause-params)))
(into clause-params)))
(format-on-conflict k [x]))) (format-on-conflict k [x])))
(defn- format-do-update-set [k x] (defn- format-do-update-set [k x]
@ -1302,8 +1281,7 @@
where (or (:where x) ('where x)) where (or (:where x) ('where x))
[sql & params] (when where (format-dsl {:where where}))] [sql & params] (when where (format-dsl {:where where}))]
(-> [(str sets (when sql (str " " sql)))] (-> [(str sets (when sql (str " " sql)))]
(into set-params) (into* set-params params)))
(into params)))
(format-set-exprs k x)) (format-set-exprs k x))
(sequential? x) (sequential? x)
(let [[cols clauses] (split-with (complement map?) x)] (let [[cols clauses] (split-with (complement map?) x)]
@ -1753,7 +1731,10 @@
(if (keyword? k) (if (keyword? k)
(if-let [n (namespace k)] (if-let [n (namespace k)]
(symbol n (name k)) (symbol n (name k))
(symbol (name k))) ;; In CLJ runtime, reuse symbol that's already present in the keyword.
#?(:bb (symbol (name k))
:clj (.sym ^clojure.lang.Keyword k)
:default (symbol (name k))))
k)) k))
(defn format-dsl (defn format-dsl
@ -1849,23 +1830,18 @@
(= 1 (count params-y)) (= 1 (count params-y))
(coll? v1)) (coll? v1))
(let [sql (str "(" (join ", " (repeat (count v1) "?")) ")")] (let [sql (str "(" (join ", " (repeat (count v1) "?")) ")")]
(-> [(str sql-x " " (sql-kw in) " " sql)] (into* [(str sql-x " " (sql-kw in) " " sql)] params-x v1))
(into params-x)
(into v1)))
(and *numbered* (and *numbered*
(= (str "$" (count @*numbered*)) sql-y) (= (str "$" (count @*numbered*)) sql-y)
(= 1 (count params-y)) (= 1 (count params-y))
(coll? v1)) (coll? v1))
(let [vs (for [v v1] (->numbered v)) (let [vs (for [v v1] (->numbered v))
sql (str "(" (join ", " (map first) vs) ")")] sql (str "(" (join ", " (map first) vs) ")")]
(-> [(str sql-x " " (sql-kw in) " " sql)] (into* [(str sql-x " " (sql-kw in) " " sql)]
(into params-x) params-x [nil] (map second vs)))
(conj nil)
(into (map second vs))))
:else :else
(-> [(str sql-x " " (sql-kw in) " " sql-y)] (into* [(str sql-x " " (sql-kw in) " " sql-y)]
(into params-x) params-x (if *numbered* values params-y)))))
(into (if *numbered* values params-y))))))
(defn- function-0 [k xs] (defn- function-0 [k xs]
[(str (sql-kw k) [(str (sql-kw k)
@ -1909,7 +1885,7 @@
(let [[sql-e & params-e] (format-expr e) (let [[sql-e & params-e] (format-expr e)
[sql-c & params-c] (format-dsl c {:nested true})] [sql-c & params-c] (format-dsl c {:nested true})]
[(conj sqls (str sql-e " " (sql-kw k) " " sql-c)) [(conj sqls (str sql-e " " (sql-kw k) " " sql-c))
(-> params (into params-e) (into params-c))])) (into* params params-e params-c)]))
[[] []] [[] []]
(partition 2 pairs))] (partition 2 pairs))]
(into [(join ", " sqls)] params))) (into [(join ", " sqls)] params)))
@ -1928,7 +1904,7 @@
(= 'else condition)) (= 'else condition))
(conj sqls (sql-kw :else) sqlv) (conj sqls (sql-kw :else) sqlv)
(conj sqls (sql-kw :when) sqlc (sql-kw :then) sqlv)) (conj sqls (sql-kw :when) sqlc (sql-kw :then) sqlv))
(-> params (into paramsc) (into paramsv))])) (into* params paramsc paramsv)]))
[[] []] [[] []]
(partition 2 (if case-expr? (rest clauses) clauses)))] (partition 2 (if case-expr? (rest clauses) clauses)))]
(-> [(str (sql-kw :case) " " (-> [(str (sql-kw :case) " "
@ -1936,8 +1912,7 @@
(str sqlx " ")) (str sqlx " "))
(join " " sqls) (join " " sqls)
" " (sql-kw :end))] " " (sql-kw :end))]
(into paramsx) (into* paramsx params))))
(into params))))
(defn- between-fn (defn- between-fn
"For both :between and :not-between" "For both :between and :not-between"
@ -1945,10 +1920,8 @@
(let [[sql-x & params-x] (format-expr x {:nested true}) (let [[sql-x & params-x] (format-expr x {:nested true})
[sql-a & params-a] (format-expr a {:nested true}) [sql-a & params-a] (format-expr a {:nested true})
[sql-b & params-b] (format-expr b {:nested true})] [sql-b & params-b] (format-expr b {:nested true})]
(-> [(str sql-x " " (sql-kw k) " " sql-a " AND " sql-b)] (into* [(str sql-x " " (sql-kw k) " " sql-a " AND " sql-b)]
(into params-x) params-x params-a params-b)))
(into params-a)
(into params-b))))
(defn- object-record-literal (defn- object-record-literal
[k [x]] [k [x]]
@ -1967,9 +1940,7 @@
(let [[sql' & params'] (format-expr %)] (let [[sql' & params'] (format-expr %)]
(cons (str "[" sql' "]") params'))) (cons (str "[" sql' "]") params')))
kix))] kix))]
(-> [(str "(" sql ")" (join "" sqls))] (into* [(str "(" sql ")" (join "" sqls))] params params')))
(into params)
(into params'))))
(defn ignore-respect-nulls [k [x]] (defn ignore-respect-nulls [k [x]]
(let [[sql & params] (format-expr x)] (let [[sql & params] (format-expr x)]
@ -2042,9 +2013,7 @@
[sql' & params'] (if (ident? type) [sql' & params'] (if (ident? type)
[(sql-kw type)] [(sql-kw type)]
(format-expr type))] (format-expr type))]
(-> [(str "CAST(" sql " AS " sql' ")")] (into* [(str "CAST(" sql " AS " sql' ")")] params params')))
(into params)
(into params'))))
:composite :composite
(fn [_ [& args]] (fn [_ [& args]]
(let [[sqls params] (format-expr-list args)] (let [[sqls params] (format-expr-list args)]
@ -2057,9 +2026,7 @@
(fn [_ [pattern escape-chars]] (fn [_ [pattern escape-chars]]
(let [[sql-p & params-p] (format-expr pattern) (let [[sql-p & params-p] (format-expr pattern)
[sql-e & params-e] (format-expr escape-chars)] [sql-e & params-e] (format-expr escape-chars)]
(-> [(str sql-p " " (sql-kw :escape) " " sql-e)] (into* [(str sql-p " " (sql-kw :escape) " " sql-e)] params-p params-e)))
(into params-p)
(into params-e))))
:filter expr-clause-pairs :filter expr-clause-pairs
:get-in #'get-in-navigation :get-in #'get-in-navigation
:ignore-nulls ignore-respect-nulls :ignore-nulls ignore-respect-nulls
@ -2106,9 +2073,7 @@
(fn [k [e & qs]] (fn [k [e & qs]]
(let [[sql-e & params-e] (format-expr e) (let [[sql-e & params-e] (format-expr e)
[sql-q & params-q] (format-dsl {k qs})] [sql-q & params-q] (format-dsl {k qs})]
(-> [(str sql-e " " sql-q)] (into* [(str sql-e " " sql-q)] params-e params-q)))
(into params-e)
(into params-q))))
:over :over
(fn [_ [& args]] (fn [_ [& args]]
(let [[sqls params] (let [[sqls params]
@ -2119,7 +2084,7 @@
[(format-entity p)])] [(format-entity p)])]
[(conj sqls (str sql-e " OVER " sql-p [(conj sqls (str sql-e " OVER " sql-p
(when a (str " AS " (format-entity a))))) (when a (str " AS " (format-entity a)))))
(-> params (into params-e) (into params-p))])) (into* params params-e params-p)]))
[[] []] [[] []]
args)] args)]
(into [(join ", " sqls)] params))) (into [(join ", " sqls)] params)))
@ -2160,8 +2125,7 @@
(cond-> nested (cond-> nested
(as-> s (str "(" s ")"))) (as-> s (str "(" s ")")))
(vector) (vector)
(into p1) (into* p1 p2))))
(into p2))))
(defn- format-infix-expr [op' op expr nested] (defn- format-infix-expr [op' op expr nested]
(let [args (cond->> (rest expr) (let [args (cond->> (rest expr)

29
src/honey/sql/util.cljc
View file

@ -75,3 +75,32 @@
:default :default
(clojure.string/join separator (transduce xform conj [] coll))))) (clojure.string/join separator (transduce xform conj [] coll)))))
(defn split-by-separator
"More efficient implementation of `clojure.string/split` for cases when a
literal string (not regex) is used as a separator, and for cases where the
separator is not present in the haystack at all."
[s sep]
(loop [start 0, res []]
(if-let [sep-idx (clojure.string/index-of s sep start)]
(recur (inc sep-idx) (conj res (subs s start sep-idx)))
(if (= start 0)
;; Fastpath - zero separators in s
[s]
(conj res (subs s start))))))
(defn into*
"An extension of `clojure.core/into` that accepts multiple \"from\" arguments.
Doesn't support `xform`."
([to from1] (into* to from1 nil nil nil))
([to from1 from2] (into* to from1 from2 nil nil))
([to from1 from2 from3] (into* to from1 from2 from3 nil))
([to from1 from2 from3 from4]
(if (or from1 from2 from3 from4)
(as-> (transient to) to'
(reduce conj! to' from1)
(reduce conj! to' from2)
(reduce conj! to' from3)
(reduce conj! to' from4)
(persistent! to'))
to)))

17
test/honey/util_test.cljc
View file

@ -43,3 +43,20 @@
(is (= "1, 2, 3, 4" (is (= "1, 2, 3, 4"
(sut/join ", " (remove nil?) [1 nil 2 nil 3 nil nil nil 4]))) (sut/join ", " (remove nil?) [1 nil 2 nil 3 nil nil nil 4])))
(is (= "" (sut/join ", " (remove nil?) [nil nil nil nil])))) (is (= "" (sut/join ", " (remove nil?) [nil nil nil nil]))))
(deftest split-by-separator-test
(is (= [""] (sut/split-by-separator "" ".")))
(is (= ["" ""] (sut/split-by-separator "." ".")))
(is (= ["hello"] (sut/split-by-separator "hello" ".")))
(is (= ["h" "e" "l" "l" "o"] (sut/split-by-separator "h.e.l.l.o" ".")))
(is (= ["" "h" "e" "" "" "l" "" "l" "o" ""]
(sut/split-by-separator ".h.e...l..l.o." "."))))
(deftest into*-test
(is (= [1] (sut/into* [1] nil)))
(is (= [1] (sut/into* [1] [])))
(is (= [1] (sut/into* [1] nil [] nil [])))
(is (= [1 2 3] (sut/into* [1] [2 3])))
(is (= [1 2 3 4 5 6] (sut/into* [1] [2 3] [4 5 6])))
(is (= [1 2 3 4 5 6 7] (sut/into* [1] [2 3] [4 5 6] [7])))
(is (= [1 2 3 4 5 6 7 8 9] (sut/into* [1] [2 3] [4 5 6] [7] [8 9]))))