From 148f752b5f48707dc3d7fe448d1faf33d5cd0228 Mon Sep 17 00:00:00 2001 From: Carlo Zancanaro Date: Thu, 13 Jun 2013 18:24:05 +1000 Subject: Starting a re-write of the DSL, to be followed by the compiler. Flip around field/table aliases, do joins a bit differently. They're my main aims at the moment! I'll also add a preprocessor for the compiler to massage it into a nicer form there. I discovered that joins can be done with a pretty sweet syntax in SQL: (tableA LEFT JOIN tableB) RIGHT JOIN tableC This is pretty much perfect for my purposes. Flipping alias maps just makes more sense and removes a whole bunch of `flip-map` calls that would be unnecessary if the aliases were the other way around. The user-facing side of the DSL will be left unchanged, though. The user provides an `{old-name new-name}` map and internally we convert that into `{new-name old-name}`. Like magic. I'm also adding a bunch more tests. Hopefully that will make things more likely to work for long periods of time. Peace out! --- src/clojure_sql/compiler.clj | 2 +- src/clojure_sql/core.clj | 22 +++--- src/clojure_sql/dsl.clj | 159 ++++++++++++++++++++++--------------------- src/clojure_sql/util.clj | 15 +++- 4 files changed, 109 insertions(+), 89 deletions(-) (limited to 'src') diff --git a/src/clojure_sql/compiler.clj b/src/clojure_sql/compiler.clj index 7ded112..ecd7bd6 100644 --- a/src/clojure_sql/compiler.clj +++ b/src/clojure_sql/compiler.clj @@ -211,7 +211,7 @@ (defn insert! [db query & records] {:pre [(empty? (:joins query))]} ;; some code here - ($str (return "Carlo")) + #_($str (return "Carlo")) ) (defn update! [db query & partial-records] diff --git a/src/clojure_sql/core.clj b/src/clojure_sql/core.clj index 4f88a53..4e3db34 100644 --- a/src/clojure_sql/core.clj +++ b/src/clojure_sql/core.clj @@ -17,16 +17,18 @@ (binding [*out* writer] (pr (c/compile nil query)))) -(def table #'d/table) -(def project #'d/project) -(def rename #'d/rename) -(def join #'d/join) -(def select #'d/select) -(def sort-by #'d/sort-by) - -(def insert! #'c/insert!) -(def update! #'c/update!) -(def delete! #'c/delete!) +(comment + + (def table #'d/table) + (def project #'d/project) + (def rename #'d/rename) + (def join #'d/join) + (def select #'d/select) + (def sort-by #'d/sort-by) + + (def insert! #'c/insert!) + (def update! #'c/update!) + (def delete! #'c/delete!)) diff --git a/src/clojure_sql/dsl.clj b/src/clojure_sql/dsl.clj index 8c9c31d..68446d1 100644 --- a/src/clojure_sql/dsl.clj +++ b/src/clojure_sql/dsl.clj @@ -19,9 +19,9 @@ ;; -SORTING- ;; { -;; :table => tablename -> table_alias, +;; :tables => tablename -> table_alias ;; :fields => (table_alias, fieldname) -> field_alias -;; :joins => [tablename -> (type, table_alias, on)] +;; :joins => [left-table type right-table on?] ;; :where => expression ;; :sort-by => [(field, direction)] ;; } @@ -29,8 +29,8 @@ (defn table [arg] (into (q/->Query) (if (map? arg) - {:table arg} - {:table {arg arg}}))) + {:tables (u/flip-map arg)} + {:tables {arg arg}}))) (defn ^:private ambiguous-error [field & [query]] (throw (ex-info (str "Ambiguous field " field " in query with more than one table") @@ -38,7 +38,7 @@ :query query}))) (defn ^:private resolve-field [table aliases field] - (let [field-alias-lookup (u/flip-map aliases)] + (let [field-alias-lookup aliases] (or (field-alias-lookup field) (if table [table field] @@ -51,25 +51,27 @@ :else expression)) (defn project [query fields] - (let [table (if-not (:joins query) - (-> query :table first val)) - alias-lookup (u/flip-map (:fields query)) - original-name #(resolve-fields table (:fields query) %)] + (let [table (if (= (count (:tables query)) 1) + (-> query :tables first key)) + alias-lookup (or (:fields query) {}) + original-name #(resolve-fields table alias-lookup %)] (assoc query :fields (->> (for [[key val] (if (map? fields) fields (zipmap fields fields))] - [(original-name key) val]) + [val (original-name key)]) (into {}))))) (defn rename [query field-renames] {:pre [(map? field-renames) ;; the intersection of the new aliases with the old aliases NOT renamed by this operation (empty? (set/intersection (set (vals field-renames)) - (set/difference (set (vals (:fields query))) + (set/difference (set (keys (:fields query))) (set (keys field-renames)))))]} (let [fields (:fields query) - alias-lookup (u/flip-map (:fields query)) + alias-lookup (or (:fields query) {}) + fields-to-remove (set/difference (set (keys field-renames)) + (set (vals field-renames))) original-name (fn [field] (cond (vector? field) field (contains? alias-lookup field) (get alias-lookup field) @@ -77,72 +79,75 @@ {:field field :query query :renames field-renames}))) - (get alias-lookup field))] - (update-in query - [:fields] #(->> (for [[key val] field-renames] - ;(if (contains? val (:fields query))) - [(original-name key) val]) - (into %))))) + (get alias-lookup field)) + ;; do the renaming we want here: + fields (->> (for [[key val] field-renames] + [val (original-name key)]) + (into fields)) + ;; remove the things we no longer have here: + fields (->> (remove (comp fields-to-remove key) fields) + (into {}))] + (assoc query :fields fields))) -(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 ^: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 & {: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) join-condition]) - (:joins right))) - (assoc :where (combine-wheres (:where left) (:where right)))))) +;; (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) join-condition]) +;; (:joins left))) +;; (assoc :where (combine-wheres (:where left) (:where right)))))) -(defn select [query expression] - (let [table-name (if-not (:joins query) - (-> 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 select [query expression] +;; (let [table-name (if-not (:joins query) +;; (-> 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] - (let [table-name (if-not (:joins query) - (-> 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]))))) +;; (defn sort-by [query fields] +;; (let [table-name (if-not (:joins query) +;; (-> 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]))))) diff --git a/src/clojure_sql/util.clj b/src/clojure_sql/util.clj index cd8e8b6..f2edf30 100644 --- a/src/clojure_sql/util.clj +++ b/src/clojure_sql/util.clj @@ -1,4 +1,5 @@ -(ns clojure-sql.util) +(ns clojure-sql.util + (:require [clojure.set :as set])) (defn funcall [f & args] (apply f args)) @@ -11,3 +12,15 @@ (->> m (map (comp vec reverse)) (into {}))) + +(defn map-kv [f & maps] + (let [all-keys (into #{} (mapcat keys maps))] + (->> all-keys + (map (fn [key] + (apply f key (map #(get % key) maps)))) + (into {})))) + +(defn map-vals [f & maps] + (apply map-kv (fn [k & vs] + [k (apply f vs)]) + maps)) -- cgit v1.2.3