Fix query printing, operators, make joins better (also implicit on clause)

Queries now print out their `compile-query` output when they are printed,
rather than complaining about `print-method`. This is completely a better idea,
so whoo!

Operators now compile more nicely, and SQL functions can be used too. So stuff
like (substring :name 1 3) will work for getting the first three letters of the
:name field.

Joins now handle outer stuff more nicely, and compile to "INNER JOIN" rather
than just "JOIN" (they're the same in SQL, but this makes the intent more
clear). Additionally, joins now automatically add an equality constraint to
fields which are aliased the same. So if two relations have shared fields then
(join rel1 rel2) will give the natural join of the two relations (an on clause
can still be provided, but it will be put in a conjunction with the implicit
one). If the implicit on is generated for an OUTER join then the duplicate
field which cannot be NULL is the one which will be selected (for INNER joins,
or joins without an implicit on, there is no ambiguity).

1 files changed, 136 insertions, 50 deletions

diff --git a/src/clojure_sql/core.clj b/src/clojure_sql/core.clj
index 43e5089..89d218e 100644
--- a/src/clojure_sql/core.clj
+++ b/src/clojure_sql/core.clj
@@ -19,6 +19,9 @@
 (defrecord ^:private Query []
   clojure.lang.IDeref
   (deref [this] (*query-deref-behaviour* this)))
+(defmethod print-method Query [query writer]
+  (binding [*out* writer]
+    (pr (compile-query nil query))))
 
 
 
@@ -26,6 +29,10 @@
 (defn add-parentheses [s]
   (str \( s \)))
 
