luciano/honeysql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fixes #301 Fixes #306 by expanding drop/create syntax

Browse source
This commit is contained in:
Sean Corfield 2021-03-12 11:43:21 -08:00
parent 445fb08e2f
commit ddebda9481
5 changed files with 223 additions and 66 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
doc/clause-reference.md
View file

@ -120,7 +120,7 @@ constraint, `FOREIGN KEY` (with a column name), `REFERENCES`
## create-extension
## create-view
## create-view, create-materialized-view
`:create-view` accepts a single view name:

7
doc/special-syntax.md
View file

@ -60,6 +60,13 @@ expression (comma-separated, wrapped in parentheses):
;;=> ["(a, b, ?, x + ?)" "red" 1]
```
## entity
Accepts a single keyword or symbol argument and produces a
SQL entity. This is intended for use in contexts that would
otherwise produce a sequence of SQL keywords, such as when
constructing DDL statements.
## inline
Accepts a single argument and tries to render it as a

177
src/honey/sql.cljc
View file

@ -39,8 +39,10 @@
[;; DDL comes first (these don't really have a precedence):
:alter-table :add-column :drop-column :modify-column :rename-column
:add-index :drop-index :rename-table
:create-table :create-table-as :with-columns :create-view :drop-table
:create-extension :drop-extension
:create-table :create-table-as :with-columns
:create-view :create-materialized-view :create-extension
:drop-table :drop-view :drop-materialized-view :drop-extension
: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
@ -561,72 +563,110 @@
(let [e (format-entity x {:drop-ns true})]
[(str (sql-kw k) " " e " = EXCLUDED." e)])))
(defn- format-simple-clause [c]
(defn- format-simple-clause [c context]
(binding [*inline* true]
(let [[x & y] (format-dsl c)]
(when (seq y)
(throw (ex-info "column/index operations must be simple clauses"
{:clause c :params y})))
x)))
(let [[sql & params] (format-dsl c)]
(when (seq params)
(throw (ex-info (str "parameters are not accepted in " context)
{:clause c :params params})))
sql)))
(defn- format-simple-expr [e context]
(binding [*inline* true]
(let [[sql & params] (format-expr e)]
(when (seq params)
(throw (ex-info (str "parameters are not accepted in " context)
{:expr e :params params})))
sql)))
(defn- format-alter-table [k x]
(if (sequential? x)
[(str (sql-kw k) " " (format-entity (first x))
(when-let [clauses (next x)]
(str " " (str/join ", " (map #'format-simple-clause clauses)))))]
(str " " (str/join ", " (map #(format-simple-clause % "column/index operations") clauses)))))]
[(str (sql-kw k) " " (format-entity x))]))
(defn- destructure-create-item [table]
(let [coll
(defn- format-ddl-options
"Given a sequence of options for a DDL statement (the part that
comes between the entity name being created/dropped and the
remaining part of the statement), render clauses and sequences
of keywords and entity names. Returns a sequence of SQL strings."
[opts context]
(for [opt opts]
(cond (map? opt)
(format-simple-clause opt context)
(sequential? opt)
(str/join " "
(map (fn [e]
(if (ident? e)
(sql-kw e)
(format-simple-expr e context)))
opt))
:else
(sql-kw opt))))
(defn- destructure-create-item [table context]
(let [params
(if (sequential? table)
table
[table])
ine (last coll)
coll (take-while ident? params)
opts (drop-while ident? params)
ine (last coll)
[prequel table ine]
(if (= :if-not-exists (sym->kw ine))
[(butlast (butlast coll)) (last (butlast coll)) ine]
[(butlast coll) (last coll) nil])]
[(str/join " " (map sql-kw prequel))
(format-entity table)
(when ine (sql-kw ine))]))
(into [(str/join " " (map sql-kw prequel))
(format-entity table)
(when ine (sql-kw ine))]
(format-ddl-options opts context))))
(defn- format-create [k item as]
(let [[pre i ine] (destructure-create-item item)]
(defn- format-create [q k item as]
(let [[pre entity ine & more]
(destructure-create-item item (str (sql-kw q) " options"))]
[(str/join " " (remove nil?
[(sql-kw :create)
(when (seq pre) pre)
(sql-kw k)
ine
i
(when as (sql-kw as))]))]))
(-> [(sql-kw q)
(when (and (= :create q) (seq pre)) pre)
(sql-kw k)
ine
(when (and (= :refresh q) (seq pre)) pre)
entity]
(into more)
(conj (when as (sql-kw as))))))]))
(defn- format-with-data [k data]
[(str/join " " (remove nil?
[(sql-kw :with)
(when-not data (sql-kw :no))
(sql-kw :data)]))])
(defn- format-with-data [_ data]
(let [data (if (sequential? data) (first data) data)]
[(str/join " " (remove nil?
[(sql-kw :with)
(when-not data (sql-kw :no))
(sql-kw :data)]))]))
(defn- format-drop-table
(defn- destructure-drop-items [tables context]
(let [params
(if (sequential? tables)
tables
[tables])
coll (take-while ident? params)
opts (drop-while ident? params)
[if-exists & tables]
(if (#{:if-exists 'if-exists} (first coll))
coll
(cons nil coll))]
(into [(when if-exists (sql-kw :if-exists))
(str/join ", " (map #'format-entity tables))]
(format-ddl-options opts context))))
(defn- format-drop-items
[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-simple-expr [e]
(binding [*inline* true]
(let [[x & y] (format-expr e)]
(when (seq y)
(throw (ex-info "column elements must be simple expressions"
{:expr e :params y})))
x)))
(let [[if-exists tables & more] (destructure-drop-items params "DROP options")]
[(str/join " " (remove nil? (into [(sql-kw k) if-exists tables] more)))]))
(defn- format-single-column [xs]
(str/join " " (let [[id & spec] (map #'format-simple-expr xs)]
(str/join " " (let [[id & spec] (map #(format-simple-expr % "column operation") xs)]
(cons id (map upper-case spec)))))
(defn- format-table-columns [k xs]
(defn- format-table-columns [_ xs]
[(str "("
(str/join ", " (map #'format-single-column xs))
")")])
@ -661,13 +701,17 @@
:add-index (fn [_ x] (format-on-expr :add x))
:drop-index #'format-selector
:rename-table (fn [_ x] (format-selector :rename-to x))
:create-table (fn [_ x] (format-create :table x nil))
:create-table-as (fn [_ x] (format-create :table x :as))
:create-extension (fn [_ x] (format-create :extension x nil))
:create-table (fn [_ x] (format-create :create :table x nil))
:create-table-as (fn [_ x] (format-create :create :table x :as))
:create-extension (fn [_ x] (format-create :create :extension x nil))
:with-columns #'format-table-columns
:create-view (fn [_ x] (format-create :view x :as))
:drop-table #'format-drop-table
:drop-extension #'format-drop-table
:create-view (fn [_ x] (format-create :create :view x :as))
:create-materialized-view (fn [_ x] (format-create :create :materialized-view x :as))
:drop-table #'format-drop-items
:drop-extension #'format-drop-items
:drop-view #'format-drop-items
:drop-materialized-view #'format-drop-items
:refresh-materialized-view (fn [_ x] (format-create :refresh :materialized-view x nil))
:nest (fn [_ x] (format-expr x))
:with #'format-with
:with-recursive #'format-with
@ -737,9 +781,10 @@
[statement-map & [{:keys [aliased nested pretty]}]]
(let [[sqls params leftover]
(reduce (fn [[sql params leftover] k]
(if-let [xs (or (k statement-map)
(let [s (kw->sym k)]
(get statement-map s)))]
(if-some [xs (if-some [xs (k statement-map)]
xs
(let [s (kw->sym k)]
(get statement-map s)))]
(let [formatter (k @clause-format)
[sql' & params'] (formatter k xs)]
[(conj sql sql')
@ -804,22 +849,35 @@
(defn- function-0 [k xs]
[(str (sql-kw k)
(when (seq xs)
(str "(" (str/join ", " (map #'format-simple-expr xs)) ")")))])
(str "("
(str/join ", "
(map #(format-simple-expr % "column/index operation")
xs))
")")))])
(defn- function-1 [k xs]
[(str (sql-kw k)
(when (seq xs)
(str " " (format-simple-expr (first xs))
(str " " (format-simple-expr (first xs)
"column/index operation")
(when-let [args (next xs)]
(str "(" (str/join ", " (map #'format-simple-expr args)) ")")))))])
(str "("
(str/join ", "
(map #(format-simple-expr % "column/index operation")
args))
")")))))])
(defn- function-1-opt [k xs]
[(str (sql-kw k)
(when (seq xs)
(str (when-let [e (first xs)]
(str " " (format-simple-expr e)))
(str " " (format-simple-expr e "column/index operation")))
(when-let [args (next xs)]
(str "(" (str/join ", " (map #'format-simple-expr args)) ")")))))])
(str "("
(str/join ", "
(map #(format-simple-expr % "column/index operation")
args))
")")))))])
(def ^:private special-syntax
(atom
@ -840,6 +898,9 @@
:primary-key #'function-0
:references #'function-1
:unique #'function-1-opt
;; used in DDL to force rendering as a SQL entity instead
;; of a SQL keyword:
:entity (fn [_ [e]] [(format-entity e)])
:array
(fn [_ [arr]]
(let [[sqls params] (format-expr-list arr)]

31
src/honey/sql/helpers.cljc
View file

@ -65,7 +65,7 @@
(helper-merge {} k args)))
(defn- generic-1 [k [data arg]]
(if arg
(if (some? arg)
(assoc data k arg)
(assoc {} k data)))
@ -213,8 +213,19 @@
(-> (create-view :cities)
(select :*) (from :city))"
{:arglists '([view])}
[& args]
(generic-1 :create-view args))
(generic :create-view args))
(defn create-materialized-view
"Accepts a single view name to create.
(-> (create-materialized-view :cities)
(select :*) (from :city))
(with-data true)"
{:arglists '([view])}
[& args]
(generic :create-materialized-view args))
(defn drop-table
"Accepts one or more table names to drop.
@ -228,6 +239,22 @@
[& extensions]
(generic :drop-extension extensions))
(defn drop-view
"Accepts one or more view names to drop."
[& views]
(generic :drop-view views))
(defn drop-materialized-view
"Accepts one or more materialied view names to drop."
[& views]
(generic :drop-materialized-view views))
(defn refresh-materialized-view
"Accepts a materialied view name to refresh."
{:arglists '([view])}
[& views]
(generic :refresh-materialized-view views))
(defn nest
[& args]
(generic :nest args))

72
test/honey/sql/helpers_test.cljc
View file

@ -6,13 +6,15 @@
:cljs [cljs.test :refer-macros [deftest is testing]])
[honey.sql :as sql]
[honey.sql.helpers
:refer [add-column add-index alter-table columns create-table create-view
:refer [add-column add-index alter-table columns create-table create-table-as create-view
create-materialized-view drop-view drop-materialized-view
cross-join do-update-set drop-column drop-index drop-table from full-join
group-by having insert-into
join-by join left-join limit offset on-conflict order-by
over partition-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 values where window with with-columns
with-data]]))
(deftest test-select
(let [m1 (-> (with [:cte (-> (select :*)
@ -367,6 +369,54 @@
(from :cities)
(where [:= :metroflag "y"])))
["CREATE VIEW metro AS SELECT * FROM cities WHERE metroflag = ?" "y"]))
(is (= (sql/format (-> (create-table-as :metro :if-not-exists)
(select :*)
(from :cities)
(where [:= :metroflag "y"])
(with-data false)))
["CREATE TABLE IF NOT EXISTS metro AS SELECT * FROM cities WHERE metroflag = ? WITH NO DATA" "y"]))
(is (= (sql/format (-> (create-materialized-view :metro :if-not-exists)
(select :*)
(from :cities)
(where [:= :metroflag "y"])
(with-data false)))
["CREATE MATERIALIZED VIEW IF NOT EXISTS metro AS SELECT * FROM cities WHERE metroflag = ? WITH NO DATA" "y"]))
(is (= (sql/format (-> (create-table-as :metro :if-not-exists
(columns :foo :bar :baz)
[:tablespace [:entity :quux]])
(select :*)
(from :cities)
(where [:= :metroflag "y"])
(with-data false)))
[(str "CREATE TABLE IF NOT EXISTS metro"
" (foo, bar, baz) TABLESPACE quux"
" AS SELECT * FROM cities WHERE metroflag = ? WITH NO DATA") "y"]))
(is (= (sql/format (-> (create-materialized-view :metro :if-not-exists
(columns :foo :bar :baz)
[:tablespace [:entity :quux]])
(select :*)
(from :cities)
(where [:= :metroflag "y"])
(with-data false)))
[(str "CREATE MATERIALIZED VIEW IF NOT EXISTS metro"
" (foo, bar, baz) TABLESPACE quux"
" AS SELECT * FROM cities WHERE metroflag = ? WITH NO DATA") "y"]))
(is (= (sql/format {:create-materialized-view [:metro :if-not-exists]
:select [:*]
:from :cities
:where [:= :metroflag "y"]
:with-data true})
["CREATE MATERIALIZED VIEW IF NOT EXISTS metro AS SELECT * FROM cities WHERE metroflag = ? WITH DATA" "y"]))
(is (= (sql/format {:create-materialized-view [:metro :if-not-exists
(columns :foo :bar :baz)
[:tablespace [:entity :quux]]]
:select [:*]
:from :cities
:where [:= :metroflag "y"]
:with-data false})
[(str "CREATE MATERIALIZED VIEW IF NOT EXISTS metro"
" (foo, bar, baz) TABLESPACE quux"
" AS SELECT * FROM cities WHERE metroflag = ? WITH NO DATA") "y"]))
(is (= (sql/format (-> (create-table :films)
(with-columns
[:id :int :unsigned :auto-increment]
@ -391,20 +441,32 @@
["DROP TABLE foo"]))
(is (= (sql/format {:drop-table [:if-exists :foo]})
["DROP TABLE IF EXISTS foo"]))
(is (= (sql/format {:drop-view [:if-exists :foo]})
["DROP VIEW IF EXISTS foo"]))
(is (= (sql/format {:drop-materialized-view [:if-exists :foo]})
["DROP MATERIALIZED VIEW IF EXISTS foo"]))
(is (= (sql/format {:refresh-materialized-view [:concurrently :foo]
:with-data true})
["REFRESH MATERIALIZED VIEW CONCURRENTLY foo WITH DATA"]))
(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"]))
(is (= (sql/format {:drop-table [:if-exists :foo :bar [:cascade]]})
["DROP TABLE IF EXISTS foo, bar CASCADE"]))
(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 (-> (refresh-materialized-view :concurrently :foo)
(with-data true)))
["REFRESH MATERIALIZED VIEW CONCURRENTLY foo WITH DATA"]))
(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"])))
(is (= (sql/format (drop-table :if-exists :foo :bar [:cascade]))
["DROP TABLE IF EXISTS foo, bar CASCADE"])))
(deftest issue-293-alter-table
(is (= (sql/format (-> (alter-table :fruit)