Rename sort-by, add grouping, refactor+fix some join stuff

`sort-by` is now called `sort`. This is just because I think it makes more
sense and nothing more.

Grouping has been added with `group` and `having`. They behave as you'd expect
from SQL, except that joining with a table which has a `group` or `having`
clause will move that query in as a subquery. I wasn't sure how else to ensure
their composition, so this way maintains the semantics (which is the most
important part) at the potential cost of some efficiency in performing the
query. I'm not sure that there exists a more general solution. I would assume
not.

The join stuff has been fixed a bit (some valid renames were rejected as
invalid) and standardised a bit (exceptions are now more similar). A bunch of
things have been added to the join stuff as a result of the above grouping
things, too. A bunch of changes all around, basically.

The compiler has also had a few small changes made to it, and has been enhanced
to support the grouping stuff.

2 files changed, 281 insertions, 122 deletions

diff --git a/src/clojure_sql/compiler.clj b/src/clojure_sql/compiler.clj
index 6f940c0..60a5530 100644
--- a/src/clojure_sql/compiler.clj
+++ b/src/clojure_sql/compiler.clj
@@ -50,18 +50,27 @@
 ;; ==============================================================
 
 ;; compile-* multimethods are of the signature:
-;;  (db, expr) -> (fn [s] [sql])
+;;  (db, expr) -> [args] -> [sql & args]
 
 (declare compile-query compile-expression)
 