+;; ==============================================================
+;; DB specific escaping methods
+;; ==============================================================
+
 (defmulti field-name (fn [db _] db))
 (defmethod field-name :default [_ field]
   (str \" (name field) \"))
@@ -34,13 +41,24 @@
 (defmethod table-name :default [_ table]
   (str \" (name table) \"))
 
+(defmulti function-name (fn [db _] db))
+(defmethod function-name :default [_ function]
+  (str \" (name function) \"))
+
+
+
 
 
+;; ==============================================================
+;; Utility functions for the compile-* functions
+;; ==============================================================
+
 ;; compile-* multimethods are of the signature:
 ;;  (db, expr) -> [SQL & replacements]
 
-(def is-unary? (comp boolean '#{not}))
-(def is-predicate? (comp boolean '#{= < > <= >= is in}))
+(def is-unary? (comp boolean '#{"not"} name))
+(def is-binary? (comp boolean '#{"=" "<" ">" "<=" ">=" "is" "in" "+" "-" "/" "*"} name))
+(def is-operator? (comp boolean '#{"and" "or"} name))
 
 (defn c-return [val] [val])
 (defn c-lift [f & orig-args]
@@ -56,6 +74,12 @@
                      (apply concat (map rest args)))))
 (def c-add-parentheses (c-lift add-parentheses))
 
+
+
+;; ==============================================================
+;; compile-* functions (turning a map into a query string)
+;; ==============================================================
+
 (defmulti compile-expression (fn [db _] db))
 (defmethod compile-expression :default [db ex]
   (condp #(%1 %2) ex
@@ -64,14 +88,31 @@
     keyword? (c-return (field-name db ex))
     string? ["?" ex] ;;(sql-string db ex)
     symbol? (c-return (string/upper-case (name ex)))
-    sequential? (-> (if (= (count ex) 2)
-                      (->> ex
-                           (map (partial compile-expression db))
-                           (c-join " "))
+    sequential? (-> (condp #(%1 %2) (first  ex)
+                      is-unary? (if (= (count ex) 2)
+                                  (->> ex
+                                       (map (partial compile-expression db))
+                                       (c-join " "))
+                                  (throw (ex-info "Unary operators can only take one argument."
+                                                  {:operator (first ex)
+                                                   :arguments (rest ex)})))
+                      is-binary? (if (= (count ex) 3)
+                                   (->> (rest ex)
+                                        (map (partial compile-expression db))
+                                        (interpose (compile-expression db (first ex)))
+                                        (c-join " "))
+                                   (throw (ex-info "Binary operators must take two arguments."
+                                                   {:operator (first ex)
+                                                    :arguments (rest ex)})))
+                      is-operator? (->> (rest ex)
+                                        (map (partial compile-expression db))
+                                        (interpose (compile-expression db (first ex)))
+                                        (c-join " "))
                       (->> (rest ex)
                            (map (partial compile-expression db))
-                           (interpose (compile-expression db (first ex)))
-                           (c-join " ")))
+                           (c-join ", ")
+                           c-add-parentheses
+                           (c-str (c-return (function-name db (first ex))))))
                     c-add-parentheses)
     (c-return ex)))
 
@@ -104,9 +145,9 @@
 (defmulti compile-join (fn [db _] db))
 (defmethod compile-join :default [db [type table-map on]]
   (c-str (c-return (case type
-                     :left " LEFT OUTER "
-                     :right " RIGHT OUTER "
-                     ""))
+                     :left " LEFT OUTER"
+                     :right " RIGHT OUTER"
+                     " INNER"))
          (c-return " JOIN ")
          (compile-tables db table-map)
          (c-return " ON ")
@@ -136,7 +177,8 @@
 (defmethod compile-query :default [db {:keys [table fields joins where sort-by]}]
   (c-str (c-return "SELECT ")
          (compile-fields db fields)
-         (c-return " FROM ")
+         (if table
+           (c-return " FROM "))
          (compile-tables db table)
          (compile-joins db joins)
          (compile-where db where)
@@ -144,7 +186,6 @@
 
 
 
-
 ;; SQL SERVER
 (defmethod field-name :sql-server [_ field]
   (str \[ (name field) \]))
@@ -163,6 +204,21 @@
 
 
 
+
+
+
+
+
+
+
+
+
+
+
+;; ==============================================================
+;; The DSL for making query maps
+;; ==============================================================
+
 ;; important sections:
 ;;   -PROJECTION-
 ;;   -TABLES-
@@ -171,12 +227,13 @@
 ;;   GROUPED FILTERS
 ;;   -SORTING-
 
-
-;; table: tablename -> table_alias
-;; fields: (table_alias, fieldname) -> field_alias
-;; joins: [(tablename -> type, table_alias, on)]
-;; where: expression
-;; sort-by: [[field direction]]
+;; {
+;;  :table => tablename -> table_alias,
+;;  :fields => (table_alias, fieldname) -> field_alias
+;;  :joins => [tablename -> (type, table_alias, on)]
+;;  :where => expression
+;;  :sort-by => [(field, direction)]
+;; }
 
 (defn table [arg]
   (into (->Query)
@@ -256,19 +313,52 @@
                             `(and ~acc ~where))))
           nil wheres))
 
-(defn join [left right & [on type]]
-  {:pre [(empty? (set/intersection (set (vals (:fields left)))
-                                   (set (vals (:fields right)))))]}
-  (let [joins-vector (or (:join left) [])
-        joined-fields (merge (:fields left) (:fields right))
-        on (or on true)]
+(defn join [left right & {:keys [on type]}]
+  (let [joins-vector (or (:join left) []) 
+        common-fields (set/intersection (set (vals (:fields left)))
+                                        (set (vals (:fields right))))
+        joined-fields (if (:type :right) 
+                        (merge (->> (:fields left)
+                                    (filter (comp not common-fields val))
+                                    (into {}))
+                               (:fields right))
+                        (merge (:fields left)
+                               (->> (:fields right)
+                                    (filter (comp not common-fields val))
+                                    (into {}))))
+        implicit-on (if (seq common-fields)
+                      (map (fn [field]
+                             `(= ~(resolve-field (:table left) (:fields left) field)
+                                 ~(resolve-field (:table right) (:fields right) field)))
+                           common-fields))
+        on (if on
+             [(resolve-fields nil joined-fields on)])
+        join-condition (if-let [condition (seq (concat implicit-on on))]
+                         `(and ~@condition)
+                         true)]
     (-> left
         (assoc :fields joined-fields)
         (assoc :joins (into (conj joins-vector
-                                  [(or type :inner) (:table right) (resolve-fields nil joined-fields on)])
+                                  [(or type :inner) (:table right) join-condition])
                             (:joins right)))
         (assoc :where (combine-wheres (:where left) (:where right))))))
 
+(-> (join (-> (table {:nodes :child})
+              (project {:parent-id :pid, :name :name}))
+          (-> (table {:nodes :parent})
+              (project {:id :id}))
+          :type :outer
+          :on '(= :pid :id))
+    println)
+
+(-> (join (-> (table :x)
+              (project [:id :num :age]))
+          (-> (table :y)
+              (project [:id :num :b-age]))
+          :type :left
+          :on '(= :age :b-age))
+    (project [:id :num]))
+
 (defn select [query expression]
   (let [table-name (if-not (:joins query)
                      (-> query :table first val))
@@ -301,26 +391,24 @@
                      (project [:id :fname :sname])
                      (select '(= :deleted false)))
           uid-pid-match '(= :uid :pid)
-          is-carlo `(= :fname "Carlo'; SELECT * FROM users --")
-          query (-> (join (-> users
-                              (rename {:id :uid}))
-                          (join (-> people
-                                    (rename {:id :pid}))
-                                (-> (table {:others :o})
-                                    (project {:id :oid}))
-                                '(= :pid :oid))
-                          uid-pid-match)
-                    (select is-carlo)
-                    (project [:fname :sname :oid]))]
-      @query))
+          is-carlo `(= :fname "Carlo'; SELECT * FROM users --")]
+      (-> (join (-> users
+                    (rename {:id :uid}))
+                (join (-> people
+                          (rename {:id :pid}))
+                      (-> (table {:others :o})
+                          (project {:id :oid}))
+                      '(= :pid :oid))
+                uid-pid-match)
+          (select is-carlo)
+          (project [:fname :sname :oid]))))
 
   (-> (table :users)
       (join (table :something-else-with-a-username)
             true)
       (select '(or (= :username "john")
                    (not (= :username "carlo"))))
-      (project [:username])
-      deref)
+      (project [:username]))
 
   (-> (table {:nodes :child})
       (project [:parent-id, :name])
@@ -329,27 +417,25 @@
                 (project [:id, :name])
                 (rename {:name :parent.name}))
             '(= :parent-id :id))
-      (project [:child.name :parent.name])
-      deref)
+      (project [:child.name :parent.name]))
 
   (-> (table :users)
       (project [:id])
       (join (-> (table :people)
                 (project [:id]))
-            true) 
-      deref)
+            true))
   (-> (table :users)
       (project [:id :name])
       (rename {:id :name
-               :name :id})
-      deref)
+               :name :id}))
   (-> (table :users)
       (project {:id :name
-                :name :id})
-      deref)
+                :name :id}))
 
   (-> (table :anotherStack)
       (project [:anotherNumber])
       (join (-> (table :collection)
-                (project [:number])))
-      deref))
+                (project [:number]))))
+
+  (-> (table :users)
+      (select '(= (left :username 1) "bloo"))))