blob: a75b8f729417719e366b4cabe539aa25c136af10 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
(ns clojure-sql.dsl
(:refer-clojure :exclude [sort-by])
(:require [clojure.set :as set]
[clojure.walk :as walk]
[clojure-sql.query :as q]
[clojure-sql.util :as u]))
;; ==============================================================
;; The DSL for making query maps
;; ==============================================================
;; important sections:
;; -PROJECTION-
;; -TABLES-
;; -FILTERS-
;; GROUPING
;; GROUPED FILTERS
;; -SORTING-
;; {
;; :tables => tablename -> table_alias
;; :fields => (table_alias, fieldname) -> field_alias
;; :joins => [left-table type right-table on?]
;; :where => expression
;; :sort-by => [(field, direction)]
;; }
(defn table [arg]
(into (q/->Query)
(if (map? arg)
{:tables (u/flip-map arg)
:joins (vec (vals arg))}
{:tables {arg arg}
:joins [arg]})))
(defn ^:private ambiguous-error [field & [query]]
(throw (ex-info (str "Ambiguous field " field " in query with more than one table")
{:field field
:query query})))
(defn ^:private resolve-field [table aliases field]
(let [field-alias-lookup aliases]
(or (field-alias-lookup field)
(if table
[table field]
(ambiguous-error field)))))
(defn ^:private process-expression [table aliases expression]
(cond (vector? expression) (list 'quote expression)
(sequential? expression) (map (partial process-expression table aliases) expression)
(keyword? expression) (resolve-field table aliases expression)
:else expression))
(defn project [query fields]
(let [table (if (= (count (:tables query)) 1)
(-> query :tables first key))
alias-lookup (or (:fields query) {})
get-real-name #(resolve-field table alias-lookup %)]
(assoc query
:fields (->> (for [[old-name new-name] (if (map? fields)
fields
(zipmap fields fields))]
[new-name (get-real-name old-name)])
(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 (keys (:fields query)))
(set (keys field-renames)))))]}
(let [fields (: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)
:else (throw (ex-info (str "Cannot rename field " (pr-str field) ". Field does not exist in query.")
{:field field
:query query
:renames field-renames})))
(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 join [left right & {:keys [on type]}]
(let [common-tables (set/intersection (set (keys (:tables left)))
(set (keys (:tables right))))
;;_ (assert (empty? common-tables) "Cannot join two tables with the same name")
merged-tables (merge (:tables left) (:tables right))
common-fields (set/intersection (set (keys (:fields left)))
(set (keys (:fields right))))
merged-fields (merge (:fields left) (:fields right))
join-condition (cond
(nil? on) (let [implicit (map (fn [field]
`(~'=
~(resolve-field (:table left) (:fields left) field)
~(resolve-field (:table right) (:fields right) field)))
common-fields)]
(if (next implicit)
(seq (cons `and implicit)) ;; more than one, so add an "and" around them
(first implicit)))
(seq common-fields) (throw (ex-info "Cannot join with common fields unless natural join"
{:left left
:right right
:common-fields common-fields}))
:else (process-expression nil merged-fields on))
type (or type
(if join-condition :inner)
:cross)]
(-> left
(assoc :fields merged-fields
:tables merged-tables
:joins {:left (:joins left)
:right (:joins right)
:type type
:on join-condition}
:where (combine-wheres (:where left)
(:where right))))))
(defn select [query expression]
(let [table-name (if (= (count (:tables query)) 1)
(-> query :tables first key))
old-where (:where query)
resolved-expression (process-expression 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 (= (count (:tables query)) 1)
(-> query :tables first key))
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])))))
(let [id 10]
(-> (table :x)
(project [:x])
(select `(and (in :x [1 2 3 :y])
(= :x ~id)))
(join (-> (table :y)
(project [:y]))
:on `(= :x :y))
(join (-> (table :z)
(project [:x])))
(sort-by [:x])))
|
