summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/clojure_sql/dsl.clj269
1 files changed, 123 insertions, 146 deletions
diff --git a/src/clojure_sql/dsl.clj b/src/clojure_sql/dsl.clj
index 13319f3..e33bbfb 100644
--- a/src/clojure_sql/dsl.clj
+++ b/src/clojure_sql/dsl.clj
@@ -65,64 +65,45 @@
(throw (ex-info "Cannot union queries with different fields"
{:queries queries})))
-(defn table
- "Create a query on a database table. If `arg` is itself a query it
- will be wrapped, otherwise `arg` will be used as the table name."
- [arg]
- (q/map->Query (let [alias (keyword (gensym (if (u/named? arg)
- (name arg)
- "table")))]
- {:tables {alias arg}
- :joins [alias]})))
(defn ^:private rename-table [query from to]
(q/map->Query (walk/prewalk-replace {from to} (into {} query))))
-(defn ^:private resolve-field [table aliases field]
- (let [field-alias-lookup aliases]
- (or (and field-alias-lookup (field-alias-lookup field))
- (if table
- [table field]
- (ambiguous-error field)))))
-
-(defn ^:private process-expression [table aliases expression]
- (cond (vector? expression) (list 'quote (mapv (partial process-expression table aliases) expression))
- (sequential? expression) (map (partial process-expression table aliases) expression)
- (keyword? expression) (resolve-field table aliases expression)
- :else expression))
+(defn ^:private resolve-field [tables aliases field]
+ (or (and aliases (aliases field))
+ (if (= (count tables) 1)
+ [(key (first tables)) field]
+ (ambiguous-error field))))
-(defn project
- "Limit a query's fields to a specified set of fields. `fields` can
- be either a seq of allowed field names, or a map of field names to
- aliases.
+(defn ^:private process-expression [tables aliases expression]
+ (cond (vector? expression) (list 'quote (mapv (partial process-expression tables aliases) expression))
+ (sequential? expression) (map (partial process-expression tables aliases) expression)
+ (keyword? expression) (resolve-field tables aliases expression)
+ :else expression))
- If the query is currently on a single table then any unknown fields
- will be resolved as columns in that table. If the query is on more
- than one table then an exception will be thrown for unknown fields."
- [query fields]
- (let [table (if (= (count (:tables query)) 1)
- (-> query :tables first key))
- alias-lookup (or (:fields query) {})
- get-real-name #(process-expression table alias-lookup %)
- fields (if (map? fields)
- fields
- (zipmap fields fields))]
- (assoc query
- :fields (reduce (fn [fields [field alias]]
- (if (contains? fields alias)
- (same-rename-error alias fields query)
- (assoc fields alias (get-real-name field))))
- {} fields))))
+(defn table
+ "Create a query on a database table. If `table` is itself a query it
+ will be wrapped, otherwise `table` will be used as the table name."
+ [table]
+ (q/map->Query (let [name (if (u/named? table) table "table")]
+ {:tables {name table}
+ :joins [name]})))
+
+(defn ^:private into-map-duplicate-error [coll error-fn]
+ (reduce (fn [acc [k v]]
+ (if (contains? acc k)
+ (error-fn k v)
+ (assoc acc k v)))
+ {} coll))
(defn ^:private rename-with-fn [query field-renames]
- (update-in query [:fields]
- (fn [fields]
- (reduce (fn [fields [old-alias field]]
- (let [new-alias (or (field-renames old-alias) old-alias)]
- (if (contains? fields new-alias)
- (same-rename-error new-alias field-renames query)
- (assoc fields new-alias field))))
- {} fields))))
+ (let [new-name #(or (field-renames %) %)
+ new-fields (map (fn [[alias field]]
+ [(new-name alias) field])
+ (:fields query))
+ error-fn (fn [k _] (same-rename-error k field-renames query))]
+ (assoc query
+ :fields (into-map-duplicate-error new-fields error-fn))))
(defn ^:private rename-with-map [query field-renames]
(doseq [[field alias] field-renames]
@@ -145,6 +126,25 @@
(rename-with-map query field-renames)
(rename-with-fn query field-renames)))
+(defn project
+ "Limit a query's fields to a specified set of fields. `fields` can
+ be either a seq of allowed field names, or a map of field names to
+ aliases.
+
+ If the query is currently on a single table then any unknown fields
+ will be resolved as columns in that table. If the query is on more
+ than one table then an exception will be thrown for unknown fields."
+ [query fields]
+ (if (map? fields)
+ (-> (project query (keys fields))
+ (rename-with-map fields))
+ (let [get-real-name #(process-expression (:tables query) (:fields query) %)
+ query (assoc query
+ :fields (->> fields
+ (map (juxt identity get-real-name))
+ (into {})))]
+ query)))
+
(defn prefix-names-matching
"Higher-order helper function to use with `rename`."
[pred prefix]
@@ -155,30 +155,34 @@
(defn prefix-names
"Higher-order helper function to use with `rename`."
- [prefix]
- (prefix-names-matching (constantly true) prefix))
+ [prefix] (prefix-names-matching (constantly true) prefix))
(defn as-subobject
"Prefix all field names with \"{key}.\" to use them as sub-objects
in the final result. Can also be useful to disambiguate fields for
joins in a regular and predictable manner."
- [key]
- (prefix-names (str (name key) \.)))
+ [key] (prefix-names (str (name key) \.)))
+
+(defn ^:private conjunction? [clause]
+ (or (nil? clause)
+ (and (sequential? clause)
+ (= (name (first clause)) "and"))))
+(defn ^:private clean-conjunction [clause]
+ (if (conjunction? clause)
+ (next clause)
+ [clause]))
(defn ^:private combine-conjunctions [& wheres]
- (reduce (fn [acc where]
- (cond (nil? acc) where
- (nil? where) acc
- :else (or (if (and (sequential? where)
- (= (name (first where)) "and"))
- `(and ~acc ~@(next where)))
- (if (and (sequential? acc)
- (= (name (first acc)) "and"))
- `(and ~@(next acc) ~where))
- `(and ~acc ~where))))
- nil wheres))
+ (let [conjunction (reduce (fn [acc where]
+ `(and ~@(clean-conjunction acc)
+ ~@(clean-conjunction where)))
+ nil wheres)]
+ (case (count conjunction)
+ 1 nil
+ 2 (second conjunction)
+ (seq conjunction))))
(defn ^:private joinable? [query]
(and (nil? (:group query))
@@ -195,11 +199,15 @@
(dissoc query :sort))
(defn ^:private make-join-subquery [query]
- (if (joinable? query)
- query
- (if (or (:take query) (:drop query))
- (convert-to-subquery query)
- (convert-to-subquery (remove-sort query)))))
+ (cond (joinable? query) query
+ (:take query) (convert-to-subquery query)
+ (:drop query) (convert-to-subquery query)
+ :else (convert-to-subquery (remove-sort query))))
+
+(defn ^:private rename-all-tables [query]
+ (reduce (fn [query [alias table]]
+ (rename-table query alias (keyword (gensym "table"))))
+ query (:tables query)))
(def ^:private valid-join-type? (comp boolean #{:cross :inner :outer :full-outer}))
(defn join
@@ -209,62 +217,45 @@
If `type` is not provided then the join type will be automatically
set: if the arguments have any fields in common, or if an `on` is
provided, then an inner join will be performed (joining on common
- attributes if no `on` is provided), otherwise a cross join will be
+ fields if no `on` is provided), otherwise a cross join will be
performed.
Valid join types are :cross, :inner, :outer and :full-outer. An
outer join is considered a LEFT outer join. To achieve a right outer
join reverse the query arguments."
[left right & {:keys [on type]}]
- (if (= type :right)
- (join right left :on on :type :left)
- (let [type (if (= type :left)
- :outer
- type)
- left (make-join-subquery left)
- right (make-join-subquery right)
- common-tables (set/intersection (set (keys (:tables left)))
- (set (keys (:tables right))))
- right (reduce (fn [query [alias table]]
- (rename-table query alias (keyword (gensym (name table)))))
- right (:tables right))
- merged-tables (merge (:tables left) (:tables right))
- common-fields (set/intersection (set (keys (:fields left)))
- (set (keys (:fields right))))
- merged-fields (merge (:fields right) (:fields left)) ;; favour the left name for outer joins
- join-condition (cond
- (nil? on) (let [implicit (map (fn [field]
- `(~'=
- ~(resolve-field (:table left) (or (:fields left) {}) field)
- ~(resolve-field (:table right) (or (:fields right) {}) field)))
- common-fields)]
- (if (next implicit)
- (seq (cons `and implicit)) ;; more than one, so add an "and" around them
- (first implicit)))
- (seq common-fields) (common-fields-error left right common-fields)
- :else (process-expression nil merged-fields on))
- type (or type
- (if join-condition :inner)
- :cross)
- [join-condition where] (if (contains? #{:outer :full-outer} type)
- [(combine-conjunctions (:where right) join-condition) (:where left)]
- [join-condition (combine-conjunctions (:where left) (:where right))])]
- (if-not (valid-join-type? type)
- (throw (invalid-join-type type left right)))
- (if (and (= type :cross) join-condition)
- (if (seq common-fields)
- (cross-join-duplicate-fields common-fields left right)
- (cross-join-condition-error join-condition left right)))
- (-> left
- (assoc :fields merged-fields
- :tables merged-tables
- :joins {:left (:joins left)
- :right (:joins right)
- :type type
- :on join-condition}
- :where where
- :sort (seq (concat (:sort left)
- (:sort right))))))))
+ (let [left (make-join-subquery left)
+ right (rename-all-tables (make-join-subquery right))
+ merged-tables (merge (:tables left) (:tables right))
+ common-fields (set/intersection (set (keys (:fields left)))
+ (set (keys (:fields right))))
+ merged-fields (merge (:fields right) (:fields left)) ;; favour the left name for outer joins
+ join-condition (cond
+ (nil? on) (->> common-fields
+ (map (fn [field] `(= ~(resolve-field (:tables left) (:fields left) field)
+ ~(resolve-field (:tables right) (:fields right) field))))
+ (reduce combine-conjunctions))
+ (seq common-fields) (common-fields-error left right common-fields)
+ :else (process-expression merged-tables merged-fields on))
+ type (or type (if join-condition :inner :cross))
+ [join-condition where] (if (or (= type :outer) (= type :full-outer))
+ [(combine-conjunctions (:where right) join-condition) (:where left)]
+ [join-condition (combine-conjunctions (:where left) (:where right))])]
+ (cond
+ (not (valid-join-type? type)) (invalid-join-type type left right)
+ (and (= type :cross) join-condition) (if (seq common-fields)
+ (cross-join-duplicate-fields common-fields left right)
+ (cross-join-condition-error join-condition left right))
+ :else (assoc left
+ :fields merged-fields
+ :tables merged-tables
+ :joins {:left (:joins left)
+ :right (:joins right)
+ :type type
+ :on join-condition}
+ :where where
+ :sort (seq (concat (:sort left)
+ (:sort right)))))))
(defn select
"Apply a filter to a query. The expression is an unevaluated
@@ -282,17 +273,11 @@
(select query {:id 10}) - equivalent to the above
(select query `(in :id '(1 2 3)) - filter for an id of 1, 2 or 3"
[query expression]
- (let [table-name (if (= (count (:tables query)) 1)
- (-> query :tables first key))
- old-where (:where query)
- resolved-expression (->> (if (map? expression)
- (->> (for [[key val] expression]
- `(= ~key ~val))
- (reduce combine-conjunctions))
- expression)
- (process-expression table-name (:fields query)))
- new-where (combine-conjunctions old-where resolved-expression)]
- (assoc query :where new-where)))
+ (let [expression (if (map? expression)
+ (reduce combine-conjunctions
+ (map #(cons '= %) expression)))
+ resolved-expression (process-expression (:tables query) (:fields query) expression)]
+ (update-in query [:where] combine-conjunctions resolved-expression)))
(defn sort
"Apply a sort to a query. Replaces any existing sort on the
@@ -309,17 +294,14 @@
(let [query (if (or (:take query) (:drop query))
(convert-to-subquery query)
query)
- table-name (if (= (count (:tables query)) 1)
- (-> query :tables first key))
fields-seq (if (sequential? fields)
fields
- [fields])
- fields-lookup (or (:fields query) {})]
+ [fields])]
(assoc query
:sort (for [field fields-seq]
(if (vector? field)
- [(process-expression table-name fields-lookup (first field)) (second field)]
- [(process-expression table-name fields-lookup field) :asc])))))
+ [(process-expression (:tables query) (:fields query) (first field)) (second field)]
+ [(process-expression (:tables query) (:fields query) field) :asc])))))
(defn group
"Apply a grouping to a query.
@@ -332,13 +314,10 @@
(let [query (if (:group query)
(convert-to-subquery query)
query)
- table-name (if (= (count (:tables query)) 1)
- (-> query :tables first key))
fields-seq (if (sequential? fields)
fields
- [fields])
- fields-lookup (or (:fields query) {})]
- (assoc query :group (map (partial resolve-field table-name fields-lookup)
+ [fields])]
+ (assoc query :group (map (partial resolve-field (:tables query) (:fields query))
fields-seq))))
(defn having
@@ -352,10 +331,8 @@
(having query `(< (sum :age) 100)) - select groups with a combined
age under 100"
[query expression]
- (let [table-name (if (= (count (:tables query)) 1)
- (-> query :tables first key))
- old-having (:having query)
- resolved-expression (process-expression table-name (:fields query) expression)
+ (let [old-having (:having query)
+ resolved-expression (process-expression (:tables query) (:fields query) expression)
new-having (combine-conjunctions old-having resolved-expression)]
(assoc query :having new-having)))