Add :quoted-snake option

CHANGELOG.md

@@ -1,5 +1,9 @@
 # Changes
 
+* 2.0.next in progress
+  * Add `:quoted-snake true` option to force conversion from kebab-case to snake_case when `:quoted true` or a `:dialect` is specified to `format`.
+  * TBD `%` function syntax may respect `:quoted true` or a `:dialect` is specified to `format` (awaiting PR).
+
 * 2.0.0-rc1 (for testing; 2021-05-06)
   * Fix #324 so that `insert-into` supports merging into another statement in all cases.
   * Fix #323 by supporting more than one SQL entity in `:on-conflict`.

doc/differences-from-1-x.md

@@ -85,7 +85,7 @@ The `:quoting <dialect>` option has superseded by the new dialect machinery and
 Identifiers are automatically quoted if you specify a `:dialect` option to `format`, unless you also specify `:quoted false`.
 
 The following options are no longer supported:
-* `:allow-dashed-names?` -- if you provide dashed-names in 2.x, they will be left as-is if quoting is enabled, else they will be converted to snake_case (so you will either get `"dashed-names"` with quoting or `dashed_names` without).
+* `:allow-dashed-names?` -- if you provide dashed-names in 2.x, they will be left as-is if quoting is enabled, else they will be converted to snake_case (so you will either get `"dashed-names"` with quoting or `dashed_names` without). If you want dashed-names to be converted to snake_case when `:quoted true`, you also need to specify `:quoted-snake true`. _[New in 2.0.next]_
 * `:allow-namespaced-names?` -- this supported `foo/bar` column names in SQL which I'd like to discourage.
 * `:namespace-as-table?` -- this is the default in 2.x: `:foo/bar` will be treated as `foo.bar` which is more in keeping with `next.jdbc`.
 * `:parameterizer` -- this would add a lot of complexity to the formatting engine and I do not know how widely it was used (especially in its arbitrarily extensible form).

src/honey/sql.cljc

@@ -100,6 +100,7 @@
 ;; functions harder than necessary:
 (def ^:private ^:dynamic *clause-order* default-clause-order)
 (def ^:private ^:dynamic *quoted* nil)
+(def ^:private ^:dynamic *quoted-snake* nil)
 (def ^:private ^:dynamic *inline* nil)
 (def ^:private ^:dynamic *params* nil)
 ;; there is no way, currently, to enable suspicious characters
@@ -165,21 +166,23 @@
   return the equivalent SQL fragment (as a string -- no parameters).
 
   Handles quoting, splitting at / or ., replacing - with _ etc."
-  [x & [{:keys [aliased drop-ns]}]]
+  [e & [{:keys [aliased drop-ns]}]]
-  (let [nn    (if (or *quoted* (string? x)) name               name-_)
+  (let [col-fn      (if (or *quoted* (string? e))
-        q     (if (or *quoted* (string? x)) (:quote *dialect*) identity)
+                      (if *quoted-snake* name-_ name)
-        [t c] (if-let [n (when-not (or drop-ns (string? x))
+                      name-_)
-                           (namespace-_ x))]
+        quote-fn    (if (or *quoted* (string? e)) (:quote *dialect*) identity)
-                [n (nn x)]
+        [table col] (if-let [n (when-not (or drop-ns (string? e))
-                (if aliased
+                                 (namespace-_ e))]
-                  [nil (nn x)]
+                      [n (col-fn e)]
-                  (let [[t c] (str/split (nn x) #"\.")]
+                      (if aliased
-                    (if c [t c] [nil t]))))
+                        [nil (col-fn e)]
-        entity (cond->> c
+                        (let [[t c] (str/split (col-fn e) #"\.")]
-                 (not= "*" c)
+                          (if c [t c] [nil t]))))
-                 (q)
+        entity      (cond->> col
-                 t
+                      (not= "*" col)
-                 (str (q t) "."))
+                      (quote-fn)
+                      table
+                      (str (quote-fn table) "."))
         suspicious #";"]
     (when-not *allow-suspicious-entities*
       (when (re-find suspicious entity)
@@ -188,11 +191,15 @@
     entity))
 
 (comment
-  (for [v [:foo-bar 'foo-bar "foo-bar"
+  (for [v [:foo-bar "foo-bar" ; symbol is the same as keyword
-           :f-o.bar 'f-o.bar "f-o.bar"]
+           :f-o.b-r :f-o/b-r]
         a [true false] d [true false] q [true false]]
     (binding [*dialect* (:mysql dialects) *quoted* q]
-      (format-entity v :aliased a :drop-ns d)))
+      (if q
+        [v a d (format-entity v {:aliased a :drop-ns d})
+         (binding [*quoted-snake* true]
+           (format-entity v {:aliased a :drop-ns d}))]
+        [v a d (format-entity v {:aliased a :drop-ns d})])))
   .)
 
 (defn- param-value [k]
@@ -1253,6 +1260,8 @@
                *quoted*  (if (contains? opts :quoted)
                            (:quoted opts)
                            dialect?)
+               *quoted-snake* (when (contains? opts :quoted-snake)
+                                (:quoted-snake opts))
                *params* (:params opts)]
        (mapv #(unwrap % opts) (format-dsl data opts)))))
   ([data k v & {:as opts}] (format data (assoc opts k v))))

test/honey/sql/postgres_test.cljc

@@ -14,21 +14,21 @@
             ;; pull in all the PostgreSQL helpers that the nilenso
             ;; library provided (as well as the regular HoneySQL ones):
             [honey.sql.helpers :as sqlh :refer
-            [upsert on-conflict do-nothing on-constraint
+             [upsert on-conflict do-nothing on-constraint
-             returning do-update-set
+              returning do-update-set
-             ;; not needed because do-update-set can do this directly
+              ;; not needed because do-update-set can do this directly
-             #_do-update-set!
+              #_do-update-set!
-             alter-table rename-column drop-column
+              alter-table rename-column drop-column
-             add-column partition-by
+              add-column partition-by
-             ;; not needed because insert-into can do this directly
+              ;; not needed because insert-into can do this directly
-             #_insert-into-as
+              #_insert-into-as
-             create-table rename-table drop-table
+              create-table rename-table drop-table
-             window create-view over with-columns
+              window create-view over with-columns
-             create-extension drop-extension
+              create-extension drop-extension
-             select-distinct-on
+              select-distinct-on
-             ;; already part of HoneySQL
+              ;; already part of HoneySQL
-             insert-into values where select
+              insert-into values where select
-             from order-by update set]]
+              from order-by update set]]
             [honey.sql :as sql]))
 
 (deftest upsert-test