diff options
Diffstat (limited to 'src/clojure_sql/core.clj')
| -rw-r--r-- | src/clojure_sql/core.clj | 303 |
1 files changed, 298 insertions, 5 deletions
diff --git a/src/clojure_sql/core.clj b/src/clojure_sql/core.clj index 423ff8e..2000595 100644 --- a/src/clojure_sql/core.clj +++ b/src/clojure_sql/core.clj @@ -1,6 +1,299 @@ -(ns clojure-sql.core) +(ns clojure-sql.core + (:refer-clojure :exclude [sort-by]) + (:require [clojure.set :as set] + [clojure.string :as string] + [clojure-sql.util :as u])) -(defn foo - "I don't do a whole lot." - [x] - (println x "Hello, World!")) +(defn add-parentheses [s] + (str \( s \))) + +(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 sql-string (fn [db _] db)) +(defmethod sql-string :default [_ string] + (str \' (string/replace string "'" "''") \')) + +;; compile-* multimethods are of the signature: +;; (db, expr) -> (SQL, replacements) + +(def is-unary? (comp boolean '#{not})) +(def is-predicate? (comp boolean '#{= < > <= >= is in})) + +(defn c-lift [f] + (fn [& args] + (let [seconds (map second args)]) + (apply f (map first args)))) +(defn c-str [elements] + (reduce (fn [[string args] [new-string new-args]] + [(str string new-string) + (vec concat args new-args)]) + ["" nil] elements)) + +(defmulti compile-expression (fn [db _] db)) +(defmethod compile-expression :default [db ex] + (condp #(%1 %2) ex + nil? "NULL" + vector? (str (table-name db (first ex)) \. (field-name db (second ex))) + keyword? (field-name db ex) + string? (sql-string db ex) + symbol? (string/upper-case (name ex)) + sequential? (if (= (count ex) 2) + (->> (second ex) + (compile-expression db) + (str (compile-expression db (first ex)) " ") + add-parentheses) + (->> (rest ex) + (map (partial compile-expression db)) + (interpose (compile-expression db (first ex))) + (string/join " ") + add-parentheses)) + ex)) + +(defmulti compile-join (fn [db _] db)) +(defmethod compile-join :default [db [type table-map on]] + (str (case type + :left " LEFT OUTER " + :right " RIGHT OUTER " + "") + " JOIN " (compile-tables db table-map) " ON " (compile-expression db on))) + +(defmulti compile-joins (fn [db _] db)) +(defmethod compile-joins :default [db joins] + (->> joins + (map (partial compile-join db)) + (string/join " "))) + +(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 ", ")) + "*")) + +(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 ", "))) + +(defmulti compile-where (fn [db _] db)) +(defmethod compile-where :default [db expr] + (if expr + (str " 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 ")))) + +(defmulti compile-query (fn [db _] db)) +(defmethod compile-query :default [db {:keys [table fields joins where sort-by]}] + (str "SELECT " + (compile-fields db fields) + " FROM " + (compile-tables db table) + (compile-joins db joins) + (compile-where db where) + (compile-sort-by db sort-by))) + + + + +;; 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) \`)) + +(defmethod sql-string :mysql [_ string] + (str \" (string/replace string "\"" "\\\"") \")) + + + + + +;; important sections: +;; -PROJECTION- +;; -TABLES- +;; -FILTERS- +;; GROUPING +;; GROUPED FILTERS +;; -SORTING- + + +;; table: tablename -> table_alias +;; fields: (table_alias, fieldname) -> field_alias +;; joins: [(tablename -> table_alias, type, on)] +;; where: expression +;; group-by: [field] +;; having: expression + +(def ^:dynamic *database-type* nil) +(defrecord Table [] + clojure.lang.IDeref + (deref [this] (compile-query *database-type* this))) + +(defn table [arg] + (into (->Table) + (if (map? arg) + {:table arg} + {:table {arg arg}}))) + +(defn project [query fields] + (let [table (-> query :table first val) + alias-lookup (->> query :fields + (map (comp vec reverse)) + (into {})) + original-name (fn [field] + (if (vector? field) + field + (get alias-lookup field [table field])))] + (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)]} + (let [alias-lookup (->> query :fields + (map (comp vec reverse)) + (into {})) + original-name (fn [field] + (cond (vector? field) field + (contains? alias-lookup field) (get alias-lookup field) + :else (throw (ex-info (str "Invalid field in rename: " (pr-str field)) + {:field field + :query query + :renames field-renames}))) + (get alias-lookup field))] + (update-in query + [:fields] #(->> (for [[key val] field-renames] + [(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])))) + +(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 on & [type]] + (let [joins-vector (or (:join left) []) + joined-fields (merge (:fields left) (:fields right))] + (-> left + (assoc :fields joined-fields) + (assoc :joins (into (conj joins-vector + [(or type :inner) (:table right) (resolve-fields nil joined-fields on)]) + (:joins right))) + (assoc :where (combine-wheres (:where left) (:where right)))))) + +(defn select [query expression] + (let [table-name (-> 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] + #_{:pre [(let [flipped-query-fields (u/flip-map (:fields query)) + field-names-seq (map (fn [x] (if (vector? x) (first x) x)) + (if (sequential? fields) fields [fields]))] + (every? flipped-query-fields field-names-seq))]} + (let [table-name (-> 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]))))) + + +(binding [*database-type* :mysql] + (let [users (-> (table :users) + (project [:id :username :password]) + (select '(= :deleted false))) + people (-> (table :people) + (project [:id :fname :sname]) + (select '(= :deleted false))) + uid-pid-match '(= :uid :pid) + is-carlo `(= :username "Carlo") + query (-> (join (-> users + (rename {:id :uid})) + (join (-> people + (rename {:id :pid})) + (-> (table {:others :o}) + (project {:id :oid})) + '(= :pid :oid)) + uid-pid-match) + (select is-carlo) + (project [:fname :sname :oid]))] + @query)) + +(-> (table {:nodes :child}) + (project [:parent-id, :name]) + (rename {:name :child.name}) + (join (-> (table {:nodes :parent}) + (project [:id, :name]) + (rename {:name :parent.name})) + '(= :parent-id :id)) + (project [:child.name :parent.name]) + deref #_println) + + +(deref (-> (table :anotherStack) + (project [:anotherNumber]) + (join (-> (table :collection) + (project [:number])) + true))) |