diff options
| -rw-r--r-- | src/clojure_sql/core.clj | 186 |
1 files changed, 136 insertions, 50 deletions
diff --git a/src/clojure_sql/core.clj b/src/clojure_sql/core.clj index 43e5089..89d218e 100644 --- a/src/clojure_sql/core.clj +++ b/src/clojure_sql/core.clj @@ -19,6 +19,9 @@ (defrecord ^:private Query [] clojure.lang.IDeref (deref [this] (*query-deref-behaviour* this))) +(defmethod print-method Query [query writer] + (binding [*out* writer] + (pr (compile-query nil query)))) @@ -26,6 +29,10 @@ (defn add-parentheses [s] (str \( s \))) +;; ============================================================== +;; DB specific escaping methods +;; ============================================================== + (defmulti field-name (fn [db _] db)) (defmethod field-name :default [_ field] (str \" (name field) \")) @@ -34,13 +41,24 @@ (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})) -(def is-predicate? (comp boolean '#{= < > <= >= is in})) +(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] @@ -56,6 +74,12 @@ (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 @@ -64,14 +88,31 @@ keyword? (c-return (field-name db ex)) string? ["?" ex] ;;(sql-string db ex) symbol? (c-return (string/upper-case (name ex))) - sequential? (-> (if (= (count ex) 2) - (->> ex - (map (partial compile-expression db)) - (c-join " ")) + 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)) - (interpose (compile-expression db (first ex))) - (c-join " "))) + (c-join ", ") + c-add-parentheses + (c-str (c-return (function-name db (first ex)))))) c-add-parentheses) (c-return ex))) @@ -104,9 +145,9 @@ (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 " - "")) + :left " LEFT OUTER" + :right " RIGHT OUTER" + " INNER")) (c-return " JOIN ") (compile-tables db table-map) (c-return " ON ") @@ -136,7 +177,8 @@ (defmethod compile-query :default [db {:keys [table fields joins where sort-by]}] (c-str (c-return "SELECT ") (compile-fields db fields) - (c-return " FROM ") + (if table + (c-return " FROM ")) (compile-tables db table) (compile-joins db joins) (compile-where db where) @@ -144,7 +186,6 @@ - ;; SQL SERVER (defmethod field-name :sql-server [_ field] (str \[ (name field) \])) @@ -163,6 +204,21 @@ + + + + + + + + + + + +;; ============================================================== +;; The DSL for making query maps +;; ============================================================== + ;; important sections: ;; -PROJECTION- ;; -TABLES- @@ -171,12 +227,13 @@ ;; 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]] +;; { +;; :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 (->Query) @@ -256,19 +313,52 @@ `(and ~acc ~where)))) nil wheres)) -(defn join [left right & [on type]] - {:pre [(empty? (set/intersection (set (vals (:fields left))) - (set (vals (:fields right)))))]} - (let [joins-vector (or (:join left) []) - joined-fields (merge (:fields left) (:fields right)) - on (or on true)] +(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) (resolve-fields nil joined-fields on)]) + [(or type :inner) (:table right) join-condition]) (:joins right))) (assoc :where (combine-wheres (:where left) (:where right)))))) +(-> (join (-> (table {:nodes :child}) + (project {:parent-id :pid, :name :name})) + (-> (table {:nodes :parent}) + (project {:id :id})) + :type :outer + :on '(= :pid :id)) + println) + +(-> (join (-> (table :x) + (project [:id :num :age])) + (-> (table :y) + (project [:id :num :b-age])) + :type :left + :on '(= :age :b-age)) + (project [:id :num])) + (defn select [query expression] (let [table-name (if-not (:joins query) (-> query :table first val)) @@ -301,26 +391,24 @@ (project [:id :fname :sname]) (select '(= :deleted false))) uid-pid-match '(= :uid :pid) - is-carlo `(= :fname "Carlo'; SELECT * FROM users --") - 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)) + is-carlo `(= :fname "Carlo'; SELECT * FROM users --")] + (-> (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])))) (-> (table :users) (join (table :something-else-with-a-username) true) (select '(or (= :username "john") (not (= :username "carlo")))) - (project [:username]) - deref) + (project [:username])) (-> (table {:nodes :child}) (project [:parent-id, :name]) @@ -329,27 +417,25 @@ (project [:id, :name]) (rename {:name :parent.name})) '(= :parent-id :id)) - (project [:child.name :parent.name]) - deref) + (project [:child.name :parent.name])) (-> (table :users) (project [:id]) (join (-> (table :people) (project [:id])) - true) - deref) + true)) (-> (table :users) (project [:id :name]) (rename {:id :name - :name :id}) - deref) + :name :id})) (-> (table :users) (project {:id :name - :name :id}) - deref) + :name :id})) (-> (table :anotherStack) (project [:anotherNumber]) (join (-> (table :collection) - (project [:number]))) - deref)) + (project [:number])))) + + (-> (table :users) + (select '(= (left :username 1) "bloo")))) |