This commit is contained in:
David Sargeant 2014-10-24 14:38:04 +00:00
commit 4af6f27070
2 changed files with 111 additions and 95 deletions

View file

@ -46,6 +46,7 @@
(defn- undasherize [s] (defn- undasherize [s]
(string/replace s "-" "_")) (string/replace s "-" "_"))
(defn quote-identifier [x & {:keys [style split] :or {split true}}] (defn quote-identifier [x & {:keys [style split] :or {split true}}]
(let [qf (if style (let [qf (if style
(quote-fns style) (quote-fns style)
@ -213,50 +214,58 @@
(extend-protocol ToSql (extend-protocol ToSql
clojure.lang.Keyword clojure.lang.Keyword
(-to-sql [x] (let [s ^String (name x)] (-to-sql [x]
(condp = (.charAt s 0) (let [s ^String (name x)]
\% (let [call-args (string/split (subs s 1) #"\." 2)] (condp = (.charAt s 0)
(to-sql (apply call (map keyword call-args)))) \? (to-sql (param (keyword (subs s 1))))
\? (to-sql (param (keyword (subs s 1)))) (quote-identifier x))))
(quote-identifier x))))
clojure.lang.Symbol clojure.lang.Symbol
(-to-sql [x] (quote-identifier x)) (-to-sql [x]
(let [s ^String (name x)]
(condp = (.charAt s 0)
\? (to-sql (param (keyword (subs s 1))))
(quote-identifier x))))
java.lang.Number java.lang.Number
(-to-sql [x] (str x)) (-to-sql [x] (str x))
java.lang.Boolean java.lang.Boolean
(-to-sql [x] (if x "TRUE" "FALSE")) (-to-sql [x] (if x "TRUE" "FALSE"))
clojure.lang.Sequential clojure.lang.IPersistentVector
(-to-sql [x] (if *fn-context?* (-to-sql [x]
;; list argument in fn call (if *fn-context?*
(paren-wrap (comma-join (map to-sql x))) ;; list argument in fn call
;; alias (paren-wrap (comma-join (map to-sql x)))
(str (to-sql (first x)) ;; alias
; Omit AS in FROM, JOIN, etc. - Oracle doesn't allow it (str (to-sql (first x))
(if (= :select *clause*) " AS "
" AS " (if (string? (second x))
" ") (quote-identifier (second x))
(if (string? (second x)) (to-sql (second x))))))
(quote-identifier (second x)) clojure.lang.IPersistentList
(to-sql (second x)))))) (-to-sql [x]
(let [fn-name (name (first x))
fn-name (fn-aliases fn-name fn-name)]
(apply fn-handler fn-name (rest x))))
SqlCall SqlCall
(-to-sql [x] (binding [*fn-context?* true] (-to-sql [x]
(let [fn-name (name (.name x)) (binding [*fn-context?* true]
fn-name (fn-aliases fn-name fn-name)] (let [fn-name (name (.name x))
(apply fn-handler fn-name (.args x))))) fn-name (fn-aliases fn-name fn-name)]
(apply fn-handler fn-name (.args x)))))
SqlRaw SqlRaw
(-to-sql [x] (.s x)) (-to-sql [x] (.s x))
clojure.lang.IPersistentMap clojure.lang.IPersistentMap
(-to-sql [x] (let [clause-ops (concat (-to-sql [x]
(filter #(contains? x %) clause-order) (let [clause-ops (concat
(remove known-clauses (keys x))) (filter #(contains? x %) clause-order)
sql-str (binding [*subquery?* true (remove known-clauses (keys x)))
*fn-context?* false] sql-str (binding [*subquery?* true
(space-join *fn-context?* false]
(map (comp #(-format-clause % x) #(find x %)) (space-join
clause-ops)))] (map (comp #(-format-clause % x) #(find x %))
(if *subquery?* clause-ops)))]
(paren-wrap sql-str) (if *subquery?*
sql-str))) (paren-wrap sql-str)
sql-str)))
nil nil
(-to-sql [x] "NULL")) (-to-sql [x] "NULL"))
@ -266,15 +275,16 @@
(defn to-sql [x] (defn to-sql [x]
(if (satisfies? ToSql x) (if (satisfies? ToSql x)
(-to-sql x) (-to-sql x)
(let [[x pname] (if (instance? SqlParam x) (let [[x pname]
(let [pname (param-name x)] (if (instance? SqlParam x)
(if (map? @*input-params*) (let [pname (param-name x)]
[(get @*input-params* pname) pname] (if (map? @*input-params*)
(let [x (first @*input-params*)] [(get @*input-params* pname) pname]
(swap! *input-params* rest) (let [x (first @*input-params*)]
[x pname]))) (swap! *input-params* rest)
;; Anonymous param name -- :_1, :_2, etc. [x pname])))
[x (keyword (str "_" (swap! *param-counter* inc)))])] ;; Anonymous param name -- :_1, :_2, etc.
[x (keyword (str "_" (swap! *param-counter* inc)))])]
(swap! *param-names* conj pname) (swap! *param-names* conj pname)
(swap! *params* conj x) (swap! *params* conj x)
"?"))) "?")))

View file

@ -23,24 +23,19 @@
(if (coll? x) x [x])) (if (coll? x) x [x]))
(defhelper select [m fields] (defhelper select [m fields]
(assoc m :select (collify fields)))
(defhelper merge-select [m fields]
(update-in m [:select] concat (collify fields))) (update-in m [:select] concat (collify fields)))
(defhelper replace-select [m fields]
(assoc m :select (collify fields)))
(defhelper un-select [m fields] (defhelper un-select [m fields]
(update-in m [:select] #(remove (set (collify fields)) %))) (update-in m [:select] #(remove (set (collify fields)) %)))
(defhelper from [m tables] (defhelper from [m tables]
(assoc m :from (collify tables)))
(defhelper merge-from [m tables]
(update-in m [:from] concat (collify tables))) (update-in m [:from] concat (collify tables)))
(defmethod build-clause :where [_ m pred] (defhelper replace-from [m tables]
(if (nil? pred) (assoc m :from (collify tables)))
m
(assoc m :where pred)))
(defn- prep-where [args] (defn- prep-where [args]
(let [[m preds] (if (map? (first args)) (let [[m preds] (if (map? (first args))
@ -54,20 +49,14 @@
(into [logic-op] preds))] (into [logic-op] preds))]
[m pred logic-op])) [m pred logic-op]))
(defn where [& args] (defmethod build-clause :where [_ m pred]
(let [[m pred] (prep-where args)]
(if (nil? pred)
m
(assoc m :where pred))))
(defmethod build-clause :merge-where [_ m pred]
(if (nil? pred) (if (nil? pred)
m m
(assoc m :where (if (not (nil? (:where m))) (assoc m :where (if (not (nil? (:where m)))
[:and (:where m) pred] [:and (:where m) pred]
pred)))) pred))))
(defn merge-where [& args] (defn where [& args]
(let [[m pred logic-op] (prep-where args)] (let [[m pred logic-op] (prep-where args)]
(if (nil? pred) (if (nil? pred)
m m
@ -75,26 +64,37 @@
[logic-op (:where m) pred] [logic-op (:where m) pred]
pred))))) pred)))))
(defhelper join [m clauses] (defmethod build-clause :replace-where [_ m pred]
(assoc m :join clauses)) (if (nil? pred)
m
(assoc m :where pred)))
(defhelper merge-join [m clauses] (defn replace-where [& args]
(let [[m pred] (prep-where args)]
(if (nil? pred)
m
(assoc m :where pred))))
(defhelper join [m clauses]
(update-in m [:join] concat clauses)) (update-in m [:join] concat clauses))
(defhelper left-join [m clauses] (defhelper replace-join [m clauses]
(assoc m :left-join clauses)) (assoc m :join clauses))
(defhelper merge-left-join [m clauses] (defhelper left-join [m clauses]
(update-in m [:left-join] concat clauses)) (update-in m [:left-join] concat clauses))
(defhelper right-join [m clauses] (defhelper replace-left-join [m clauses]
(assoc m :right-join clauses)) (assoc m :left-join clauses))
(defhelper merge-right-join [m clauses] (defhelper right-join [m clauses]
(update-in m [:right-join] concat clauses)) (update-in m [:right-join] concat clauses))
(defhelper replace-right-join [m clauses]
(assoc m :right-join clauses))
(defmethod build-clause :group-by [_ m fields] (defmethod build-clause :group-by [_ m fields]
(assoc m :group-by (collify fields))) (update-in m [:group-by] concat (collify fields)))
(defn group [& args] (defn group [& args]
(let [[m fields] (if (map? (first args)) (let [[m fields] (if (map? (first args))
@ -102,28 +102,23 @@
[{} args])] [{} args])]
(build-clause :group-by m fields))) (build-clause :group-by m fields)))
(defhelper merge-group-by [m fields] (defmethod build-clause :replace-group-by [_ m fields]
(update-in m [:group-by] concat (collify fields))) (assoc m :group-by (collify fields)))
(defn replace-group [& args]
(let [[m fields] (if (map? (first args))
[(first args) (rest args)]
[{} args])]
(build-clause :replace-group-by m fields)))
(defmethod build-clause :having [_ m pred] (defmethod build-clause :having [_ m pred]
(if (nil? pred)
m
(assoc m :having pred)))
(defn having [& args]
(let [[m pred] (prep-where args)]
(if (nil? pred)
m
(assoc m :having pred))))
(defmethod build-clause :merge-having [_ m pred]
(if (nil? pred) (if (nil? pred)
m m
(assoc m :having (if (not (nil? (:having m))) (assoc m :having (if (not (nil? (:having m)))
[:and (:having m) pred] [:and (:having m) pred]
pred)))) pred))))
(defn merge-having [& args] (defn having [& args]
(let [[m pred logic-op] (prep-where args)] (let [[m pred logic-op] (prep-where args)]
(if (nil? pred) (if (nil? pred)
m m
@ -131,12 +126,23 @@
[logic-op (:having m) pred] [logic-op (:having m) pred]
pred))))) pred)))))
(defhelper order-by [m fields] (defmethod build-clause :replace-having [_ m pred]
(assoc m :order-by (collify fields))) (if (nil? pred)
m
(assoc m :having pred)))
(defhelper merge-order-by [m fields] (defn replace-having [& args]
(let [[m pred] (prep-where args)]
(if (nil? pred)
m
(assoc m :having pred))))
(defhelper order-by [m fields]
(update-in m [:order-by] concat (collify fields))) (update-in m [:order-by] concat (collify fields)))
(defhelper replace-order-by [m fields]
(assoc m :order-by (collify fields)))
(defhelper limit [m l] (defhelper limit [m l]
(if (nil? l) (if (nil? l)
m m
@ -150,12 +156,12 @@
(defhelper modifiers [m ms] (defhelper modifiers [m ms]
(if (nil? ms) (if (nil? ms)
m m
(assoc m :modifiers (collify ms)))) (update-in m [:modifiers] concat (collify ms))))
(defhelper merge-modifiers [m ms] (defhelper replace-modifiers [m ms]
(if (nil? ms) (if (nil? ms)
m m
(update-in m [:modifiers] concat (collify ms)))) (assoc m :modifiers (collify ms))))
(defmethod build-clause :insert-into [_ m table] (defmethod build-clause :insert-into [_ m table]
(assoc m :insert-into table)) (assoc m :insert-into table))
@ -165,11 +171,11 @@
([m table] (build-clause :insert-into m table))) ([m table] (build-clause :insert-into m table)))
(defhelper columns [m fields] (defhelper columns [m fields]
(assoc m :columns (collify fields)))
(defhelper merge-columns [m fields]
(update-in m [:columns] concat (collify fields))) (update-in m [:columns] concat (collify fields)))
(defhelper replace-columns [m fields]
(assoc m :columns (collify fields)))
(defmethod build-clause :values [_ m vs] (defmethod build-clause :values [_ m vs]
(assoc m :values vs)) (assoc m :values vs))