(ns clojure-sql.compiler (:refer-clojure :exclude [compile sequence]) (:require [clojure.string :as string] [clojure-sql.query :refer [query?]] [clojure-sql.util :as u] [clojure-sql.writer :as w :refer [return lift p-lift sequence do-m tell >>]])) (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) \")) ;; we use the $ prefix to denote a lifted function (def $add-parentheses (lift add-parentheses)) (def $str (lift str)) ;; ============================================================== ;; Utility functions for the compile-* functions ;; ============================================================== (def ^:private named? (some-fn string? symbol? keyword?)) (def quote? (comp boolean '#{"quote"} name)) (def unary? (comp boolean '#{"not" "exists"} name)) (def binary? (comp boolean '#{"=" "<" ">" "<=" ">=" "is" "in"} name)) (def operator? (comp boolean '#{"and" "or" "+" "-" "/" "*"} name)) ;; ============================================================== ;; compile-* functions (turning a map into a query string) ;; ============================================================== ;; compile-* multimethods are of the signature: ;; (db, expr) -> (fn [s] [sql]) (declare compile-query compile-expression) (defmulti compile-expression-sequential (fn [db ex])) (defmethod compile-expression-sequential :default [db ex] (let [compile-exprs #(map (partial compile-expression db) %) op (name (first ex)) num-args (dec (count ex))] (-> (condp u/funcall (first ex) quote? (do (assert (= num-args 1) "`quote` must only take one argument") (>> (tell (second ex)) (return "?"))) unary? (do (assert (= num-args 1) (str "Unary operator `" op "` must take one argument")) (do-m :let [exprs (compile-exprs ex)] vals <- (apply sequence exprs) (return (string/join "" vals)))) binary? (do (assert (= num-args 2) (str "Binary operator `" op "` must take two arguments")) (do-m :let [[op left right] (compile-exprs ex)] vals <- (sequence left op right) (return (string/join " " vals)))) operator? (do-m :let [[op & exprs] (compile-exprs ex)] vals <- (apply sequence (interpose op exprs)) (return (string/join " " vals))) (do-m :let [fn-name (function-name db (first ex)) exprs (compile-exprs (rest ex))] vals <- (apply sequence exprs) (return (str fn-name (add-parentheses (string/join "," vals)))))) $add-parentheses))) (defmulti compile-expression (fn [db _] db)) (defmethod compile-expression :default [db ex] (condp u/funcall ex query? ($add-parentheses (compile-query db ex)) nil? (return "NULL") vector? (return (str (table-name db (first ex)) \. (field-name db (second ex)))) keyword? (return (field-name db ex)) string? (>> (tell ex) (return "?")) ;;(sql-string db ex) symbol? (return (string/upper-case (name ex))) sequential? (compile-expression-sequential db ex) (return ex))) (defn ^:private make-table-name [db table & [alias]] (if (or (= table alias) (nil? alias)) (return (table-name db table)) ($str (condp #(%1 %2) table query? ($add-parentheses (compile-query db table)) named? (return (table-name db table)) (compile-expression db table)) (return " AS ") (return (table-name db alias))))) (defn ^:private make-field-name [db field & [alias]] (if (and (vector? field) (or (= field alias) (nil? alias))) (compile-expression db field) ($str (compile-expression db field) (return " AS ") (return (field-name db alias))))) (defmulti compile-fields (fn [db _] db)) (defmethod compile-fields :default [db fields-map] (if (seq fields-map) (->> (for [[field alias] fields-map] (make-field-name db field alias)) (apply sequence) ((p-lift string/join ", "))) (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)) (apply sequence) ((p-lift string/join ", ")))) (defmulti compile-join (fn [db _] db)) (defmethod compile-join :default [db [type table-map on]] ($str (return (case type :left " LEFT OUTER" :right " RIGHT OUTER" " INNER")) (return " JOIN ") (compile-tables db table-map) (return " ON ") (compile-expression db on))) (defmulti compile-joins (fn [db _] db)) (defmethod compile-joins :default [db joins] (->> joins (map (partial compile-join db)) (apply sequence) ((p-lift string/join "")))) (defmulti compile-where (fn [db _] db)) (defmethod compile-where :default [db expr] (if expr ($str (return " WHERE ") (compile-expression db expr)) (return nil))) (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 (return " ORDER BY ")) return) (return nil))) (defmulti compile-query (fn [db _] db)) (defmethod compile-query :default [db {:keys [table fields joins where sort-by]}] ($str (return "SELECT ") (compile-fields db fields) (if table (return " FROM ")) (compile-tables db table) (compile-joins db joins) (compile-where db where) (compile-sort-by db sort-by))) (defn compile [db query] (let [[sql vars] ((compile-query db query) [])] (vec (cons sql vars)))) ;; ============================================================== ;; 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) \`)) ;;(compile nil {:table {:u :u}, :fields {[:v :x] :w}}) ;; Utility functions (defn insert! [db query & records] {:pre [(empty? (:joins query))]} ;; some code here #_($str (return "Carlo")) ) (defn update! [db query & partial-records] {:pre [(empty? (:joins query))]} ;; some code here ) (defn delete! [db query] {:pre [(empty? (:joins query))]} ;; some code here )