Addresses #293 start work on DDL support

doc/clause-reference.md

@@ -11,6 +11,26 @@ a space (e.g., `:left-join` is formatted as `LEFT JOIN`).
 Except as noted, these clauses apply to all the SQL
 dialects that HoneySQL supports.
 
+## alter-table
+
+## create-table
+
+## create-view
+
+## drop-table
+
+`:drop-table` can accept a single table name or a sequence of
+table names. If a sequence is provided and the first element
+is `:if-exists` (or the symbol `if-exists`) then that conditional
+clause is added before the table names:
+
+```clojure
+user=> (sql/format '{drop-table (if-exists foo bar)})
+["DROP TABLE IF EXISTS foo, bar"]
+user=> (sql/format {:drop-table [:foo :bar]})
+["DROP TABLE foo, bar"]
+```
+
 ## nest
 
 This is pseudo-syntax that lets you wrap a substatement

src/honey/sql.cljc

@@ -36,7 +36,10 @@
 (declare clause-format)
 (def ^:private default-clause-order
   "The (default) order for known clauses. Can have items added and removed."
-  [:nest :with :with-recursive :intersect :union :union-all :except :except-all
+  [;; DDL comes first (these don't really have a precedence):
+   :alter-table :create-table :with-columns :create-view :drop-table
+   ;; then SQL clauses in priority order:
+   :nest :with :with-recursive :intersect :union :union-all :except :except-all
    :select :select-distinct :insert-into :update :delete :delete-from :truncate
    :columns :set :from :using
    :join :left-join :right-join :inner-join :outer-join :full-join
@@ -139,7 +142,12 @@
 (defn- namespace-_ [x] (some-> (namespace x) (str/replace "-" "_")))
 (defn- name-_      [x] (str/replace (name x) "-" "_"))
 
-(defn- format-entity [x & [{:keys [aliased drop-ns]}]]
+(defn format-entity
+  "Given a simple SQL entity (a keyword or symbol -- or string),
+  return the equivalent SQL fragment (as a string -- no parameters).
+
+  Handles quoting, splitting at / or ., replacing - with _ etc."
+  [x & [{:keys [aliased drop-ns]}]]
   (let [nn    (if (or *quoted* (string? x)) name               name-_)
         q     (if (or *quoted* (string? x)) (:quote *dialect*) identity)
         [t c] (if-let [n (when-not (or drop-ns (string? x))
@@ -458,6 +466,27 @@
       [(str (sql-kw k) " " e " = EXCLUDED." e)])
     (format-set-exprs k x)))
 
+(defn- format-alter-table [k [x]] ["ALTER TABLE"])
+
+(defn- format-create-table [k table]
+  (let [[table if-not-exists] (if (sequential? table) table [table])]
+   [(str (sql-kw k) " "
+         (when if-not-exists (str (sql-kw :if-not-exists) " "))
+         (format-entity table))]))
+
+(defn- format-create-view [k x]
+  [(str (sql-kw k) " " (format-entity x) " AS")])
+
+(defn- format-drop-table
+  [k params]
+  (let [tables (if (sequential? params) params [params])
+        [if-exists & tables] (if (#{:if-exists 'if-exists} (first tables)) tables (cons nil tables))]
+   [(str (sql-kw k) " "
+         (when if-exists (str (sql-kw :if-exists) " "))
+         (str/join ", " (map #'format-entity tables)))]))
+
+(defn- format-table-columns [k [x]] ["()"])
+
 (def ^:private base-clause-order
   "The (base) order for known clauses. Can have items added and removed.
 
@@ -473,7 +502,12 @@
 (def ^:private clause-format
   "The (default) behavior for each known clause. Can also have items added
   and removed."
-  (atom {:nest            (fn [_ x] (format-expr x))
+  (atom {:alter-table     #'format-alter-table
+         :create-table    #'format-create-table
+         :with-columns    #'format-table-columns
+         :create-view     #'format-create-view
+         :drop-table      #'format-drop-table
+         :nest            (fn [_ x] (format-expr x))
          :with            #'format-with
          :with-recursive  #'format-with
          :intersect       #'format-on-set-op

src/honey/sql/helpers.cljc

@@ -43,6 +43,11 @@
     (assoc data k arg)
     (assoc {} k data)))
 
+(defn alter-table [& args] (generic :nest args))
+(defn create-table [& args] (generic :nest args))
+(defn with-columns [& args] (generic :nest args))
+(defn create-view [& args] (generic :nest args))
+(defn drop-table [& args] (generic :nest args))
 (defn nest [& args] (generic :nest args))
 (defn with [& args] (generic :with args))
 (defn with-recursive [& args] (generic :with-recursive args))

test/honey/sql/helpers_test.cljc

@@ -6,7 +6,8 @@
                :cljs [cljs.test :refer-macros [deftest is testing]])
             [honey.sql :as sql]
             [honey.sql.helpers
-             :refer [columns cross-join do-update-set from full-join
+             :refer [columns create-view
+                     cross-join do-update-set from full-join
                      group-by having insert-into
                      join left-join limit offset on-conflict order-by
                      over partition-by
@@ -278,7 +279,7 @@
                " AND (location NOT LIKE '/1/%')")]
          (stack-overflow-282 2))))
 
-(deftest issue-293
+(deftest issue-293-sql
   ;; these tests are based on the README at https://github.com/nilenso/honeysql-postgres
   (is (= (-> (insert-into :distributors)
              (values [{:did 5 :dname "Gizmo Transglobal"}
@@ -328,8 +329,24 @@
          [(str "SELECT id,"
                " AVG(salary) OVER () AS Average,"
                " MAX(salary) OVER () AS MaxSalary"
-               " FROM employee")]))
-  )
+               " FROM employee")])))
+
+(deftest issue-293-ddl
+  (is (= (sql/format {:create-view :metro :select [:*] :from [:cities] :where [:= :metroflag "y"]})
+         ["CREATE VIEW metro AS SELECT * FROM cities WHERE metroflag = ?" "y"]))
+  (is (= (sql/format {:create-table :films
+                      :with-columns []})
+         ["CREATE TABLE films ()"]))
+  (is (= (sql/format {:drop-table :foo})
+         ["DROP TABLE foo"]))
+  (is (= (sql/format {:drop-table [:if-exists :foo]})
+         ["DROP TABLE IF EXISTS foo"]))
+  (is (= (sql/format '{drop-table (if-exists foo)})
+         ["DROP TABLE IF EXISTS foo"]))
+  (is (= (sql/format {:drop-table [:foo :bar]})
+         ["DROP TABLE foo, bar"]))
+  (is (= (sql/format {:drop-table [:if-exists :foo :bar]})
+         ["DROP TABLE IF EXISTS foo, bar"])))
 
 (deftest issue-293-insert-into-data
   ;; insert into as (and other tests) based on :insert-into