-
-
Notifications
You must be signed in to change notification settings - Fork 6
/
core.clj
409 lines (361 loc) · 21.7 KB
/
core.clj
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
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
(ns honeyeql.core
(:require [edn-query-language.core :as eql]
[honeyeql.meta-data :as heql-md]
[clojure.data.json :as json]
[inflections.core :as inf]
[honey.sql.helpers :as hsql-helpers]
[honeyeql.db-adapter.core :as db]
[clojure.string :as str]
[honeyeql.debug :refer [trace>>]]))
(def ^:no-doc default-heql-config {:attr/return-as :naming-convention/qualified-kebab-case
:eql/mode :eql.mode/lenient})
(defn- eql-ident? [x]
(and (vector? x) ((comp not map? second) x)))
(defn- transform-honeyeql-query [eql-query]
(cond
(keyword? eql-query) eql-query
(vector? eql-query) eql-query
(map? eql-query) (let [first-key (ffirst eql-query)
props (->> (eql-query first-key)
(map transform-honeyeql-query)
vec)]
(cond
(keyword? first-key) {first-key props}
(list? first-key) {first-key props}
(eql-ident? first-key) {first-key props}
:else {(apply list first-key) props}))))
(defn- transform-honeyeql-queries [eql-queries]
(let [eql-queries (if (vector? eql-queries) eql-queries (vector eql-queries))]
(vec (map transform-honeyeql-query eql-queries))))
(defn- function-attribute-ident? [x]
(and (vector? x)
(#{:sum :count :max :min :avg :cast} (first x))))
(defn alias-attribute-ident? [x]
(and (vector? x)
(= (count x) 3)
(= :as (second x))))
(defn ^:no-doc find-join-type [heql-meta-data eql-node]
(let [{node-type :type
node-key :key} eql-node]
(cond
(= :root node-type) :root
(and (= :join node-type) (vector? node-key) (empty? node-key)) :non-ident-join
(and (= :join node-type) (keyword? node-key)) (-> (heql-md/attr-column-ref-type heql-meta-data node-key)
name
(str "-join")
keyword)
(and (= :join node-type) (alias-attribute-ident? node-key)) (-> (heql-md/attr-column-ref-type heql-meta-data (first node-key))
name
(str "-join")
keyword)
(and (= :join node-type) (seq node-key) (even? (count node-key))) :ident-join)))
(defn- eql-node->attr-ident [{:keys [key type dispatch-key]}]
(cond
(and (= :prop type) (keyword? key)) key
(and (= :prop type) (function-attribute-ident? key)) (second key)
(and (= :prop type) (alias-attribute-ident? key)) (if (function-attribute-ident? (first key))
(second (first key))
(first key))
(and (= :join type) dispatch-key) key))
(defn ^:no-doc column-alias [attr-naming-convention attr-ident]
(case attr-naming-convention
:naming-convention/qualified-kebab-case (str (namespace attr-ident) "/" (name attr-ident))
:naming-convention/unqualified-kebab-case (name attr-ident)
:naming-convention/unqualified-camel-case (inf/camel-case (name attr-ident) :lower)))
(defn- one-to-one-join-predicate [heql-meta-data {:attr.column.ref/keys [left right]} alias]
[:=
(keyword (str (:parent alias) "." (heql-md/attr-column-name heql-meta-data left)))
(keyword (str (:self alias) "." (heql-md/attr-column-name heql-meta-data right)))])
(defn- one-to-many-join-predicate [heql-meta-data {:attr.column.ref/keys [left right]} alias]
[:=
(keyword (str (:parent alias) "." (heql-md/attr-column-name heql-meta-data left)))
(keyword (str (:self alias) "." (heql-md/attr-column-name heql-meta-data right)))])
(defn- many-to-many-join-predicate [heql-meta-data {:attr.column.ref/keys [left right]
:as join-attr-md} alias assoc-table-alias]
(let [{:attr.column.ref.associative/keys [left-ident right-ident]} join-attr-md]
[:and
[:=
(keyword (str (:parent alias) "." (heql-md/attr-column-name heql-meta-data left)))
(keyword (str assoc-table-alias "." (heql-md/attr-column-name heql-meta-data left-ident)))]
[:=
(keyword (str assoc-table-alias "." (heql-md/attr-column-name heql-meta-data right-ident)))
(keyword (str (:self alias) "." (heql-md/attr-column-name heql-meta-data right)))]]))
(defmulti ^:no-doc eql->hsql (fn [db-adapter heql-meta-data eql-node] (find-join-type heql-meta-data eql-node)))
(defmethod ^{:private true} eql->hsql :root [db-adapter heql-meta-data eql-node]
(eql->hsql db-adapter heql-meta-data (first (:children eql-node))))
(defn- eql-ident->hsql-predicate [db-adapter [attr-ident value] alias]
(let [heql-meta-data (:heql-meta-data db-adapter)
attr-col-name (heql-md/attr-column-name heql-meta-data attr-ident)
attr-value (heql-md/coerce-attr-value db-adapter attr-ident value)]
[:= (keyword (str (:self alias) "." attr-col-name)) attr-value]))
(defn- eql-ident-key->hsql-predicate [db-adapter eql-ident-key alias]
(let [predicates (map #(eql-ident->hsql-predicate db-adapter % alias) (partition 2 eql-ident-key))]
(if (< 1 (count predicates))
(conj predicates :and)
(first predicates))))
(defn- resolve-group-by-column [db-adapter eql-node attr-ident]
(->> (:children eql-node)
(filter #(= attr-ident (:key %)))
first
:alias
(db/resolve-one-to-one-relationship-alias db-adapter)))
(defn- hsql-column
([db-adapter attr-ident-or-rel-attr-ident eql-node]
(hsql-column db-adapter attr-ident-or-rel-attr-ident eql-node false))
([db-adapter attr-ident-or-rel-attr-ident eql-node group-by-column]
(let [heql-meta-data (:heql-meta-data db-adapter)
attr-ident (if (keyword? attr-ident-or-rel-attr-ident) attr-ident-or-rel-attr-ident (last attr-ident-or-rel-attr-ident))
attr-md (heql-md/attr-meta-data heql-meta-data attr-ident)
attr-col-name (:attr.column/name attr-md)
attr-col-ref-type (:attr.column.ref/type attr-md)
eql-node (if (keyword? attr-ident-or-rel-attr-ident)
eql-node
(first (filter #(= (:key %) (first attr-ident-or-rel-attr-ident)) (:children eql-node))))
{:keys [self parent]} (:alias eql-node)]
(if (and group-by-column (= :attr.column.ref.type/one-to-one attr-col-ref-type))
(resolve-group-by-column db-adapter eql-node attr-ident)
(if (keyword? attr-ident-or-rel-attr-ident)
(keyword (str self "." attr-col-name))
(keyword (str parent "__" self)
(str (namespace (:attr/ident attr-md)) "/" (name (:attr/ident attr-md)))))))))
(defn- order-by-clause [db-adapter eql-node clause]
(if (keyword? clause)
(hsql-column db-adapter clause eql-node)
(let [[c t] clause]
(if (#{:asc :desc} t)
[(hsql-column db-adapter c eql-node) t]
(hsql-column db-adapter clause eql-node)))))
(defn- apply-order-by [hsql heql-meta-data clause eql-node]
(assoc hsql :order-by (map #(order-by-clause heql-meta-data eql-node %) clause)))
(defn- coerce-value [db-adapter eql-node col value]
(if (coll? value)
(map #(coerce-value db-adapter eql-node col %) value)
(if (and (keyword? value) (some? (namespace value)) (heql-md/attribute? (:heql-meta-data db-adapter) value))
(hsql-column db-adapter value eql-node)
(heql-md/coerce-attr-value db-adapter col value))))
(defn- hsql-predicate [db-adapter eql-node clause]
(let [[op col v1 v2] clause
hsql-col (hsql-column db-adapter col eql-node)]
(if v2
[op hsql-col (coerce-value db-adapter eql-node col v1) (coerce-value db-adapter eql-node col v2)]
[op hsql-col (coerce-value db-adapter eql-node col v1)])))
(defn- hsql-join-predicate [db-adapter eql-node join-attr-md self-alias]
(let [heql-meta-data (:heql-meta-data db-adapter)
ref-type (:attr.column.ref/type join-attr-md)
alias {:self self-alias
:parent (get-in eql-node [:alias :self])}
from-relation-ident (heql-md/entity-relation-ident heql-meta-data (:attr.column.ref/right join-attr-md))
from-clause [from-relation-ident (keyword self-alias)]]
(case ref-type
:attr.column.ref.type/one-to-one [[from-clause]
(one-to-one-join-predicate heql-meta-data join-attr-md alias)]
:attr.column.ref.type/one-to-many [[from-clause]
(one-to-many-join-predicate heql-meta-data join-attr-md alias)]
:attr.column.ref.type/many-to-many (let [assoc-table-alias (str (gensym))
assoc-table-from-clause [(->> (:attr.column.ref.associative/ident join-attr-md)
(heql-md/entity-meta-data heql-meta-data)
:entity.relation/ident)
(keyword assoc-table-alias)]]
[[from-clause assoc-table-from-clause]
(many-to-many-join-predicate heql-meta-data join-attr-md alias assoc-table-alias)]))))
(defn- nested-entity-attr-predicate [db-adapter eql-node clause hsql join-attr-md attr-ident]
(let [[op _ v1 v2] clause
attr-ident (if (qualified-keyword? attr-ident)
attr-ident
(keyword (name (:attr.ref/type join-attr-md)) (name attr-ident)))]
(hsql-helpers/where
hsql
(hsql-predicate db-adapter eql-node [op attr-ident v1 v2]))))
(defn- nested-entity-predicate [db-adapter eql-node clause]
(let [[op col] clause
join-attr-ident (if (= :exists op) col (first col))
attr-ident (when-not (= :exists op) (second col))
heql-meta-data (:heql-meta-data db-adapter)
self-alias (str (gensym))
self-eql-node {:alias {:self self-alias}}
join-attr-md (heql-md/attr-meta-data heql-meta-data join-attr-ident)
[from join-pred] (hsql-join-predicate db-adapter eql-node join-attr-md self-alias)
hsql {:select [1]
:from from
:where join-pred}]
[:exists (if attr-ident
(nested-entity-attr-predicate db-adapter self-eql-node clause hsql join-attr-md attr-ident)
hsql)]))
(defn- where-predicate [db-adapter clause eql-node]
(let [[op col] clause]
(case op
:and (concat [:and] (map #(where-predicate db-adapter % eql-node) (rest clause)))
:or (concat [:or] (map #(where-predicate db-adapter % eql-node) (rest clause)))
:not (conj [:not] (where-predicate db-adapter (second clause) eql-node))
:exists (nested-entity-predicate db-adapter eql-node clause)
(if (keyword? col)
(hsql-predicate db-adapter eql-node clause)
(nested-entity-predicate db-adapter eql-node clause)))))
(defn- apply-where [hsql db-adapter clause eql-node]
(hsql-helpers/where hsql (where-predicate db-adapter clause eql-node)))
(defn- apply-group-by [hsql db-adapter clause eql-node]
(apply hsql-helpers/group-by hsql (map #(hsql-column db-adapter % eql-node true) clause)))
(defn- apply-params [db-adapter hsql eql-node]
(let [{:keys [limit offset order-by where group-by]} (:params eql-node)]
(cond-> hsql
limit (assoc :limit limit)
offset (assoc :offset offset)
order-by (apply-order-by db-adapter order-by eql-node)
where (apply-where db-adapter where eql-node)
group-by (apply-group-by db-adapter group-by eql-node)
:else identity)))
(defmethod ^{:private true} eql->hsql :ident-join [db-adapter heql-meta-data eql-node]
(let [{:keys [key children alias]} eql-node
hsql {:from [[(heql-md/entity-relation-ident heql-meta-data (first key))
(keyword (:self alias))]]
:where (eql-ident-key->hsql-predicate db-adapter key alias)
:select (db/select-clause db-adapter heql-meta-data children)}
hsql (apply-params db-adapter hsql eql-node)]
(db/resolve-children-one-to-one-relationships db-adapter heql-meta-data hsql children)))
#_n
(defmethod ^{:private true} eql->hsql :non-ident-join [db-adapter heql-meta-data eql-node]
(let [{:keys [children alias]} eql-node
first-child-ident (eql-node->attr-ident (first children))
hsql {:from [[(heql-md/entity-relation-ident heql-meta-data first-child-ident)
(keyword (:self alias))]]
:select (db/select-clause db-adapter heql-meta-data children)}
hsql (apply-params db-adapter hsql eql-node)]
(db/resolve-children-one-to-one-relationships db-adapter heql-meta-data hsql children)))
(defmethod ^{:private true} eql->hsql :one-to-one-join [db-adapter heql-meta-data eql-node]
(let [{:keys [key children alias]} eql-node
key (if (alias-attribute-ident? key)
(first key)
key)
join-attr-md (heql-md/attr-meta-data heql-meta-data key)
hsql {:from [[(heql-md/ref-entity-relation-ident heql-meta-data key)
(keyword (:self alias))]]
:where (one-to-one-join-predicate heql-meta-data join-attr-md alias)
:select (db/select-clause db-adapter heql-meta-data children)}
hsql (apply-params db-adapter hsql eql-node)]
(db/resolve-one-to-one-relationship db-adapter heql-meta-data hsql eql-node)))
(defmethod ^{:private true} eql->hsql :one-to-many-join [db-adapter heql-meta-data eql-node]
(let [{:keys [key children alias]} eql-node
key (if (alias-attribute-ident? key)
(first key)
key)
join-attr-md (heql-md/attr-meta-data heql-meta-data key)
hsql {:from [[(heql-md/ref-entity-relation-ident heql-meta-data key)
(keyword (:self alias))]]
:where (one-to-many-join-predicate heql-meta-data join-attr-md alias)
:select (db/select-clause db-adapter heql-meta-data children)}
hsql (apply-params db-adapter hsql eql-node)]
(db/resolve-one-to-many-relationship db-adapter heql-meta-data hsql eql-node)))
(defmethod ^{:private true} eql->hsql :many-to-many-join [db-adapter heql-meta-data eql-node]
(let [{:keys [key children alias]} eql-node
key (if (alias-attribute-ident? key)
(first key)
key)
join-attr-md (heql-md/attr-meta-data heql-meta-data key)
assoc-table-alias (gensym)
hsql {:from [[(heql-md/ref-entity-relation-ident heql-meta-data key)
(keyword (:self alias))]
[(->> (:attr.column.ref.associative/ident join-attr-md)
(heql-md/entity-meta-data heql-meta-data)
:entity.relation/ident)
(keyword assoc-table-alias)]]
:where (many-to-many-join-predicate heql-meta-data join-attr-md alias assoc-table-alias)
:select (db/select-clause db-adapter heql-meta-data children)}
hsql (apply-params db-adapter hsql eql-node)]
(db/resolve-many-to-many-relationship db-adapter heql-meta-data hsql eql-node)))
(defn- json-key-fn [attribute-return-as aggregate-attr-convention key]
(let [default-key (keyword key)]
(if (= :naming-convention/qualified-kebab-case attribute-return-as)
(if (= :aggregate-attr-naming-convention/vector aggregate-attr-convention)
(if-let [[_ aggr-fun attr-name] (first (re-seq #"(.*)-of-(.*)" (name default-key)))]
[(keyword aggr-fun) (keyword (namespace default-key) attr-name)]
default-key)
default-key)
[default-key (column-alias attribute-return-as default-key)])))
(defn- json-value-fn [db-adapter attribute-return-as json-key json-value]
(if (= :naming-convention/qualified-kebab-case attribute-return-as)
(heql-md/coerce-attr-value db-adapter json-key json-value)
(heql-md/coerce-attr-value db-adapter (first json-key) json-value)))
(defn- transform-keys [attribute-return-as return-value]
(if (= :naming-convention/qualified-kebab-case attribute-return-as)
return-value
(inf/transform-keys return-value (comp keyword second))))
(defn- handle-non-default-schema [entity-name]
(if (str/includes? (name entity-name) ".")
(let [[schema-name table-name] (str/split (name entity-name) #"\.")]
(keyword schema-name table-name))
entity-name))
(defn- resolve-eql-nodes [{:keys [entities]} wild-card-select-node]
(->> (:key wild-card-select-node)
namespace
keyword
handle-non-default-schema
entities
:entity/attrs
(map #(merge wild-card-select-node
{:key %
:dispatch-key %
:attr-ident %}))))
(defn select-clause-alias [{:keys [attr-ident key function-attribute-ident]}]
(let [attr-ident (cond
function-attribute-ident (if (alias-attribute-ident? key)
(nth key 2)
(keyword (namespace attr-ident) (str (name (first key)) "-of-" (name attr-ident))))
(alias-attribute-ident? key) (nth key 2)
:else attr-ident)]
(column-alias :naming-convention/qualified-kebab-case attr-ident)))
(declare enrich-eql-node)
(defn resolve-wid-card-attributes [{:keys [heql-config heql-meta-data]
:as db-adapter} self-alias eql-nodes]
(let [eql-nodes (map #(enrich-eql-node db-adapter % self-alias) eql-nodes)]
(if (= :eql.mode/lenient (:eql/mode heql-config))
(let [[props joins] ((juxt filter remove) #(= :prop (:type %)) eql-nodes)
wild-card-select-node (some #(when (and (keyword? (:key %))
(= "*" (name (:key %)))) %) props)]
(if wild-card-select-node
(concat (resolve-eql-nodes heql-meta-data wild-card-select-node) joins)
eql-nodes))
eql-nodes)))
(defn-
enrich-eql-node
"Adds ident & alias to the eql node and also resolve wild-card-select props"
([db-adapter eql-node]
(enrich-eql-node db-adapter eql-node nil))
([db-adapter eql-node parent-alias]
(let [attr-ident (eql-node->attr-ident eql-node)]
(case (:type eql-node)
:root (update (assoc eql-node :attr-ident attr-ident) :children
(fn [eql-nodes]
(vec (map #(enrich-eql-node db-adapter %) eql-nodes))))
:join (let [self-alias (gensym)]
(update (assoc eql-node
:alias {:self self-alias
:parent parent-alias}
:attr-ident attr-ident)
:children
(partial resolve-wid-card-attributes db-adapter self-alias)))
:prop (-> (assoc eql-node :attr-ident attr-ident)
(assoc-in [:alias :parent] parent-alias)
(assoc :function-attribute-ident (if (alias-attribute-ident? (:key eql-node))
(function-attribute-ident? (first (:key eql-node)))
(function-attribute-ident? (:key eql-node)))))))))
(defn query [db-adapter eql-query]
(let [{:keys [heql-meta-data heql-config]} db-adapter
{:attr/keys [return-as aggregate-attr-convention]} heql-config
eql-query (case (:eql/mode heql-config)
:eql.mode/lenient (trace>> :transformed-eql (transform-honeyeql-queries eql-query))
:eql.mode/strict eql-query)]
(map #(transform-keys return-as %)
(json/read-str (->> (eql/query->ast eql-query)
(trace>> :raw-eql-ast)
(enrich-eql-node db-adapter)
(trace>> :eql-ast)
(eql->hsql db-adapter heql-meta-data)
(trace>> :hsql)
(db/to-sql db-adapter)
(trace>> :sql)
(db/query db-adapter))
:bigdec true
:key-fn #(json-key-fn return-as aggregate-attr-convention %)
:value-fn #(json-value-fn db-adapter return-as %1 %2)))))
(defn query-single [db-adapter eql-query]
(first (query db-adapter eql-query)))