Address #292 by starting to support SELECT TOP

CHANGELOG.md

@@ -8,6 +8,7 @@
   * Fix #301 by adding support for `CREATE`/`DROP`/`REFRESH` on `MATERIALIZED VIEW`.
   * Add tests to confirm #299 does not affect v2.
   * Confirm the whole of the [nilenso/honeysql-postgres](https://github.com/nilenso/honeysql-postgres) is implemented out-of-the-box (#293).
+  * Add support for `SELECT TOP` (#292).
   * Reconcile `where` behavior with recent 1.0 changes (porting #283 to v2).
   * Fix #280 by adding `:escape` as special syntax for regular expression patterns.
   * Fix #277 by adding `:join-by`/`join-by` so that you can have multiple `JOIN`'s in a specific order.

src/honey/sql.cljc

@@ -45,7 +45,7 @@
    :refresh-materialized-view
    ;; then SQL clauses in priority order:
    :nest :with :with-recursive :intersect :union :union-all :except :except-all
-   :select :select-distinct :select-distinct-on
+   :select :select-distinct :select-distinct-on :select-top :select-distinct-top
    :insert-into :update :delete :delete-from :truncate
    :columns :set :from :using
    :join-by
@@ -298,7 +298,7 @@
     k)
    xs))
 
-(defn- format-selects-on [k xs]
+(defn- format-selects-on [_ xs]
   (let [[on & cols] xs
         [sql & params]
         (format-expr (into [:distinct-on] on))
@@ -309,6 +309,32 @@
          cols)]
     (-> [sql'] (into params) (into params'))))
 
+(defn- format-select-top [k xs]
+  (let [[top & cols] xs
+        [top & parts]
+        (if (sequential? top)
+          ;; could be an expression or a number followed by :percent :with-ties
+          (let [top-q?    #(and (ident? %)
+                                (#{:percent :with-ties} (sym->kw %)))
+                r-top     (reverse top)
+                top-quals (take-while top-q? r-top)
+                top-list  (drop-while top-q? r-top)]
+            (if (seq top-quals)
+              (if (= 1 (count top-list))
+                (into (vec top-list) (reverse top-quals))
+                (throw (ex-info "unparseable TOP expression"
+                                {:top top})))
+              [top]))
+          [top])
+        [sql & params]
+        (format-expr top)
+        [sql' & params']
+        (format-selects-common
+         (str (sql-kw k) " " sql (str/join " " (map sql-kw parts)))
+         true
+         cols)]
+    (-> [sql'] (into params) (into params'))))
+
 (defn- format-with-part [x]
   (if (sequential? x)
     (let [[sql & params] (format-dsl (second x))]
@@ -723,6 +749,8 @@
          :select          #'format-selects
          :select-distinct #'format-selects
          :select-distinct-on #'format-selects-on
+         :select-top      #'format-select-top
+         :select-distinct-top #'format-select-top
          :insert-into     #'format-insert
          :update          #'format-selector
          :delete          #'format-selects

src/honey/sql/helpers.cljc

@@ -331,6 +331,21 @@
   [& args]
   (generic :select-distinct-on args))
 
+(defn select-top
+  "Accepts a TOP expression, followed by any number of
+  column names, or column/alias pairs, or SQL expressions
+  (optionally aliased), as for `select`. The TOP expression
+  can be a simple numeric expression, or a sequence with
+  a numeric expression followed by keywords (or symbols)
+  for PERCENT and/or WITH TIES."
+  [& args]
+  (generic :select-top args))
+
+(defn select-distinct-top
+  "Like `select-top` but produces SELECT DISTINCT TOP..."
+  [& args]
+  (generic :select-distinct-top args))
+
 (defn insert-into
   "Accepts a table name or a table/alias pair. That
   can optionally be followed by a collection of

test/honey/sql/helpers_test.cljc

@@ -14,7 +14,8 @@
                      on-duplicate-key-update
                      order-by over partition-by refresh-materialized-view
                      rename-column rename-table returning right-join
-                     select select-distinct values where window with with-columns
+                     select select-distinct select-top select-distinct-top
+                     values where window with with-columns
                      with-data]]))
 
 (deftest test-select
@@ -78,6 +79,9 @@
                           ;; to enable :lock
                           :dialect :mysql :quoted false}))))))
 
+(deftest select-top-tests
+  (is true))
+
 (deftest join-by-test
   (testing "Natural JOIN orders"
     (is (= ["SELECT * FROM foo INNER JOIN draq ON f.b = draq.x LEFT JOIN clod AS c ON f.a = c.d RIGHT JOIN bock ON bock.z = c.e FULL JOIN beck ON beck.x = c.y"]