Fixes #338 properly by making offset/fetch smarter

CHANGELOG.md

@@ -1,13 +1,11 @@
 # Changes
 
-* 2.0.next (gold) in progress
+* 2.0.0-rc5 in progress
-  * Address #332 by improving `:cross-join` documentation.
+  * Fix #338 by producing `OFFSET n ROWS` (or `ROW` if `n` is 1) if `:fetch` is present or `:sqlserver` dialect is specified; and by producing `FETCH NEXT n ROWS ONLY` (or `ROW` is `n` is 1; or `FIRST` instead of `NEXT` if `:offset` is not present).
-  * Fix `fetch` helper.
-
-* 2.0.0-rc4 (for testing; 2021-07-17)
-  * Fix #338 by adding `ONLY` to `:fetch`.
   * Fix #337 by switching to `clojure.test` even for ClojureScript.
+  * Address #332 by improving `:cross-join` documentation.
   * Address #330 by improving exception when a non-entity is encountered where an entity is expected.
+  * Fix `fetch` helper (it previously returned an `:offset` clause).
   * Fix bug in unrolling nested argument to `with-columns` helper.
 
 * 2.0.0-rc3 (for testing; 2021-06-16)

pom.xml

@@ -3,7 +3,7 @@
   <modelVersion>4.0.0</modelVersion>
   <groupId>com.github.seancorfield</groupId>
   <artifactId>honeysql</artifactId>
-  <version>2.0.0-rc4</version>
+  <version>2.0.0-rc5</version>
   <name>honeysql</name>
   <description>SQL as Clojure data structures.</description>
   <url>https://github.com/seancorfield/honeysql</url>
@@ -25,7 +25,7 @@
     <url>https://github.com/seancorfield/honeysql</url>
     <connection>scm:git:git://github.com/seancorfield/honeysql.git</connection>
     <developerConnection>scm:git:ssh://git@github.com/seancorfield/honeysql.git</developerConnection>
-    <tag>v2.0.0-rc4</tag>
+    <tag>v2.0.0-rc5</tag>
   </scm>
   <dependencies>
     <dependency>

src/honey/sql.cljc

