diff options
Diffstat (limited to 'src/clojure_sql/compiler.clj')
| -rw-r--r-- | src/clojure_sql/compiler.clj | 187 |
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) \`)) + + + |