diff options
| -rw-r--r-- | src/clojure_sql/dsl.clj | 269 |
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))) |