Support custom dialects fixes #401 (add docs/tests)

CHANGELOG.md

@@ -1,7 +1,7 @@
 # Changes
 
 * 2.3.next in progress
-  * Address [#401](https://github.com/seancorfield/honeysql/issues/401) by adding `register-dialect!` and `get-dialect`, and also making `add-clause-before` and `strop` public so that new dialects are easier to construct.
+  * Address [#401](https://github.com/seancorfield/honeysql/issues/401) by adding `register-dialect!` and `get-dialect`, and also making `add-clause-before`, `strop`, and `upper-case` public so that new dialects are easier to construct.
 
 * 2.2.891 -- 2022-04-23
   * Address [#404](https://github.com/seancorfield/honeysql/issues/404) by documenting PostgreSQL's `ARRAY` constructor syntax and how to produce it.

doc/extending-honeysql.md

@@ -156,3 +156,38 @@ of it and would call `sql/format-expr` on each argument:
 ;; produces:
 ;;=> ["SELECT * FROM table WHERE FOO(a + ?)" 1]
 ```
+
+## Registering a new Dialect
+
+_New in HoneySQL 2.3.x_
+
+The built-in dialects that HoneySQL supports are:
+* `:ansi` -- the default, that quotes identifiers with double-quotes, like `"this"`
+* `:mysql` -- quotes identifiers with backticks, and changes the precedence of `SET` in `UPDATE`
+* `:oracle` -- quotes identifiers like `:ansi`, and does not use `AS` in aliases
+* `:sqlserver` -- quotes identifiers with brackets, like `[this]`
+
+A dialect spec is a hash map containing at least `:quote` but also optionally `:clause-order-fn` and/or `:as`:
+* `:quote` -- a unary function that takes a string and returns the quoted version of it
+* `:clause-order-fn` -- a unary function that takes a sequence of clause names (keywords) and returns an updated sequence of clause names; this defines the precedence of clauses in the DSL parser
+* `:as` -- a boolean that indicates whether `AS` should be present in aliases (the default, if `:as` is omitted) or not (by specifying `:as false`)
+
+To make writing new dialects easier, the following helper functions in `honey.sql` are available:
+* `add-clause-before` -- a function that accepts the sequence of clause names, the (new) clause to add, and the clause to add it before (`nil` means add at the end)
+* `get-dialect` -- a function that accepts an existing dialect name (keyword) and returns its spec (hash map)
+* `strop` -- a function that accepts an opening quote, a string, and a closing quote and returns the quoted string, doubling-up any closing quote characters inside the string to make it legal SQL
+* `upper-case` -- a locale-insensitive version of `clojure.string/upper-case`
+
+For example, to add a variant of the `:ansi` dialect that forces names to be upper-case as well as double-quoting them:
+
+```clojure
+(sql/register-dialect! ::ANSI (update (sql/get-dialect :ansi) :quote comp sql/upper-case))
+;; or you could do this:
+(sql/register-dialect! ::ANSI {:quote #(sql/strop \" (sql/upper-case %) \")})
+
+(sql/format {:select :foo :from :bar} {:dialect :ansi})
+;;=> ["SELECT \"foo\" FROM \"bar\""]
+
+(sql/format {:select :foo :from :bar} {:dialect ::ANSI})
+;;=> ["SELECT \"FOO\" FROM \"BAR\""]
+```

src/honey/sql.cljc

@@ -158,10 +158,17 @@
 ;; way we'd expect.
 ;;
 ;; Use this instead of `str/upper-case` as it will always use Locale/US.
-(def ^:private ^{:arglists '([s])} upper-case
+#?(:clj
+   (defn upper-case
+     "Upper-case a string in Locale/US to avoid locale-specific capitalization."
+     [^String s]
+     (.. s toString (toUpperCase (java.util.Locale/US))))
    ;; TODO - not sure if there's a JavaScript equivalent here we should be using as well
-  #?(:clj (fn [^String s] (.. s toString (toUpperCase (java.util.Locale/US))))
-     :cljs str/upper-case))
+   :cljs
+   (defn upper-case
+     "In ClojureScript, just an alias for cljs.string/upper-case."
+     [s]
+     (str/upper-case s)))
 
 (defn- dehyphen
   "Replace _embedded_ hyphens with spaces.
@@ -1540,15 +1547,19 @@
   (when-not (keyword? dialect)
     (throw (ex-info "Dialect must be a keyword" {:dialect dialect})))
   (when-not (map? dialect-spec)
-    (throw (ex-info "Dialect spec must be a hash map containing at least a :quoted function"
+    (throw (ex-info "Dialect spec must be a hash map containing at least a :quote function"
                     {:dialect-spec dialect-spec})))
-  (when-not (fn? (:quoted dialect-spec))
-    (throw (ex-info "Dialect spec is missing a :quoted function"
+  (when-not (fn? (:quote dialect-spec))
+    (throw (ex-info "Dialect spec is missing a :quote function"
                     {:dialect-spec dialect-spec})))
   (when-let [cof (:clause-order-fn dialect-spec)]
     (when-not (fn? cof)
       (throw (ex-info "Dialect spec contains :clause-order-fn but it is not a function"
                       {:dialect-spec dialect-spec}))))
+  (when-some [as (:as dialect-spec)]
+    (when-not (boolean? as)
+      (throw (ex-info "Dialect spec contains :as but it is not a boolean"
+                      {:dialect-spec dialect-spec}))))
   (swap! dialects assoc dialect (assoc dialect-spec :dialect dialect)))
 
 (defn get-dialect

test/honey/sql_test.cljc

@@ -750,6 +750,14 @@ ORDER BY id = ? DESC
   (testing "that registering a clause by name works"
     (is (map? (sut/register-clause! :qualify :having :window)))))
 
+(deftest issue-401-dialect
+  (testing "registering a dialect that upper-cases idents"
+    (sut/register-dialect! ::MYSQL (update (sut/get-dialect :mysql) :quote comp sut/upper-case))
+    (is (= ["SELECT `foo` FROM `bar`"]
+           (sut/format {:select :foo :from :bar} {:dialect :mysql})))
+    (is (= ["SELECT `FOO` FROM `BAR`"]
+           (sut/format {:select :foo :from :bar} {:dialect ::MYSQL})))))
+
 (deftest issue-321-linting
   (testing "empty IN is ignored by default"
     (is (= ["WHERE x IN ()"]