-(defmulti compile-expression-sequential (fn [db ex]))
+(defmulti compile-expression-list (fn [db _] db))
+(defmethod compile-expression-list :default [db ex]
+  (->> (map (partial compile-expression db) ex)
+       (apply sequence)
+       ((p-lift string/join ","))
+       $add-parentheses))
+
+(defmulti compile-expression-sequential (fn [db _] db))
 (defmethod compile-expression-sequential :default [db ex]
   (let [compile-exprs #(map (partial compile-expression db) %)
         op (name (first ex))
         num-args (dec (count ex))]
     (-> (condp u/funcall (first ex)
           quote?    (do (assert (= num-args 1) "`quote` must only take one argument")
-                        (>> (tell (second ex)) (return "?")))
+                        (if (sequential? (second ex))
+                          (compile-expression-list db (second ex))
+                          (>> (tell (second ex)) (return "?"))))
           unary?    (do (assert (= num-args 1) (str "Unary operator `" op "` must take one argument"))
                         (do-m :let [exprs (compile-exprs ex)]
                               vals <- (apply sequence exprs)
@@ -120,28 +129,33 @@
 
 (def ^:private join-type-names
   {:inner "INNER"
-   :left "LEFT OUTER"
-   :right "RIGHT OUTER"
-   :outer "FULL OUTER"
+   :outer "LEFT OUTER"
+   :full-outer "FULL OUTER"
    :cross "CROSS"})
 
 (defmulti compile-tables (fn [db _ _] db))
-(defmethod compile-tables :default [db join tables-map]
-  (if (vector? join)
+(defmethod compile-tables :default [db join tables-map] 
+  (if (vector? join) 
     (->> (for [table-alias join]
            (make-table-name db (get tables-map table-alias) table-alias))
          (apply sequence)
          ((p-lift string/join ", ")))
     (let [{:keys [left right type on]} join]
-      ($str (return "(") 
-            (compile-tables db left tables-map)
-            (return (str " " (get join-type-names type (name type)) " JOIN "))
-            (compile-tables db right tables-map) 
-            (if on
-              ($str (return " ON ")
-                    (compile-expression db on))
-              (return ""))
-            (return ")")))))
+      (if (= type :cross)
+        ($str (return "(")
+              (compile-tables db left tables-map)
+              (return " CROSS JOIN ")
+              (compile-tables db right tables-map)
+              (return ")"))
+        ($str (return "(") 
+              (compile-tables db left tables-map)
+              (return (str " " (get join-type-names type (name type)) " JOIN "))
+              (compile-tables db right tables-map) 
+              (return " ON ")
+              (if on
+                (compile-expression db on)
+                (return "TRUE"))
+              (return ")"))))))
 
 (defmulti compile-where (fn [db _] db))
 (defmethod compile-where :default [db expr]
@@ -149,8 +163,8 @@
     ($str (return " WHERE ") (compile-expression db expr))
     (return nil)))
 
-(defmulti compile-sort-by (fn [db _] db))
-(defmethod compile-sort-by :default [db fields]
+(defmulti compile-sort (fn [db _] db))
+(defmethod compile-sort :default [db fields]
   (if fields
     (->> (for [[[table field] dir] fields]
            ($str (make-field-name db [table field])
@@ -160,8 +174,24 @@
          ($str (return " ORDER BY ")))
     (return nil)))
 
+(defmulti compile-group (fn [db _] db))
+(defmethod compile-group :default [db fields]
+  (if fields
+    (->> (for [[table field] fields]
+           (make-field-name db [table field]))
+         (apply sequence)
+         ((p-lift string/join ","))
+         ($str (return " GROUP BY ")))
+    (return nil)))
+
+(defmulti compile-having (fn [db _] db))
+(defmethod compile-having :default [db expr]
+  (if expr
+    ($str (return " HAVING ") (compile-expression db expr))
+    (return nil)))
+
 (defmulti compile-query (fn [db _] db))
-(defmethod compile-query :default [db {:keys [tables fields joins where sort-by]}]
+(defmethod compile-query :default [db {:keys [tables fields joins where sort group having]}]
   ($str (return "SELECT ")
         (compile-fields db fields)
         (if tables
@@ -169,7 +199,9 @@
                 (compile-tables db joins tables))
           ($str ""))
         (compile-where db where)
-        (compile-sort-by db sort-by)))
+        (compile-group db group)
+        (compile-having db having)
+        (compile-sort db sort)))
 
 
 
diff --git a/src/clojure_sql/dsl.clj b/src/clojure_sql/dsl.clj
index 6f01198..a31a913 100644
--- a/src/clojure_sql/dsl.clj
+++ b/src/clojure_sql/dsl.clj
@@ -1,5 +1,5 @@
 (ns clojure-sql.dsl
-  (:refer-clojure :exclude [sort-by])
+  (:refer-clojure :exclude [sort group])
   (:require [clojure.set :as set]
             [clojure.walk :as walk]
             [clojure-sql.query :as q]
@@ -14,40 +14,82 @@
 ;;   -PROJECTION-
 ;;   -TABLES-
 ;;   -FILTERS-
-;;   GROUPING
-;;   GROUPED FILTERS
 ;;   -SORTING-
+;;   -GROUPING-
+;;   -GROUPED FILTERS-
+
 
 ;; {
 ;;  :tables => tablename -> table_alias
 ;;  :fields => (table_alias, fieldname) -> field_alias
 ;;  :joins => [left-table type right-table on?]
 ;;  :where => expression
-;;  :sort-by => [(field, direction)]
+;;  :sort => [(field, direction)]
+;;  :group => [field]
+;;  :having => expression
 ;; }
 
-(defn table [arg]
-  (into (q/->Query)
-        (if (map? arg)
-          {:tables (u/flip-map arg)
-           :joins (vec (vals arg))}
-          {:tables {arg arg}
-           :joins [arg]})))
-
 (defn ^:private ambiguous-error [field & [query]]
   (throw (ex-info (str "Ambiguous field " field " in query with more than one table")
                   {:field field
                    :query query})))
 
+(defn ^:private same-rename-error [alias renames & [query]]
+  (throw (ex-info (str "Cannot rename two fields to the same alias: " alias)
+                  {:alias alias
+                   :renames renames
+                   :query query})))
+
+(defn ^:private missing-rename-error [field renames & [query]]
+  (throw (ex-info (str "Cannot rename field not present in query: " field)
+                  {:field field
+                   :query query
+                   :renames renames})))
+
+(defn ^:private common-fields-error [left right common-fields]
+  (throw (ex-info "Cannot join with common fields unless natural join"
+                  {:left left
+                   :right right
+                   :common-fields common-fields})))
+
+(defn ^:private cross-join-duplicate-fields [common-fields left right]
+  (throw (ex-info "Cross join will introduce ambiguous duplicate fields"
+                  {:left left
+                   :right right
+                   :common-fields common-fields})))
+
+(defn ^:private cross-join-condition-error [condition left right]
+  (throw (ex-info "Cannot have a cross join with condition (maybe you wanted either a selection or an inner join)"
+                  {:left left
+                   :right right
+                   :condition condition})))
+
+(defn ^:private invalid-join-type [type left right]
+  (throw (ex-info (str "Invalid join type: " type)
+                  {:left left
+                   :right right
+                   :type type })))
+
+(defn table [arg]
+  (into (q/->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 (field-alias-lookup field)
+    (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 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))
@@ -56,43 +98,54 @@
   (let [table (if (= (count (:tables query)) 1)
                 (-> query :tables first key))
         alias-lookup (or (:fields query) {})
-        get-real-name #(resolve-field table alias-lookup %)]
+        get-real-name #(resolve-fields table alias-lookup %)
+        fields (if (map? fields)
+                 fields
+                 (zipmap fields fields))]
     (assoc query
-      :fields (->> (for [[old-name new-name] (if (map? fields)
-                                               fields
-                                               (zipmap fields fields))]
-                     [new-name (get-real-name old-name)])
-                   (into {})))))
+      :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 rename [query field-renames]
-  {:pre [(map? field-renames)
-         ;; the intersection of the new aliases with the old aliases NOT renamed by this operation
-         (empty? (set/intersection (set (vals field-renames))
+(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))))
+
+(defn ^:private rename-with-map [query field-renames]
+  {:pre [;; the intersection of the new aliases with the old aliases NOT renamed by this operation
+         #_(empty? (set/intersection (set (vals field-renames))
                                    (set/difference (set (keys (:fields query)))
                                                    (set (keys field-renames)))))]}
-  (let [fields (:fields query)
-        alias-lookup (or (:fields query) {}) 
-        fields-to-remove (set/difference (set (keys field-renames))
-                                         (set (vals field-renames)))
-        original-name (fn [field]
-                        (cond (vector? field) field
-                              (contains? alias-lookup field) (get alias-lookup field)
-                              :else (throw (ex-info (str "Cannot rename field " (pr-str field) ". Field does not exist in query.")
-                                                    {:field field
-                                                     :query query
-                                                     :renames field-renames})))
-                        (get alias-lookup field))
-        ;; do the renaming we want here:
-        fields (->> (for [[key val] field-renames]
-                      [val (original-name key)]) 
-                    (into fields))
-        ;; remove the things we no longer have here:
-        fields (->> (remove (comp fields-to-remove key) fields)
-                    (into {}))]
-    (assoc query :fields fields)))
-
-
-(defn ^:private combine-wheres [& wheres]
+  (doseq [[field alias] field-renames]
+    (if-not (contains? (:fields query) field)
+      (missing-rename-error field field-renames query)))
+  (rename-with-fn query field-renames))
+
+(defn rename [query field-renames]
+  (if (map? field-renames)
+    (rename-with-map query field-renames)
+    (rename-with-fn query field-renames)))
+
+(defn prefix-names-matching [pred prefix]
+  (fn [alias]
+    (if (pred alias)
+      (keyword (str prefix (name alias)))
+      alias)))
+
+(defn prefix-names [prefix]
+  (prefix-names-matching (constantly true) prefix))
+
+
+
+(defn ^:private combine-conjunctions [& wheres]
   (reduce (fn [acc where]
             (cond (nil? acc) where
                   (nil? where) acc
@@ -105,71 +158,145 @@
                             `(and ~acc ~where))))
           nil wheres))
 
+(defn ^:private joinable? [query] 
+  (and (nil? (:group query))
+       (nil? (:having query))))
+(defn ^:private convert-to-subquery [query]
+  (-> (table query)
+      (project (keys (:fields query)))))
+
+(def ^:private valid-join-type? (comp boolean #{:cross :inner :outer :full-outer}))
 (defn join [left right & {:keys [on type]}]
-  (let [common-tables (set/intersection (set (keys (:tables left)))
-                                        (set (keys (:tables right))))
-        ;;_ (assert (empty? common-tables) "Cannot join two tables with the same name")
-        merged-tables (merge (:tables left) (:tables right))
-        common-fields (set/intersection (set (keys (:fields left)))
-                                        (set (keys (:fields right))))
-        merged-fields (merge (:fields left) (:fields right))
-        join-condition (cond
-                        (nil? on) (let [implicit (map (fn [field]
-                                                        `(~'=
-                                                          ~(resolve-field (:table left) (:fields left) field)
-                                                          ~(resolve-field (:table right) (: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) (throw (ex-info "Cannot join with common fields unless natural join"
-                                                            {:left left
-                                                             :right right
-                                                             :common-fields common-fields}))
-                        :else (process-expression nil merged-fields on))
-        type (or type
-                 (if join-condition :inner)
-                 :cross)] 
-    (-> left
-        (assoc :fields merged-fields
-               :tables merged-tables
-               :joins {:left (:joins left)
-                       :right (:joins right)
-                       :type type
-                       :on join-condition}
-               :where (combine-wheres (:where left)
-                                      (:where right))))))
+  (if (= type :right)
+    (join right left :on on :type :left)
+    (let [type (if (= type :left)
+                 :outer
+                 type)
+          left (if (joinable? left)
+                 left
+                 (convert-to-subquery left))
+          right (if (joinable? right)
+                  right
+                  (convert-to-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))
+                                        ;_ (assert (empty? common-tables) "Cannot join two tables with the same name")
+          merged-tables (merge (:tables left) (:tables right))
+          common-fields (set/intersection (set (keys (:fields left)))
+                                          (set (keys (:fields right))))
+          merged-fields (merge (:fields left) (:fields right))
+          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))))))))
 
 (defn select [query expression]
   (let [table-name (if (= (count (:tables query)) 1)
                      (-> query :tables first key))
         old-where (:where query)
         resolved-expression (process-expression table-name (:fields query) expression)
-        new-where (combine-wheres old-where resolved-expression)]
+        new-where (combine-conjunctions old-where resolved-expression)]
     (assoc query :where new-where)))
 
-(defn sort-by [query fields]
+(defn sort [query fields]
   (let [table-name (if (= (count (:tables query)) 1)
                      (-> query :tables first key))
         fields-seq (if (sequential? fields)
                      fields
-                     [fields])]
+                     [fields])
+        fields-lookup (or (:fields query) {})]
     (assoc query
-      :sort-by (for [field fields-seq]
-                 (if (vector? field)
-                   [(resolve-field table-name (:fields query) (first field)) (second field)]
-                   [(resolve-field table-name (:fields query) field) :asc])))))
-
-
-(let [id 10]
-  (-> (table {:x :carlo-table})
-      (project [:x])
-      (select `(and (in :x [1 2 3 :y])
-                    (= :x ~id)))
-      (join (-> (table :y)
-                (project [:y]))
-            :on `(= :x :y)
-            :type :left)
-      (join (-> (table :z)
-                (project [:x])))
-      (sort-by [[:x :desc]])))
+      :sort (for [field fields-seq]
+              (if (vector? field)
+                [(resolve-field table-name fields-lookup (first field)) (second field)]
+                [(resolve-field table-name fields-lookup field) :asc])))))
+
+(defn group [query fields]
+  (let [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-seq))))
+
+(defn having [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)
+        new-having (combine-conjunctions old-having resolved-expression)]
+    (assoc query :having new-having)))
+
+(-> (table :x)
+    (project [:x])
+    (join (-> (table :y)
+              (select `(= :id 10)))
+          :type :right))
+
+(let [users (-> (table :users)
+                (project [:id]))]
+  (join users users))
+
+(-> (table :x)
+    (project [:x])
+    (join (-> (table :y)
+              #_(select `(= :id 10)))
+          :type :full-outer))
+
+(-> (table :x)
+    (project [:x])
+    (join (-> (table :y)
+              (project [:x]))))
+
+#_(-> (table :x)
+    (project [:x])
+    (rename {:y :z}))
+
+(-> (table :x)
+    (project [:x])
+    (rename {:x :y}))
+
+(-> (table :people)
+    (project '{(count *) :count})
+    (group [:age])
+    (sort [:age])
+    (join (-> (table :number-count)
+              (project [:number :text])
+              (sort [:number]))
+          :on `(= :count :number))
+    (project [:text])
+    println)