Merge branch 'master' into pagination

src/clojureql/core.clj

@@ -135,15 +135,12 @@
              (modify \"TOP 5\")) ; MSSqls special LIMIT syntax
          (-> (table :one) distinct)")
 
-  (pick!      [this kw]
-    "For queries where you know only a single result will be returned,
-     pick calls the keyword on that result. You can supply multiple keywords
-     in a collection.  Returns nil for no-hits, throws
-     an exception on multiple hits.
-
+  (transform  [this fn]
+    "Transforms results using fn when deref or with-results is called.
+     The pick helper function is implemented using this.
      Ex. (-> (table :users)
-             (select (where (= :id 5))) ; We know this will only match 1 row
-             (pick :email))")
+             (select (where (= :id 5)))
+             (transform #(map :email %))")
 
   (conj!      [this records]
     "Inserts record(s) into the table
@@ -194,23 +191,24 @@
 
 (defrecord RTable [cnx tname tcols restriction renames joins
                    grouped-by pre-scope scope order-by modifiers
-                   combinations having]
+                   combinations having transform]
   clojure.lang.IDeref
   (deref [this]
     (apply-on this doall))
 
   Relation
   (apply-on [this f]
     (with-cnx cnx
-      (with-results* (compile this cnx) f)))
+      (with-results* (compile this cnx)
+        (fn [results]
+          (f (if transform
+               (transform results)
+               results))))))
 
-  (pick! [this kw]
-    (let [results @this]
-      (if (or (= 1 (count results)) (empty? results))
-        (if (coll? kw)
-          (map (first results) kw)
-          (kw (first results)))
-        (throw (Exception. "Multiple items in resultsetseq, keyword lookup not possible")))))
+  (transform [this fn]
+    (if transform
+      (assoc this :transform (comp fn transform))
+      (assoc this :transform fn)))
 
   (select [this clause]
     (if (and (has-aggregate? this) (seq grouped-by))
@@ -228,26 +226,45 @@
     (outer-join this table2 nil join-on))
 
   (outer-join [this table2 type join-on]
-    (if (requires-subselect? table2)
-      (assoc this
-        :tcols (into (or tcols [])
-                     (rename-subselects (:tname table2)
-                                        (-> table2 :grouped-by first)))
-        :joins (conj (or joins [])
-                 {:data     [table2 join-on]
-                 :type     (if (keyword? type) :outer :join)
-                 :position type}))
-      (assoc this
-        :tcols (if-let [t2cols (seq (:tcols table2))]
-                 (apply conj (or tcols [])
-                        (map #(add-tname (:tname table2) %)
-                             (if (coll? t2cols)
-                               t2cols [t2cols])))
-                 tcols)
-        :joins (conj (or joins [])
-                 {:data     [(to-tablename (:tname table2)) join-on]
-                  :type     (if (keyword? type) :outer :join)
-                  :position type}))))
+	      (let [sort-joins (fn sort-joins [joins]
+				 (let [to-tbl-name (fn to-tbl-name [{[table-name join-on] :data :as join}]
+						     (->> join-on :cols
+							  (map #(-> % name (.replaceAll "\\..*" "")))
+							  (filter #(not= % table-name))
+							  first))
+				       to-graph-el (fn to-graph-el [m {[table-name join-on] :data :as join}]
+						     (let [required-table (to-tbl-name join)]
+						       (assoc m table-name required-table)))
+				       map-of-joins (reduce #(let [{[table-name join-on] :data :as join} %2
+								   k table-name]
+							       (assoc %1 k (conj (%1 k) join))) {} joins)
+				       edges (reduce to-graph-el {} joins)
+				       set-of-root-nodes (clojure.set/difference (into #{} (vals edges)) (into #{} (keys edges)))
+				       add-deps (fn add-deps [tbl]
+						  (into [(map-of-joins tbl)] (map add-deps (filter #(= tbl (edges %)) (keys edges)))))
+				       sorted-joins (filter #(not (nil? %)) (flatten (map add-deps set-of-root-nodes)))]
+				   sorted-joins))
+		    j (into (or joins []) (-> table2 :joins (or [])))]
+		(if (requires-subselect? table2)
+		  (assoc this
+		    :tcols (into (or tcols [])
+				 (rename-subselects (:tname table2)
+						    (-> table2 :grouped-by first)))
+		    :joins (sort-joins (conj j
+					     {:data     [table2 join-on]
+					      :type     (if (keyword? type) :outer :join)
+					      :position type})))
+		  (assoc this
+		    :tcols (if-let [t2cols (seq (:tcols table2))]
+			     (apply conj (or tcols [])
+				    (map #(add-tname (:tname table2) %)
+					 (if (coll? t2cols)
+					   t2cols [t2cols])))
+			     tcols)
+		    :joins (sort-joins (conj j
+					     {:data     [(to-tablename (:tname table2)) join-on]
+					      :type     (if (keyword? type) :outer :join)
+					      :position type}))))))
 
   (modify [this new-modifiers]
     (assoc this :modifiers
@@ -421,9 +438,33 @@
      (let [connection-info (if (fn? connection-info)
                              (connection-info)
                              connection-info)]
-       (RTable. connection-info table-name [:*] nil nil nil nil nil nil nil nil nil nil))))
+       (RTable. connection-info table-name [:*] nil nil nil nil nil nil nil nil nil nil nil))))
+
+(defmacro declare-tables
+  "Given a connection info map (or nil) and as list
+   of tablenames as keywords a number of tables will
+   be (def)ined with identical names of the keywords
+   given.
+
+   Ex. (declare-tables db :t1 :t2)
+       @t1
+       ({....} {...})"
+  [conn-info & names]
+  `(do
+     ~@(for [nm names]
+         (list 'def (-> nm name symbol)
+               (list 'table conn-info nm)))))
 
 (defn table?
   "Returns true if tinstance is an instnce of RTable"
   [tinstance]
   (instance? clojureql.core.RTable tinstance))
+
+(defn pick [table kw]
+  (transform table
+             (fn [results]
+               (if (or (= 1 (count results)) (empty? results))
+                 (if (coll? kw)
+                   (map (first results) kw)
+                   (kw (first results)))
+                 (throw (Exception. "Multiple items in resultsetseq, keyword lookup not possible"))))))

src/clojureql/internal.clj

@@ -3,6 +3,7 @@
    [clojure.contrib.sql.internal :as sqlint]
    [clojure.contrib.sql :as csql])
   (:use [clojure.string :only [join upper-case] :rename {join join-str}]
+        [clojure.contrib.string :only (as-str)]
         [clojure.contrib.core :only [-?> -?>>]]))
 
 (defn upper-name [kw]
@@ -146,6 +147,14 @@
              (str aggr "(" (split-fields p col) ")"))
            (add-tname p c))))))
 
+(defn to-tablealias
+  "Returns the alias of a :tname. If :tname is not aliased it
+  returns the same as to-tablename."
+  [c]
+  (if (map? c)
+    (as-str (first (vals c)))
+    (to-tablename c)))
+
 (defn emit-case
   [{:keys [alias clauses returns else]}]
   (format "CASE %s %s END AS %s"

src/clojureql/predicates.clj

@@ -120,7 +120,7 @@
                         colname
                         (if (.contains colname ".")
                           colname
-                          (str tname \. colname)))))
+                          (str (to-tablealias (:tname this)) \. colname)))))
              (str pred) (set cols))
      env
      cols)))

src/clojureql/sql92compiler.clj

@@ -113,12 +113,12 @@
                            (interleave (mapcat #(mapcat (fn [clause] (:env clause)) %)
                                                (map :clauses cases))
                                        (mapcat :returns cases)))
+                         (mapcat last jdata)
                          (map :else (filter map? tcols))
                          (map (comp :env second) jdata)
                          (if (table? tcols) (rest tables))
                          (if preds [(:env preds)])
-                         (if having [(:env having)])
-                         (mapcat last jdata)]
+                         (if having [(:env having)])]
                         flatten (remove nil?) vec)
                    (->> (mapcat rest combs)
                         (remove nil?)))

test/clojureql/test/core.clj

@@ -236,7 +236,9 @@
                 "JOIN salary w1 ON (u1.id = w1.id) WHERE (s2.article IS NULL)")
            (-> u1 (join (project w1 [[:wage :as :income]]) (where (= :u1.id :w1.id))))
            (str "SELECT u1.id,u1.article,u1.price,w1.wage AS income "
-                "FROM users u1 JOIN salary w1 ON (u1.id = w1.id)"))))
+                "FROM users u1 JOIN salary w1 ON (u1.id = w1.id)")
+           (select (table {:users :developers}) (where (= :title "Dev")))
+           "SELECT developers.* FROM users developers WHERE (developers.title = Dev)")))
 
   (testing "joining on multiple tables"
     (are [x y] (= (-> x (compile nil) interpolate-sql) y)
@@ -252,6 +254,90 @@
               "ON (countries.id = spots_subselect.country_id) "
               "WHERE (regions_subselect.country_id = spots_subselect.country_id)")))
 
+  (testing "joins are associative"
+    (let [ta (join (table :t1) (table :t2) :id)
+	  tb (join (table :t3) ta :id)] ;; swapping argument order of "ta" and "(table :t3)" works
+      (are [x y] (= (-> x (compile nil) interpolate-sql (.replaceAll "SELECT .* FROM" "SELECT * FROM")) y)
+	   tb
+	   "SELECT * FROM t3 JOIN t1 USING(id) JOIN t2 USING(id)"))
+    (let [ta (-> (table :t1)
+		 (join (table :t2) (where (= :t1.a :t2.a)))
+		 (join (table :t6) (where (= :t6.e :t2.e))))
+	  tb (-> (table :t3)
+		 (join (table :t4) (where (= :t3.b :t4.b)))
+		 (join (table :t5) (where (= :t5.d :t4.d))))
+	  qu (join ta tb (where (= :t3.c :t2.c)))]
+      (are [x y] (= (-> x (compile nil) interpolate-sql (.replaceAll "SELECT .* FROM" "SELECT * FROM")) y)
+	   qu
+	   (str "SELECT * FROM t1 "
+		"JOIN t2 ON (t1.a = t2.a) "
+		"JOIN t6 ON (t6.e = t2.e) "
+		"JOIN t3 ON (t3.c = t2.c) "
+		"JOIN t4 ON (t3.b = t4.b) "
+		"JOIN t5 ON (t5.d = t4.d)")))
+    (let [product-variants-table (project (table :product_variants)
+					      [[:id			:as :product_variant_id]
+					       [:product_id		:as :product_variant_product_id]
+					       [:product_code		:as :product_variant_product_code]
+					       [:status			:as :product_variant_status]
+					       [:price_id		:as :product_variant_price_id]])
+	  products-table (project (table :products)
+				      [[:id				:as :product_id]
+				       [:name				:as :product_name]
+				       [:description			:as :product_description]
+				       [:manufacturer_id		:as :product_manufacturer_id]])
+	  product-variant-skus-table (project (table :product_variant_skus)
+						  [[:id			:as :product_variant_sku_id]
+						   [:product_variant_id	:as :product_variant_sku_product_variant_id]
+						   [:sku_id		:as :product_variant_sku_sku_id]
+						   [:quantity		:as :product_variant_sku_quantity]])
+	  orders-table   (project (table :orders)
+				      [[:id				:as :order_id]
+				       [:customer_id			:as :order_customer_id]
+				       [:customer_ref			:as :order_customer_ref]
+				       [:created			:as :order_created]
+				       [:status				:as :order_status]
+				       [:created_by			:as :order_created_by]
+				       [:source_id			:as :order_source_id]
+				       [:updated			:as :order_updated]
+				       [:cancellation_reason_id		:as :order_cancellation_reason_id]
+				       [:expirable			:as :order_expirable]
+				       [:shipping_method_id		:as :order_shipping_method_id]])
+	  order-lines-table (project (table :order_lines)
+					 [[:id				:as :order_line_id]
+					  [:order_id			:as :order_line_order_id]
+					  [:product_variant_id		:as :order_line_product_variant_id]
+					  [:quantity			:as :order_line_quantity]
+					  [:status			:as :order_line_status]
+					  [:updated			:as :order_line_updated]
+					  [:price_id			:as :order_line_price_id]
+					  [:shippable_estimate		:as :order_line_shippable_estimate]])
+	  orders-with-lines-query (-> orders-table
+				      (join order-lines-table (where (= :orders.id :order_lines.order_id))))
+	  sku-table (project (table :skus) [[:id		:as :sku_id]
+						    [:stock_code	:as :sku_stock_code]
+						    [:barcode		:as :sku_barcode]
+						    [:reorder_quantity	:as :sku_reorder_quantity]
+						    [:minimum_level	:as :sku_minimum_level]])
+	  products-with-skus-query (-> product-variants-table
+				       (join products-table (where (= :products.id :product_variants.product_id)))
+				       (join product-variant-skus-table (where (= :product_variants.id :product_variant_skus.product_variant_id)))
+				       (join sku-table (where (= :skus.id :product_variant_skus.sku_id))))
+	  orders-with-skus-query (-> orders-with-lines-query
+				     (join products-with-skus-query
+					       (where (= :order_lines.product_variant_id :product_variants.id))))
+	  open-orders-with-skus-query  (-> orders-with-skus-query
+					   (select (where (= :orders.status 1))))]
+      (are [x y] (= (-> x (compile nil) interpolate-sql (.replaceAll "SELECT .* FROM" "SELECT * FROM")) y)
+	   open-orders-with-skus-query
+	   (str "SELECT * FROM orders "
+		"JOIN order_lines ON (orders.id = order_lines.order_id) "
+		"JOIN product_variants ON (order_lines.product_variant_id = product_variants.id) "
+		"JOIN product_variant_skus ON (product_variants.id = product_variant_skus.product_variant_id) "
+		"JOIN skus ON (skus.id = product_variant_skus.sku_id) "
+		"JOIN products ON (products.id = product_variants.product_id) "
+		"WHERE (orders.status = 1)"))))
+
   (testing "update-in!"
     (expect [update-or-insert-vals (has-args [:users ["(id = ?)" 1] {:name "Bob"}])
              find-connection (returns true)]

test/clojureql/test/integration.clj

@@ -96,6 +96,10 @@
                            (conj! [{:name "Alice" :title "Developer"} {:name "Bob"}]))]
       (is (= alice (first @(select users (where (!= :title nil)))))))))
 
+(database-test test-select-equals
+  (is (= @(select users (where (= :title "Dev")))
+         '({:title "Dev", :name "Lau Jensen", :id 1}))))
+
 (database-test test-select-or
   (is (= @(select users (where (or (= :id 1) (>= :id 10))))
          '({:title "Dev", :name "Lau Jensen", :id 1}))))
@@ -183,3 +187,30 @@
                             [:name :as :dupe]])]
     (is (= (map :name @users)
            (map :dupe @tbl)))))
+
+(database-test test-transform
+  (is (= @(transform users #(map (juxt :id :name) %))
+         '([1 "Lau Jensen"] [2 "Christophe"] [3 "sthuebner"] [4 "Frank"]))))
+
+(database-test test-transform-and-with-results
+  (with-results [names (transform users #(map :name %))]
+    (is (= names
+           '("Lau Jensen" "Christophe" "sthuebner" "Frank")))))
+
+(database-test test-pick
+  (is (= @(-> (select users (where (= :id 4)))
+              (pick :name))
+         "Frank")))
+
+(database-test test-composing-transforms
+  (is (= @(-> users
+              (transform #(map (juxt :id :name) %))
+              (transform first))
+         [1 "Lau Jensen"])))
+
+(database-test test-transform-with-join
+  (is (= @(-> users
+              (transform #(map (juxt :name :wage) %))
+              (join (transform salary first) ; this transform will be ignored
+                    (where (= :users.id :salary.id))))
+         '(["Lau Jensen" 100] ["Christophe" 200] ["sthuebner" 300] ["Frank" 400]))))

test/clojureql/test/internal.clj

@@ -0,0 +1,23 @@
+(ns clojureql.test.internal
+  (:refer-clojure
+   :exclude [compile take drop sort distinct conj! disj! case])
+  (:use clojure.test
+        clojureql.internal))
+
+(deftest test-to-tablename
+  (are [tname expected]
+    (is (= expected (to-tablename tname)))
+    nil nil
+    :user "user"
+    "user" "user"
+    {:user :developer} "user developer"
+    {"user" "developer"} "user developer"))
+
+(deftest test-to-tablealias
+  (are [tname expected]
+    (is (= expected (to-tablealias tname)))
+    nil nil
+    :user "user"
+    "user" "user"
+    {:user :developer} "developer"
+    {"user" "developer"} "developer"))