From 580d0a6b7ffce11c3045d96aabf75783b4523d25 Mon Sep 17 00:00:00 2001 From: Oleksandr Yakushev Date: Mon, 5 May 2025 01:41:37 +0300 Subject: [PATCH 1/2] Ensure xs in `format-values` is a vector --- src/honey/sql.cljc | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/honey/sql.cljc b/src/honey/sql.cljc index feb6d37..dd15d42 100644 --- a/src/honey/sql.cljc +++ b/src/honey/sql.cljc @@ -1165,8 +1165,8 @@ ;; use the keys from the first map if they match so that ;; users can rely on the key ordering if they want to, ;; e.g., see test that uses array-map for the first row - cols-n (into #{} (mapcat keys) (filter map? xs)) - cols (if (= (set cols-1) cols-n) cols-1 cols-n)] + cols-n (into #{} (comp (filter map?) (mapcat keys)) xs) + cols (if (= (into #{} cols-1) cols-n) cols-1 cols-n)] [cols (when-not skip-cols-sql (str "(" (join ", " (map #(format-entity % {:drop-ns true})) cols) @@ -1177,14 +1177,15 @@ row-ctr (and (sequential? xs) (ident? (first xs)) (contains? #{:row 'row} (first xs))) - xs (if row-ctr (rest xs) xs)] + xs (if (sequential? xs) (vec xs) xs) + xs (if row-ctr (subvec xs 1) xs)] (cond (and (ident? xs) (contains? #{:default 'default} xs)) [(str (sql-kw xs) " " (sql-kw k))] (empty? xs) [(str (sql-kw k) " ()")] (sequential? first-xs) ;; [[1 2 3] [4 5 6]] - (let [n-1 (map count (filter sequential? xs)) + (let [n-1 (into [] (comp (filter sequential?) (map count)) xs) ;; issue #291: ensure all value sequences are the same length xs' (if (apply = n-1) xs From 0a4df0b06381351159c531ba8bd0089154962d6a Mon Sep 17 00:00:00 2001 From: Oleksandr Yakushev Date: Mon, 5 May 2025 01:07:00 +0300 Subject: [PATCH 2/2] Consolidate private dynvars under a single *options* var --- src/honey/sql.cljc | 270 ++++++++++++++++++++++----------------------- 1 file changed, 132 insertions(+), 138 deletions(-) diff --git a/src/honey/sql.cljc b/src/honey/sql.cljc index dd15d42..c07cb89 100644 --- a/src/honey/sql.cljc +++ b/src/honey/sql.cljc @@ -134,30 +134,32 @@ (def ^:private default-numbered (atom false)) (def ^:private ^:dynamic *dialect* nil) -;; nil would be a better default but that makes testing individual -;; functions harder than necessary: -(def ^:private ^:dynamic *clause-order* default-clause-order) -(def ^:private ^:dynamic *quoted* @default-quoted) -(def ^:private ^:dynamic *quoted-always* @default-quoted-always) -(def ^:private ^:dynamic *quoted-snake* @default-quoted-snake) -(def ^:private ^:dynamic *inline* @default-inline) -(def ^:private ^:dynamic *params* nil) -(def ^:private ^:dynamic *values-default-columns* nil) -;; there is no way, currently, to enable suspicious characters -;; in entities; if someone complains about this check, an option -;; can be added to format to turn this on: -(def ^:private ^:dynamic *allow-suspicious-entities* false) -;; the following metadata is ignored in formatted by default: -;; :file, :line, :column, :end-line, and :end-column -;; this dynamic var can be used to add more metadata to ignore: -(def ^:private ^:dynamic *ignored-metadata* []) -;; "linting" mode (:none, :basic, :strict): -(def ^:private ^:dynamic *checking* @default-checking) -;; the current DSL hash map being formatted (for clause-body / contains-clause?): -(def ^:private ^:dynamic *dsl* nil) -;; caching data to detect expressions that cannot be cached: -(def ^:private ^:dynamic *caching* nil) -(def ^:private ^:dynamic *numbered* nil) +(def ^:private ^:dynamic *options* + {;; nil would be a better default but that makes testing individual + ;; functions harder than necessary: + :clause-order default-clause-order + :quoted @default-quoted + :quoted-always @default-quoted-always + :quoted-snake @default-quoted-snake + :inline @default-inline + :params nil + :values-default-columns nil + ;; there is no way, currently, to enable suspicious characters + ;; in entities; if someone complains about this check, an option + ;; can be added to format to turn this on: + :allow-suspicious-entities false + ;; the following metadata is ignored in formatted by default: + ;; :file, :line, :column, :end-line, and :end-column + ;; this dynamic var can be used to add more metadata to ignore: + :ignored-metadata [] + ;; "linting" mode (:none, :basic, :strict): + :checking @default-checking + ;; the current DSL hash map being formatted (for clause-body / contains-clause?): + :dsl nil + ;; caching data to detect expressions that cannot be cached: + :caching nil + :numbered nil}) + ;; #533 mostly undocumented dynvar to prevent ? -> ?? escaping: (def ^:no-doc ^:dynamic *escape-?* true) @@ -165,7 +167,7 @@ (def ^:private suspicious ";") (defn- suspicious? [s] (str/includes? s suspicious)) (defn- suspicious-entity-check [entity] - (when-not *allow-suspicious-entities* + (when-not (:allow-suspicious-entities *options*) (when (suspicious? entity) (throw (ex-info (str "suspicious character found in entity: " entity) {:disallowed suspicious}))))) @@ -176,11 +178,12 @@ "If the current DSL expression being formatted contains the specified clause (as a keyword or symbol), returns that clause's value." [clause] - (or (get *dsl* clause) - (get *dsl* - (if (keyword? clause) - (symbol (name clause)) - (keyword (name clause)))))) + (let [dsl (:dsl *options*)] + (or (get dsl clause) + (get dsl + (if (keyword? clause) + (symbol (name clause)) + (keyword (name clause))))))) (defn contains-clause? "Returns true if the current DSL expression being formatted @@ -283,37 +286,38 @@ Handles quoting, splitting at / or ., replacing - with _ etc." ([e] (format-entity e {})) ([e {:keys [aliased drop-ns]}] - (let [e (if (and aliased (keyword? e) (str/starts-with? (name e) "'")) - ;; #497 quoted alias support (should behave like string) + (let [dialect *dialect* + {:keys [quoted quoted-snake quoted-always]} *options* + e (if (and aliased (keyword? e) (str/starts-with? (name e) "'")) + ;; #497 quoted alias support (should behave like string) (subs (name e) 1) e) - col-fn (or (:col-fn *dialect*) - (if (or *quoted* (string? e)) - (if *quoted-snake* name-_ name) + col-fn (or (:col-fn dialect) + (if (or quoted (string? e)) + (if quoted-snake name-_ name) name-_)) col-e (col-fn e) - dialect-q (:quote *dialect* identity) - quote-fn (cond (or *quoted* (string? e)) + dialect-q (:quote dialect identity) + quote-fn (cond (or quoted (string? e)) dialect-q ;; #422: if default quoting and "unusual" ;; characters in entity, then quote it: - (nil? *quoted*) + (nil? quoted) (fn opt-quote [part] - (cond (and *quoted-always* - (re-find *quoted-always* part)) + (cond (some-> quoted-always (re-find part)) (dialect-q part) (re-find alphanumeric part) part :else (dialect-q part))) - *quoted-always* + quoted-always (fn always-quote [part] - (if (re-find *quoted-always* part) + (if (re-find quoted-always part) (dialect-q part) part)) :else identity) - parts-fn (or (:parts-fn *dialect*) + parts-fn (or (:parts-fn dialect) #(if-let [n (when-not (or drop-ns (string? e)) (namespace-_ e))] [n %] @@ -329,10 +333,10 @@ (for [v [:foo-bar "foo-bar" ; symbol is the same as keyword :f-o.b-r :f-o/b-r] a [true false] d [true false] q [true false]] - (binding [*dialect* (:mysql @dialects) *quoted* q] + (binding [*dialect* (:mysql @dialects) *options* (assoc *options* :quoted q)] (if q [v a d (format-entity v {:aliased a :drop-ns d}) - (binding [*quoted-snake* true] + (binding [*options* (assoc *options* :quoted-snake true)] (format-entity v {:aliased a :drop-ns d}))] [v a d (format-entity v {:aliased a :drop-ns d})]))) ) @@ -356,7 +360,8 @@ (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*)] + (binding [*options* (cond-> *options* + (= ident-l "array") (assoc :quoted nil))] (format-entity (keyword ident)))) (-> n (dehyphen) (upper-case)))))) @@ -419,10 +424,11 @@ (defn- sqlize-value [x] (p/sqlize x)) (defn- param-value [k] - (if (contains? *params* k) - (get *params* k) - (throw (ex-info (str "missing parameter value for " k) - {:params (keys *params*)})))) + (let [{:keys [params]} *options*] + (if (contains? params k) + (get params k) + (throw (ex-info (str "missing parameter value for " k) + {:params (keys params)}))))) (defn- ->param [k] (with-meta (constantly k) @@ -430,18 +436,18 @@ (fn [fk _] (param-value (fk)))})) (defn ->numbered [v] - (let [n (count (swap! *numbered* conj v))] + (let [{:keys [numbered]} *options* + n (count (swap! numbered conj v))] [(str "$" n) (with-meta (constantly (dec n)) {::wrapper - (fn [fk _] (get @*numbered* (fk)))})])) + (fn [fk _] (get @numbered (fk)))})])) (defn ->numbered-param [k] - (let [n (count (swap! *numbered* conj k))] + (let [{:keys [numbered]} *options* + n (count (swap! numbered conj k))] [(str "$" n) (with-meta (constantly (dec n)) {::wrapper - (fn [fk _] (param-value (get @*numbered* (fk))))})])) - -(def ^:private ^:dynamic *formatted-column* (atom false)) + (fn [fk _] (param-value (get @numbered (fk))))})])) (defn- format-fn-name [x] @@ -457,9 +463,7 @@ (format-simple-var x c {}))) ([x c opts] (if (str/starts-with? c "'") - (do - (reset! *formatted-column* true) - (subs c 1)) + (subs c 1) (format-entity x opts)))) (defn- format-var @@ -468,7 +472,8 @@ ;; 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 (if (keyword? x) + (let [{:keys [inline numbered]} *options* + c (if (keyword? x) #?(:bb (subs (str x) 1) :clj (str (.sym ^clojure.lang.Keyword x)) :default (subs (str x) 1)) @@ -480,9 +485,9 @@ ")")]) (str/starts-with? c "?") (let [k (keyword (subs c 1))] - (cond *inline* + (cond inline [(sqlize-value (param-value k))] - *numbered* + numbered (->numbered-param k) :else ["?" (->param k)])) @@ -633,14 +638,14 @@ (into [; remove the somewhat "standard" metadata: :line :column :file :end-line :end-column] - *ignored-metadata*)))] + (:ignored-metadata *options*))))] (when (seq items) (join (str sep " ") (map sql-kw) items)))))) (comment (format-meta ^{:foo true :bar :baz :original {:line 1} :top 10} []) - (binding [*ignored-metadata* [:bar]] + (binding [*options* {:ignored-metadata [:bar]}] (format-meta ^{:foo true :bar :baz} [])) (format-meta []) @@ -682,7 +687,7 @@ (str (if as (if (or *-qualifier (and (contains? *dialect* :as) - (not (:as *dialect*)))) + (not (:as *dialect*)))) " " " AS ") " ") @@ -819,7 +824,7 @@ ["(" ")"])] (if (sequential? xs) (let [[sqls params] (reduce-sql (map #(format-selectable-dsl % {:as as})) xs)] - (when-not (= :none *checking*) + (when-not (= :none (:checking *options*)) (when (empty? xs) (throw (ex-info (str prefix " empty column list is illegal") {:clause (into [prefix] xs)})))) @@ -1173,7 +1178,8 @@ ")"))])))) (defn- format-values [k xs] - (let [first-xs (when (sequential? xs) (first (drop-while ident? xs))) + (let [{:keys [values-default-columns]} *options* + first-xs (when (sequential? xs) (first (drop-while ident? xs))) row-ctr (and (sequential? xs) (ident? (first xs)) (contains? #{:row 'row} (first xs))) @@ -1226,9 +1232,8 @@ (get x % ;; issue #366: use NULL or DEFAULT ;; for missing column values: - (if (contains? *values-default-columns* %) - [:default] - nil)))) + (when (contains? values-default-columns %) + [:default])))) cols)] [(conj sql (if (sequential? sqls') @@ -1313,7 +1318,7 @@ [(str (sql-kw k) " " e " = EXCLUDED." e)]))) (defn- format-simple-clause [c context] - (binding [*inline* true] + (binding [*options* (assoc *options* :inline true)] (let [[sql & params] (format-dsl c)] (when (seq params) (throw (ex-info (str "parameters are not accepted in " context) @@ -1321,7 +1326,7 @@ sql))) (defn- format-simple-expr [e context] - (binding [*inline* true] + (binding [*options* (assoc *options* :inline true)] (let [[sql & params] (format-expr e)] (when (seq params) (throw (ex-info (str "parameters are not accepted in " context) @@ -1571,7 +1576,7 @@ (into [(str (sql-kw k) " " sql " " (join " " (map sql-kw) units))] params)) - (binding [*inline* true] + (binding [*options* (assoc *options* :inline true)] (let [[sql & params] (format-expr n)] (into [(str (sql-kw k) " " sql)] params))))) [(str (sql-kw k) " " (sql-kw args))])) @@ -1614,10 +1619,11 @@ a non-empty where clause if at least basic checking is enabled." [formatter] (fn [k xs] - (when-not (= :none *checking*) - (when-not (seq (:where *dsl*)) - (throw (ex-info (str (sql-kw k) " without a non-empty WHERE clause is dangerous") - {:clause k :where (:where *dsl*)})))) + (let [{:keys [checking dsl]} *options*] + (when-not (= :none checking) + (when (empty? (:where dsl)) + (throw (ex-info (str (sql-kw k) " without a non-empty WHERE clause is dangerous") + {:clause k :where (:where dsl)}))))) (formatter k xs))) (def ^:private base-clause-order @@ -1760,7 +1766,7 @@ extend the DSL supported by HoneySQL." ([statement-map] (format-dsl statement-map {})) ([statement-map {:keys [aliased nested pretty]}] - (binding [*dsl* statement-map] + (binding [*options* (assoc *options* :dsl statement-map)] (let [[sqls params leftover] (reduce (fn [[sql params leftover] k] (if-some [xs (if-some [xs (k leftover)] @@ -1774,7 +1780,7 @@ (dissoc leftover k (kw->sym k))]) [sql params leftover])) [[] [] statement-map] - *clause-order*)] + (:clause-order *options*))] (if (seq leftover) (throw (ex-info (str "These SQL clauses are unknown or have nil values: " (join ", " (keys leftover)) @@ -1822,32 +1828,33 @@ x)) (defn- format-in [in [x y]] - (let [[sql-x & params-x] (format-expr x {:nested true}) + (let [{:keys [caching checking numbered]} *options* + [sql-x & params-x] (format-expr x {:nested true}) [sql-y & params-y] (format-expr y {:nested true}) [v1 :as values] (map #(unwrap % {}) params-y)] ;; #396: prevent caching IN () when named parameter is used: (when (and (meta (first params-y)) (::wrapper (meta (first params-y))) - *caching*) + caching) (throw (ex-info "SQL that includes IN () expressions cannot be cached" {}))) - (when-not (= :none *checking*) + (when-not (= :none checking) (when (or (and (sequential? y) (empty? y)) (and (sequential? v1) (empty? v1))) (throw (ex-info "IN () empty collection is illegal" {:clause [in x y]}))) - (when (and (= :strict *checking*) + (when (and (= :strict checking) (or (and (sequential? y) (some nil? y)) (and (sequential? v1) (some nil? v1)))) (throw (ex-info "IN (NULL) does not match" {:clause [in x y]})))) - (cond (and (not *numbered*) + (cond (and (not numbered) (= "?" sql-y) (= 1 (count params-y)) (coll? v1)) (let [sql (str "(" (join ", " (repeat (count v1) "?")) ")")] (into* [(str sql-x " " (sql-kw in) " " sql)] params-x v1)) - (and *numbered* - (= (str "$" (count @*numbered*)) sql-y) + (and numbered + (= (str "$" (count @numbered)) sql-y) (= 1 (count params-y)) (coll? v1)) (let [vs (for [v v1] (->numbered v)) @@ -1856,7 +1863,7 @@ params-x [nil] (map second vs))) :else (into* [(str sql-x " " (sql-kw in) " " sql-y)] - params-x (if *numbered* values params-y))))) + params-x (if numbered values params-y))))) (defn- function-0 [k xs] [(str (sql-kw k) @@ -2026,7 +2033,7 @@ (fn [_ [expr tz]] (let [[sql & params] (format-expr expr {:nested true}) [tz-sql & _] - (binding [*inline* true] + (binding [*options* (assoc *options* :inline true)] (format-expr (if (ident? tz) (name tz) tz)))] (into [(str sql " AT TIME ZONE " tz-sql)] params))) :between #'between-fn @@ -2058,7 +2065,7 @@ :ignore-nulls ignore-respect-nulls :inline (fn [_ xs] - (binding [*inline* true] + (binding [*options* (assoc *options* :inline true)] [(join " " (mapcat #(format-expr % {:record true})) xs)])) :interval format-interval :join @@ -2075,12 +2082,12 @@ (into [(str "LATERAL " sql)] params)))) :lift (fn [_ [x]] - (cond *inline* + (cond (:inline *options*) ;; this is pretty much always going to be wrong, ;; but it could produce a valid result so we just ;; assume that the user knows what they are doing: [(sqlize-value x)] - *numbered* + (:numbered *options*) (->numbered x) :else ["?" (with-meta (constantly x) @@ -2117,9 +2124,9 @@ :param (fn [_ [k]] (let [k (sym->kw k)] - (cond *inline* + (cond (:inline *options*) [(sqlize-value (param-value k))] - *numbered* + (:numbered *options*) (->numbered-param k) :else ["?" (->param k)]))) @@ -2232,9 +2239,9 @@ ["NULL"] :else - (cond *inline* + (cond (:inline *options*) [(sqlize-value expr)] - *numbered* + (:numbered *options*) (->numbered expr) :else ["?" expr])))) @@ -2284,50 +2291,37 @@ dialect (if dialect? (get @dialects (check-dialect (:dialect opts))) @default-dialect) - numbered (if (contains? opts :numbered) - (:numbered opts) - @default-numbered) - formatter (if (map? data) #'format-dsl #'format-expr)] - (binding [*dialect* dialect - *caching* cache - *checking* (if (contains? opts :checking) - (:checking opts) - @default-checking) - *clause-order* (if dialect? - (if-let [f (:clause-order-fn dialect)] - (f @base-clause-order) + numbered? (:numbered opts @default-numbered) + formatter (if (map? data) #'format-dsl #'format-expr) + options {:caching cache + :checking (:checking opts @default-checking) + :clause-order (if dialect? + (if-let [f (:clause-order-fn dialect)] + (f @base-clause-order) + @current-clause-order) @current-clause-order) - @current-clause-order) - *ignored-metadata* (if (contains? opts :ignored-metadata) - (:ignored-metadata opts) - []) - *inline* (cond (contains? opts :inline) - (:inline opts) - (= :nrql (:dialect dialect)) - true - :else - @default-inline) - *numbered* (when numbered - (atom [])) - *quoted* (cond (contains? opts :quoted) - (:quoted opts) - (= :nrql (:dialect dialect)) - nil - dialect? - true - :else - @default-quoted) - *quoted-always* (if (contains? opts :quoted-always) - (:quoted-always opts) - @default-quoted-always) - *quoted-snake* (if (contains? opts :quoted-snake) - (:quoted-snake opts) - @default-quoted-snake) - *params* (reduce-kv (fn [m k v] - (assoc m (sym->kw k) v)) - {} - (:params opts)) - *values-default-columns* (:values-default-columns opts)] + :ignored-metadata (:ignored-metadata opts []) + :inline (:inline opts (if (= :nrql (:dialect dialect)) + true + @default-inline)) + :numbered (when numbered? (atom [])) + :quoted (cond (contains? opts :quoted) + (:quoted opts) + (= :nrql (:dialect dialect)) + nil + dialect? + true + :else + @default-quoted) + :quoted-always (:quoted-always opts @default-quoted-always) + :quoted-snake (:quoted-snake opts @default-quoted-snake) + :params (reduce-kv (fn [m k v] + (assoc m (sym->kw k) v)) + {} + (:params opts)) + :values-default-columns (:values-default-columns opts)}] + (binding [*dialect* dialect + *options* options] (if cache (->> (through-opts opts cache data (fn [_] (formatter data (dissoc opts :cache)))) (mapv #(unwrap % opts)))