A bunch of refactoring in the DSL

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)))