summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/clojure_sql/core.clj186
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"))))
generated by cgit v1.2.3 (git 2.46.2) at 2024-12-27 09:08:14 +0000