Skip to content

Commit

Permalink
Merge pull request #546 from alexander-yakushev/misc-opt
Browse files Browse the repository at this point in the history 
Hodgepodge of optimizations
  • Loading branch information
@seancorfield
seancorfield committed Sep 27, 2024
2 parents f31533d + 2fb4df6 commit 40d9aee
Show file tree
Hide file tree
Showing 2 changed files with 66 additions and 53 deletions.
118 changes: 66 additions & 52 deletions src/honey/sql.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,16 +110,16 @@
(reduce-kv (fn [m k v]
(assoc m k (assoc v :dialect k)))
{}
{:ansi {:quote #(strop \" % \")}
:sqlserver {:quote #(strop \[ % \])}
:mysql {:quote #(strop \` % \`)
{:ansi {:quote #(strop "\"" % "\"")}
:sqlserver {:quote #(strop "[" % "]")}
:mysql {:quote #(strop "`" % "`")
:clause-order-fn
#(add-clause-before % :set :where)}
:nrql {:quote #(strop \` % \`)
:nrql {:quote #(strop "`" % "`")
:col-fn #(if (keyword? %) (subs (str %) 1) (str %))
:parts-fn vector}
:oracle {:quote #(strop \" % \") :as false}
:xtdb {:quote #(strop \" % \")
:oracle {:quote #(strop "\"" % "\"") :as false}
:xtdb {:quote #(strop "\"" % "\"")
:col-fn #(if (keyword? %) (subs (str %) 1) (str %))
:parts-fn #(str/split % #"\.")}})))

Expand Down Expand Up @@ -161,8 +161,8 @@
(def ^:no-doc ^:dynamic *escape-?* true)

;; suspicious entity names:
(def ^:private suspicious #";")
(defn- suspicious? [s] (boolean (re-find suspicious s)))
(def ^:private suspicious ";")
(defn- suspicious? [s] (str/includes? s suspicious))
(defn- suspicious-entity-check [entity]
(when-not *allow-suspicious-entities*
(when (suspicious? entity)
Expand Down Expand Up @@ -272,15 +272,15 @@
* the whole entity is numeric (with optional underscores), or
* the first character is alphabetic (or underscore) and the rest is
alphanumeric (or underscore)."
#"^([0-9_]+|[A-Za-z_][A-Za-z0-9_]*)$")
#"^(?:[0-9_]+|[A-Za-z_][A-Za-z0-9_]*)$")

(defn format-entity
"Given a simple SQL entity (a keyword or symbol -- or string),
return the equivalent SQL fragment (as a string -- no parameters).
Handles quoting, splitting at / or ., replacing - with _ etc."
[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)
(subs (name e) 1)
e)
Expand Down Expand Up @@ -350,7 +350,7 @@
(let [n (cond-> (name k)
*escape-?*
(str/replace "?" "??"))]
(if (= \' (first n))
(if (str/starts-with? n "'")
(let [ident (subs n 1)
ident-l (str/lower-case ident)]
(binding [*quoted* (when-not (contains? #{"array"} ident-l) *quoted*)]
Expand Down Expand Up @@ -419,21 +419,24 @@
;; rather than name/namespace, we want to allow
;; for multiple / in the %fun.call case so that
;; qualified column names can be used:
(let [c (cond-> (str x) (keyword? x) (subs 1))]
(cond (= \% (first c))
(let [c (if (keyword? x)
#?(: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) #"\.")]
[(str (format-fn-name f) "("
(join ", " (map #(format-entity (keyword %) opts)) args)
")")])
(= \? (first c))
(str/starts-with? c "?")
(let [k (keyword (subs c 1))]
(cond *inline*
[(sqlize-value (param-value k))]
*numbered*
(->numbered-param k)
:else
["?" (->param k)]))
(= \' (first c))
(str/starts-with? c "'")
(do
(reset! *formatted-column* true)
[(subs c 1)])
Expand Down Expand Up @@ -656,11 +659,16 @@
:else
(format-expr x)))

(defn- reduce-sql [xs]
(reduce (fn [[sql params] [sql' & params']]
[(conj sql sql') (if params' (into params params') params)])
[[] []]
xs))
(defn- reduce-sql
([xs] (reduce-sql identity xs))
([xform xs]
(transduce xform
(fn
([res] res)
([[sql params] [sql' & params']]
[(conj sql sql') (if params' (into params params') params)]))
[[] []]
xs)))

;; primary clauses

Expand All @@ -683,7 +691,9 @@
* [:overlay :foo :*placing :?subs :*from 3 :*for 4]
* [:trim :*leading-from :bar]"
[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
prev-in false
result []]
Expand Down Expand Up @@ -730,7 +740,7 @@
(throw (ex-info (str "format-expr-list expects a sequence of expressions, found: "
(type exprs))
{:exprs exprs})))
(reduce-sql (map #(format-expr % opts) exprs)))
(reduce-sql (map #(format-expr % opts)) exprs))

(comment
(format-expr-list :?tags)
Expand All @@ -750,7 +760,7 @@
(cond-> prefix qualifier (str " " qualifier))
qualifier)]
(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 (empty? xs)
(throw (ex-info (str prefix " empty column list is illegal")
Expand Down Expand Up @@ -848,8 +858,8 @@
;; according to docs, CTE should _always_ be wrapped:
(cond-> [(str sql " " (as-fn with) " " (str "(" sql' ")"))]
params (into params)
params' (into params')))))
xs))]
params' (into params'))))))
xs)]
(into [(str (sql-kw k) " " (join ", " sqls))] params)))

(defn- format-selector [k xs]
Expand Down Expand Up @@ -877,7 +887,7 @@
[table])
[sql & params] (format-dsl statement)
[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
" "
(cond (seq cols)
Expand All @@ -895,7 +905,7 @@
(sequential? (second table))
(let [[table cols] 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
" ("
(join ", " c-sqls)
Expand Down Expand Up @@ -925,29 +935,33 @@

(defn- format-join [k clauses]
(let [[sqls params]
(reduce (fn [[sqls params] [j e]]
(let [[sql-j & params-j]
(format-selects-common
(sql-kw (if (= :join k) :inner-join k))
true
[j])
sqls (conj sqls sql-j)]
(if (and (sequential? e) (= :using (first e)))
(let [[u-sqls u-params]
(reduce-sql (map #'format-entity-alias (rest e)))]
[(conj sqls
"USING"
(str "("
(join ", " u-sqls)
")"))
(-> params (into params-j) (into u-params))])
(let [[sql & params'] (when e (format-expr e))]
[(cond-> sqls e (conj "ON" sql))
(-> params
(into params-j)
(into params'))]))))
[[] []]
(partition-all 2 clauses))]
(transduce
(partition-all 2)
(fn
([res] res)
([[sqls params] [j e]]
(let [[sql-j & params-j]
(format-selects-common
(sql-kw (if (= :join k) :inner-join k))
true
[j])
sqls (conj sqls sql-j)]
(if (and (sequential? e) (= :using (first e)))
(let [[u-sqls u-params]
(reduce-sql (map #'format-entity-alias) (rest e))]
[(conj sqls
"USING"
(str "("
(join ", " u-sqls)
")"))
(-> params (into params-j) (into u-params))])
(let [[sql & params'] (when e (format-expr e))]
[(cond-> sqls e (conj "ON" sql))
(-> params
(into params-j)
(into params'))])))))
[[] []]
clauses)]
(into [(join " " sqls)] params)))

(def ^:private join-by-aliases
Expand Down Expand Up @@ -1961,7 +1975,7 @@
(defn- format-infix-expr [op' op expr nested]
(let [args (cond->> (rest expr)
(contains? @op-ignore-nil op)
(remove nil?))
(filterv some?))
args (cond (seq args)
args
(= :and op)
Expand All @@ -1971,7 +1985,7 @@
:else ; args is empty and not a special case
[])
[sqls params]
(reduce-sql (map #(format-expr % {:nested true}) args))]
(reduce-sql (map #(format-expr % {:nested true})) args)]
(when-not (pos? (count sqls))
(throw (ex-info (str "no operands found for " op')
{:expr expr})))
Expand Down
1 change: 0 additions & 1 deletion src/honey/sql/util.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,6 @@
"More efficient implementation of `clojure.core/str` because it has more
non-variadic arities. Optimization is Clojure-only, on other platforms it
reverts back to `clojure.core/str`."
{:tag String}
(^String [] "")
(^String [^Object a]
#?(:clj (if (nil? a) "" (.toString a))
Expand Down

0 comments on commit 40d9aee

Please sign in to comment.