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

Merge pull request #546 from alexander-yakushev/misc-opt

Browse source 
Hodgepodge of optimizations
This commit is contained in:
Sean Corfield 2024-09-27 14:13:31 -07:00 committed by GitHub
commit 40d9aee6e6
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
2 changed files with 66 additions and 53 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

118
src/honey/sql.cljc
View file

@ -110,16 +110,16 @@
(reduce-kv (fn [m k v] (reduce-kv (fn [m k v]
(assoc m k (assoc v :dialect k))) (assoc m k (assoc v :dialect k)))
{} {}
{:ansi {:quote #(strop \" % \")} {:ansi {:quote #(strop "\"" % "\"")}
:sqlserver {:quote #(strop \[ % \])} :sqlserver {:quote #(strop "[" % "]")}
:mysql {:quote #(strop \` % \`) :mysql {:quote #(strop "`" % "`")
:clause-order-fn :clause-order-fn
#(add-clause-before % :set :where)} #(add-clause-before % :set :where)}
:nrql {:quote #(strop \` % \`) :nrql {:quote #(strop "`" % "`")
:col-fn #(if (keyword? %) (subs (str %) 1) (str %)) :col-fn #(if (keyword? %) (subs (str %) 1) (str %))
:parts-fn vector} :parts-fn vector}
:oracle {:quote #(strop \" % \") :as false} :oracle {:quote #(strop "\"" % "\"") :as false}
:xtdb {:quote #(strop \" % \") :xtdb {:quote #(strop "\"" % "\"")
:col-fn #(if (keyword? %) (subs (str %) 1) (str %)) :col-fn #(if (keyword? %) (subs (str %) 1) (str %))
:parts-fn #(str/split % #"\.")}}))) :parts-fn #(str/split % #"\.")}})))
@ -161,8 +161,8 @@
(def ^:no-doc ^:dynamic *escape-?* true) (def ^:no-doc ^:dynamic *escape-?* true)
;; suspicious entity names: ;; suspicious entity names:
(def ^:private suspicious #";") (def ^:private suspicious ";")
(defn- suspicious? [s] (boolean (re-find suspicious s))) (defn- suspicious? [s] (str/includes? s suspicious))
(defn- suspicious-entity-check [entity] (defn- suspicious-entity-check [entity]
(when-not *allow-suspicious-entities* (when-not *allow-suspicious-entities*
(when (suspicious? entity) (when (suspicious? entity)
@ -272,7 +272,7 @@
* the whole entity is numeric (with optional underscores), or * the whole entity is numeric (with optional underscores), or
* the first character is alphabetic (or underscore) and the rest is * the first character is alphabetic (or underscore) and the rest is
alphanumeric (or underscore)." alphanumeric (or underscore)."
#"^([0-9_]+|[A-Za-z_][A-Za-z0-9_]*)$") #"^(?:[0-9_]+|[A-Za-z_][A-Za-z0-9_]*)$")
(defn format-entity (defn format-entity
"Given a simple SQL entity (a keyword or symbol -- or string), "Given a simple SQL entity (a keyword or symbol -- or string),
@ -280,7 +280,7 @@
Handles quoting, splitting at / or ., replacing - with _ etc." Handles quoting, splitting at / or ., replacing - with _ etc."
[e & [{:keys [aliased drop-ns]}]] [e & [{:keys [aliased drop-ns]}]]
(let [e (if (and aliased (keyword? e) (= \' (first (name e)))) (let [e (if (and aliased (keyword? e) (str/starts-with? (name e) "'"))
;; #497 quoted alias support (should behave like string) ;; #497 quoted alias support (should behave like string)
(subs (name e) 1) (subs (name e) 1)
e) e)
@ -350,7 +350,7 @@
(let [n (cond-> (name k) (let [n (cond-> (name k)
*escape-?* *escape-?*
(str/replace "?" "??"))] (str/replace "?" "??"))]
(if (= \' (first n)) (if (str/starts-with? n "'")
(let [ident (subs n 1) (let [ident (subs n 1)
ident-l (str/lower-case ident)] ident-l (str/lower-case ident)]
(binding [*quoted* (when-not (contains? #{"array"} ident-l) *quoted*)] (binding [*quoted* (when-not (contains? #{"array"} ident-l) *quoted*)]
@ -419,13 +419,16 @@
;; rather than name/namespace, we want to allow ;; rather than name/namespace, we want to allow
;; for multiple / in the %fun.call case so that ;; for multiple / in the %fun.call case so that
;; qualified column names can be used: ;; qualified column names can be used:
(let [c (cond-> (str x) (keyword? x) (subs 1))] (let [c (if (keyword? x)
(cond (= \% (first c)) #?(:clj (str (.sym ^clojure.lang.Keyword x)) ;; Omits leading colon
:default (subs (str x) 1))
(str x))]
(cond (str/starts-with? c "%")
(let [[f & args] (str/split (subs c 1) #"\.")] (let [[f & args] (str/split (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)
")")]) ")")])
(= \? (first c)) (str/starts-with? c "?")
(let [k (keyword (subs c 1))] (let [k (keyword (subs c 1))]
(cond *inline* (cond *inline*
[(sqlize-value (param-value k))] [(sqlize-value (param-value k))]
@ -433,7 +436,7 @@
(->numbered-param k) (->numbered-param k)
:else :else
["?" (->param k)])) ["?" (->param k)]))
(= \' (first c)) (str/starts-with? c "'")
(do (do
(reset! *formatted-column* true) (reset! *formatted-column* true)
[(subs c 1)]) [(subs c 1)])
@ -656,11 +659,16 @@
:else :else
(format-expr x))) (format-expr x)))
(defn- reduce-sql [xs] (defn- reduce-sql
(reduce (fn [[sql params] [sql' & params']] ([xs] (reduce-sql identity xs))
[(conj sql sql') (if params' (into params params') params)]) ([xform xs]
[[] []] (transduce xform
xs)) (fn
([res] res)
([[sql params] [sql' & params']]
[(conj sql sql') (if params' (into params params') params)]))
[[] []]
xs)))
;; primary clauses ;; primary clauses
@ -683,7 +691,9 @@
* [:overlay :foo :*placing :?subs :*from 3 :*for 4] * [:overlay :foo :*placing :?subs :*from 3 :*for 4]
* [:trim :*leading-from :bar]" * [:trim :*leading-from :bar]"
[args & [opts]] [args & [opts]]
(loop [exprs (map #(format-expr % opts) (remove inline-kw? args)) (loop [exprs (keep #(when-not (inline-kw? %)
(format-expr % opts))
args)
args args args args
prev-in false prev-in false
result []] result []]
@ -730,7 +740,7 @@
(throw (ex-info (str "format-expr-list expects a sequence of expressions, found: " (throw (ex-info (str "format-expr-list expects a sequence of expressions, found: "
(type exprs)) (type exprs))
{:exprs exprs}))) {:exprs exprs})))
(reduce-sql (map #(format-expr % opts) exprs))) (reduce-sql (map #(format-expr % opts)) exprs))
(comment (comment
(format-expr-list :?tags) (format-expr-list :?tags)
@ -750,7 +760,7 @@
(cond-> prefix qualifier (str " " qualifier)) (cond-> prefix qualifier (str " " qualifier))
qualifier)] qualifier)]
(if (sequential? xs) (if (sequential? xs)
(let [[sqls params] (reduce-sql (map #(format-selectable-dsl % {:as as}) xs))] (let [[sqls params] (reduce-sql (map #(format-selectable-dsl % {:as as})) xs)]
(when-not (= :none *checking*) (when-not (= :none *checking*)
(when (empty? xs) (when (empty? xs)
(throw (ex-info (str prefix " empty column list is illegal") (throw (ex-info (str prefix " empty column list is illegal")
@ -848,8 +858,8 @@
;; according to docs, CTE should _always_ be wrapped: ;; according to docs, CTE should _always_ be wrapped:
(cond-> [(str sql " " (as-fn with) " " (str "(" sql' ")"))] (cond-> [(str sql " " (as-fn with) " " (str "(" sql' ")"))]
params (into params) params (into params)
params' (into params'))))) params' (into params'))))))
xs))] xs)]
(into [(str (sql-kw k) " " (join ", " sqls))] params))) (into [(str (sql-kw k) " " (join ", " sqls))] params)))
(defn- format-selector [k xs] (defn- format-selector [k xs]
@ -877,7 +887,7 @@
[table]) [table])
[sql & params] (format-dsl statement) [sql & params] (format-dsl statement)
[t-sql & t-params] (format-entity-alias table) [t-sql & t-params] (format-entity-alias table)
[c-sqls c-params] (reduce-sql (map #'format-entity-alias cols))] [c-sqls c-params] (reduce-sql (map #'format-entity-alias) cols)]
(-> [(str (sql-kw k) " " t-sql (-> [(str (sql-kw k) " " t-sql
" " " "
(cond (seq cols) (cond (seq cols)
@ -895,7 +905,7 @@
(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)
[c-sqls c-params] (reduce-sql (map #'format-entity-alias cols))] [c-sqls c-params] (reduce-sql (map #'format-entity-alias) cols)]
(-> [(str (sql-kw k) " " t-sql (-> [(str (sql-kw k) " " t-sql
" (" " ("
(join ", " c-sqls) (join ", " c-sqls)
@ -925,29 +935,33 @@
(defn- format-join [k clauses] (defn- format-join [k clauses]
(let [[sqls params] (let [[sqls params]
(reduce (fn [[sqls params] [j e]] (transduce
(let [[sql-j & params-j] (partition-all 2)
(format-selects-common (fn
(sql-kw (if (= :join k) :inner-join k)) ([res] res)
true ([[sqls params] [j e]]
[j]) (let [[sql-j & params-j]
sqls (conj sqls sql-j)] (format-selects-common
(if (and (sequential? e) (= :using (first e))) (sql-kw (if (= :join k) :inner-join k))
(let [[u-sqls u-params] true
(reduce-sql (map #'format-entity-alias (rest e)))] [j])
[(conj sqls sqls (conj sqls sql-j)]
"USING" (if (and (sequential? e) (= :using (first e)))
(str "(" (let [[u-sqls u-params]
(join ", " u-sqls) (reduce-sql (map #'format-entity-alias) (rest e))]
")")) [(conj sqls
(-> params (into params-j) (into u-params))]) "USING"
(let [[sql & params'] (when e (format-expr e))] (str "("
[(cond-> sqls e (conj "ON" sql)) (join ", " u-sqls)
(-> params ")"))
(into params-j) (-> params (into params-j) (into u-params))])
(into params'))])))) (let [[sql & params'] (when e (format-expr e))]
[[] []] [(cond-> sqls e (conj "ON" sql))
(partition-all 2 clauses))] (-> params
(into params-j)
(into params'))])))))
[[] []]
clauses)]
(into [(join " " sqls)] params))) (into [(join " " sqls)] params)))
(def ^:private join-by-aliases (def ^:private join-by-aliases
@ -1961,7 +1975,7 @@
(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)
(contains? @op-ignore-nil op) (contains? @op-ignore-nil op)
(remove nil?)) (filterv some?))
args (cond (seq args) args (cond (seq args)
args args
(= :and op) (= :and op)
@ -1971,7 +1985,7 @@
:else ; args is empty and not a special case :else ; args is empty and not a special case
[]) [])
[sqls params] [sqls params]
(reduce-sql (map #(format-expr % {:nested true}) args))] (reduce-sql (map #(format-expr % {:nested true})) args)]
(when-not (pos? (count sqls)) (when-not (pos? (count sqls))
(throw (ex-info (str "no operands found for " op') (throw (ex-info (str "no operands found for " op')
{:expr expr}))) {:expr expr})))

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

@ -7,7 +7,6 @@
"More efficient implementation of `clojure.core/str` because it has more "More efficient implementation of `clojure.core/str` because it has more
non-variadic arities. Optimization is Clojure-only, on other platforms it non-variadic arities. Optimization is Clojure-only, on other platforms it
reverts back to `clojure.core/str`." reverts back to `clojure.core/str`."
{:tag String}
(^String [] "") (^String [] "")
(^String [^Object a] (^String [^Object a]
#?(:clj (if (nil? a) "" (.toString a)) #?(:clj (if (nil? a) "" (.toString a))