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, 187 insertions, 0 deletions

diff --git a/src/clojure_sql/compiler.clj b/src/clojure_sql/compiler.clj
new file mode 100644
index 0000000..ca8d2d9
--- /dev/null
+++ b/src/clojure_sql/compiler.clj
@@ -0,0 +1,187 @@
+(ns clojure-sql.compiler
+  (:require [clojure.string :as string]))
+
+
+
+(defn add-parentheses [s]
+  (str \( s \)))
+
+
+;; ==============================================================
+;; DB specific escaping methods
+;; ==============================================================
+
+(defmulti field-name (fn [db _] db))
+(defmethod field-name :default [_ field]
+  (str \" (name field) \"))
+
+(defmulti table-name (fn [db _] db))
+(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"} 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]
+  (fn [& c-args] 
+    (apply vector 
+           (apply f (concat orig-args
+                            (map first c-args)))
+           (apply concat (map rest c-args)))))
+(def c-str (c-lift str))
+(def c-join (fn [sep args]
+              (apply vector
+                     (string/join sep (map first args))
+                     (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
+    nil? (c-return "NULL")
+    vector? (c-return (str (table-name db (first ex)) \. (field-name db (second ex))))
+    keyword? (c-return (field-name db ex))
+    string? ["?" ex] ;;(sql-string db ex)
+    symbol? (c-return (string/upper-case (name ex)))
+    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))
+                           (c-join ", ")
+                           c-add-parentheses
+                           (c-str (c-return (function-name db (first ex))))))
+                    c-add-parentheses)
+    (c-return ex)))
+
+(defn ^:private make-table-name [db table & [alias]]
+  (if (or (= table alias) (nil? alias))
+    (table-name db table)
+    (str (table-name db table) " AS " (field-name db alias)))  )
+
+(defn ^:private make-field-name [db table field & [alias]]
+  (if (or (= field alias) (nil? alias))
+    (str (table-name db table) \. (field-name db field))
+    (str (table-name db table) \. (field-name db field) " AS " (field-name db alias))))
+
+(defmulti compile-fields (fn [db _] db))
+(defmethod compile-fields :default [db fields-map]
+  (if (seq fields-map)
+    (->> (for [[[table field] alias] fields-map]
+           (make-field-name db table field alias))
+         (string/join ", ")
+         c-return)
+    (c-return "*")))
+
+(defmulti compile-tables (fn [db _] db))
+(defmethod compile-tables :default [db tables-map]
+  (->> (for [[table alias] tables-map]
+         (make-table-name db table alias))
+       (string/join ", ")
+       c-return))
+
+(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"
+                     " INNER"))
+         (c-return " JOIN ")
+         (compile-tables db table-map)
+         (c-return " ON ")
+         (compile-expression db on)))
+
+(defmulti compile-joins (fn [db _] db))
+(defmethod compile-joins :default [db joins]
+  (->> joins
+       (map (partial compile-join db))
+       (c-join "")))
+
+(defmulti compile-where (fn [db _] db))
+(defmethod compile-where :default [db expr]
+  (if expr
+    (c-str (c-return " WHERE ") (compile-expression db expr))))
+
+(defmulti compile-sort-by (fn [db _] db))
+(defmethod compile-sort-by :default [db fields]
+  (if fields
+    (->> (for [[[table field] dir] fields]
+           (str (make-field-name db table field) \space (string/upper-case (name dir))))
+         (string/join ",")
+         (apply str " ORDER BY ")
+         c-return)))
+
+(defmulti compile-query (fn [db _] db))
+(defmethod compile-query :default [db {:keys [table fields joins where sort-by]}]
+  (c-str (c-return "SELECT ")
+         (compile-fields db fields)
+         (if table
+           (c-return " FROM "))
+         (compile-tables db table)
+         (compile-joins db joins)
+         (compile-where db where)
+         (compile-sort-by db sort-by)))
+
+
+
+;; ==============================================================
+;; A few DB specific overrides
+;; ==============================================================
+
+
+;; SQL SERVER
+(defmethod field-name :sql-server [_ field]
+  (str \[ (name field) \]))
+
+(defmethod table-name :sql-server [_ table]
+  (str \[ (name table) \]))
+
+;; mySQL
+(defmethod field-name :mysql [_ field]
+  (str \` (name field) \`))
+
+(defmethod table-name :mysql [_ table]
+  (str \` (name table) \`))
+
+
+