@@ -86,11 +86,14 @@
       (conj order clause))))
 
 (def ^:private dialects
-  {:ansi      {:quote #(str \" % \")}
+  (reduce-kv (fn [m k v]
-   :sqlserver {:quote #(str \[ % \])}
+               (assoc m k (assoc v :dialect k)))
-   :mysql     {:quote #(str \` % \`)
+             {}
-               :clause-order-fn #(add-clause-before % :set :where)}
+             {:ansi      {:quote #(str \" % \")}
-   :oracle    {:quote #(str \" % \") :as false}})
+              :sqlserver {:quote #(str \[ % \])}
+              :mysql     {:quote #(str \` % \`)
+                          :clause-order-fn #(add-clause-before % :set :where)}
+              :oracle    {:quote #(str \" % \") :as false}}))
 
 ; should become defonce
 (def ^:private default-dialect (atom (:ansi dialects)))
@@ -109,9 +112,26 @@
 (def ^:private ^:dynamic *allow-suspicious-entities* false)
 ;; "linting" mode (:none, :basic, :strict):
 (def ^:private ^:dynamic *checking* :none)
+;; the current DSL hash map being formatted (for contains-clause?):
+(def ^:private ^:dynamic *dsl* nil)
 
 ;; clause helpers
 
+(defn contains-clause?
+  "Returns true if the current DSL expression being formatted
+  contains the specified clause (as a keyword or symbol)."
+  [clause]
+  (or (contains? *dsl* clause)
+      (contains? *dsl*
+                 (if (keyword? clause)
+                   (symbol (name clause))
+                   (keyword (name clause))))))
+
+(defn- sql-server?
+  "Helper to detect if SQL Server is the current dialect."
+  []
+  (= :sqlserver (:dialect *dialect*)))
+
 ;; String.toUpperCase() or `str/upper-case` for that matter converts the
 ;; string to uppercase for the DEFAULT LOCALE. Normally this does what you'd
 ;; expect but things like `inner join` get converted to `İNNER JOİN` (dot over
@@ -869,10 +889,18 @@
          :partition-by    #'format-selects
          :order-by        #'format-order-by
          :limit           #'format-on-expr
-         :offset          #'format-on-expr
+         :offset          (fn [_ x]
+                            (if (or (contains-clause? :fetch) (sql-server?))
+                              (let [[sql & params] (format-on-expr :offset x)
+                                    rows (if (and (number? x) (== 1 x)) :row :rows)]
+                                (into [(str sql " " (sql-kw rows))] params))
+                              ;; format in the old style:
+                              (format-on-expr :offset x)))
          :fetch           (fn [_ x]
-                            (let [[sql & params] (format-on-expr :fetch x)]
+                            (let [which (if (contains-clause? :offset) :fetch-next :fetch-first)
-                              (into [(str sql " " (sql-kw :only))] params)))
+                                  rows  (if (and (number? x) (== 1 x)) :row-only :rows-only)
+                                  [sql & params] (format-on-expr which x)]
+                              (into [(str sql " " (sql-kw rows))] params)))
          :for             #'format-lock-strength
          :lock            #'format-lock-strength
          :values          #'format-values
@@ -907,29 +935,30 @@
   This is intended to be used when writing your own formatters to
   extend the DSL supported by HoneySQL."
   [statement-map & [{:keys [aliased nested pretty]}]]
-  (let [[sqls params leftover]
+  (binding [*dsl* statement-map]
-        (reduce (fn [[sql params leftover] k]
+    (let [[sqls params leftover]
-                  (if-some [xs (if-some [xs (k leftover)]
+          (reduce (fn [[sql params leftover] k]
-                                 xs
+                    (if-some [xs (if-some [xs (k leftover)]
-                                 (let [s (kw->sym k)]
+                                   xs
-                                   (get leftover s)))]
+                                   (let [s (kw->sym k)]
-                    (let [formatter (k @clause-format)
+                                     (get leftover s)))]
-                          [sql' & params'] (formatter k xs)]
+                      (let [formatter (k @clause-format)
-                      [(conj sql sql')
+                            [sql' & params'] (formatter k xs)]
-                       (if params' (into params params') params)
+                        [(conj sql sql')
-                       (dissoc leftover k (kw->sym k))])
+                         (if params' (into params params') params)
-                    [sql params leftover]))
+                         (dissoc leftover k (kw->sym k))])
-                [[] [] statement-map]
+                      [sql params leftover]))
-                *clause-order*)]
+                  [[] [] statement-map]
-    (if (seq leftover)
+                  *clause-order*)]
-      (throw (ex-info (str "These SQL clauses are unknown or have nil values: "
+      (if (seq leftover)
-                            (str/join ", " (keys leftover)))
+        (throw (ex-info (str "These SQL clauses are unknown or have nil values: "
-                      leftover))
+                             (str/join ", " (keys leftover)))
-      (into [(cond-> (str/join (if pretty "\n" " ") (filter seq sqls))
+                        leftover))
-               pretty
+        (into [(cond-> (str/join (if pretty "\n" " ") (filter seq sqls))
-               (as-> s (str "\n" s "\n"))
+                 pretty
-               (and nested (not aliased))
+                 (as-> s (str "\n" s "\n"))
-               (as-> s (str "(" s ")")))] params))))
+                 (and nested (not aliased))
+                 (as-> s (str "(" s ")")))] params)))))
 
 (def ^:private infix-aliases
   "Provided for backward compatibility with earlier HoneySQL versions."

test/honey/sql_test.cljc

@@ -783,7 +783,30 @@ ORDER BY id = ? DESC
                     :join [[{:select :a :from :b :where [:= :id 123]} :x] :y]
                     :where [:= :id 456]})))))
 
-(deftest fetch-offset-issue338
+(deftest fetch-offset-issue-338
-  (is (= ["SELECT foo FROM bar OFFSET ? FETCH ? ONLY" 20 10]
+  (testing "default offset (with and without limit)"
-         (format {:select :foo :from :bar
+    (is (= ["SELECT foo FROM bar LIMIT ? OFFSET ?" 10 20]
-                  :fetch 10 :offset 20}))))
+           (format {:select :foo :from :bar
+                    :limit 10 :offset 20})))
+    (is (= ["SELECT foo FROM bar OFFSET ?" 20]
+           (format {:select :foo :from :bar
+                    :offset 20}))))
+  (testing "default offset / fetch"
+    (is (= ["SELECT foo FROM bar OFFSET ? ROWS FETCH NEXT ? ROWS ONLY" 20 10]
+           (format {:select :foo :from :bar
+                    :fetch 10 :offset 20})))
+    (is (= ["SELECT foo FROM bar OFFSET ? ROW FETCH NEXT ? ROW ONLY" 1 1]
+           (format {:select :foo :from :bar
+                    :fetch 1 :offset 1})))
+    (is (= ["SELECT foo FROM bar FETCH FIRST ? ROWS ONLY" 2]
+           (format {:select :foo :from :bar
+                    :fetch 2}))))
+  (testing "SQL Server offset"
+    (is (= ["SELECT [foo] FROM [bar] OFFSET ? ROWS FETCH NEXT ? ROWS ONLY" 20 10]
+           (format {:select :foo :from :bar
+                    :fetch 10 :offset 20}
+                   {:dialect :sqlserver})))
+    (is (= ["SELECT [foo] FROM [bar] OFFSET ? ROWS" 20]
+           (format {:select :foo :from :bar
+                    :offset 20}
+                   {:dialect :sqlserver})))))