Split out core into compiler/dsl/query.

The query namespace really only exists because I didn't want to put it in dsl,
but I couldn't put it in core without a circular dependency.

Users should only have to :require core to do things, though. It just aliases
other stuff to make that work.

1 files changed, 169 insertions, 0 deletions

diff --git a/src/clojure_sql/dsl.clj b/src/clojure_sql/dsl.clj
new file mode 100644
index 0000000..006e637
--- /dev/null
+++ b/src/clojure_sql/dsl.clj
@@ -0,0 +1,169 @@
+(ns clojure-sql.dsl
+  (:refer-clojure :exclude [sort-by])
+  (:require [clojure.set :as set]
+            [clojure.walk]
+            [clojure-sql.query :as q]
+            [clojure-sql.util :as u]))
+
+
+;; ==============================================================
+;; The DSL for making query maps
+;; ==============================================================
+
+;; important sections:
+;;   -PROJECTION-
+;;   -TABLES-
+;;   -FILTERS-
+;;   GROUPING
+;;   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)]
+;; }
+
+(defn table [arg]
+  (into (q/->Query)
+        (if (map? arg)
+          {:table arg}
+          {:table {arg 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 project [query fields]
+  (let [table (if-not (:joins query)
+                (-> query :table first val))
+        alias-lookup (u/flip-map (:fields query))
+        original-name (fn [field]
+                        (if (vector? field)
+                          field
+                          (or (get alias-lookup field nil)
+                              (if table
+                                [table field] 
+                                (ambiguous-error field query)))))]
+    (assoc query
+      :fields (->> (for [[key val] (if (map? fields)
+                                     fields
+                                     (zipmap fields fields))]
+                     [(original-name key) val])
+                   (into {})))))
+
+(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))
+                                   (set/difference (set (vals (:fields query)))
+                                                   (set (keys field-renames)))))]}
+  (let [fields (:fields query)
+        alias-lookup (u/flip-map (:fields query)) 
+        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))]
+    (update-in query
+               [:fields] #(->> (for [[key val] field-renames]
+                                 ;(if (contains? val (:fields query)))
+                                 [(original-name key) val])
+                               (into %)))))
+
+(defn ^:private resolve-field [table aliases field]
+  (let [field-alias-lookup (u/flip-map aliases)]
+    (or (field-alias-lookup field)
+        (if table
+          [table field]
+          (ambiguous-error field)))))
+
+(defn ^:private resolve-fields [table aliases expression]
+  (clojure.walk/postwalk (fn [expr]
+                           (cond
+                            (keyword? expr) (resolve-field table aliases expr)
+                            :else expr))
+                         expression))
+
+(defn ^:private combine-wheres [& 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))
+
+(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) join-condition])
+                            (:joins right)))
+        (assoc :where (combine-wheres (:where left) (:where right))))))
+
+(defn select [query expression]
+  (let [table-name (if-not (:joins query)
+                     (-> query :table first val))
+        old-where (:where query)
+        resolved-expression (resolve-fields table-name (:fields query) expression)
+        new-where (combine-wheres old-where resolved-expression)]
+    (assoc query :where new-where)))
+
+(defn sort-by [query fields]
+  (let [table-name (if-not (:joins query)
+                     (-> query :table first val))
+        fields-seq (if (sequential? fields)
+                     fields
+                     [fields])]
+    (assoc query
+      :sort-by (for [field fields-seq]
+                 (if (vector? field)
+                   (resolve-field table-name (:fields query) field)
+                   [(resolve-field table-name (:fields query) field) :asc])))))
+
+
+(defn insert! [query & records]
+  {:pre [(empty? (:joins query))]}
+  ;; some code here
+  )
+
+(defn update! [query & partial-records]
+  ;; some code here
+  )
+
+(defn delete! [query]
+  ;; some code here
+  )