-
Notifications
You must be signed in to change notification settings - Fork 7
/
select.clj
476 lines (424 loc) · 23.5 KB
/
select.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
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
(ns com.verybigthings.penkala.statement.select
(:require [clojure.string :as str]
[com.verybigthings.penkala.util :refer [q expand-join-path path-prefix-join join-separator vec-conj joins]]
[com.verybigthings.penkala.statement.shared
:refer [get-rel-alias-with-prefix
get-rel-alias
get-rel-schema
get-schema-qualified-relation-name
make-rel-alias-prefix]]
[camel-snake-kebab.core :refer [->SCREAMING_SNAKE_CASE_STRING ->snake_case_string]]
[com.verybigthings.penkala.env :as env]))
(def ^:dynamic *scopes* [])
(def op->sql-op {})
(defn get-sql-op [op]
(if (string? op)
op
(or (op->sql-op op) (-> op ->SCREAMING_SNAKE_CASE_STRING (str/replace #"_" " ")))))
(declare format-query-without-params-resolution)
(def empty-acc {:query [] :params []})
(defn get-resolved-column-identifier [env rel resolved-col col-def]
(let [col-id (:id resolved-col)
col-rel-path (vec (concat (::join-path-prefix env) (:path resolved-col)))]
(if (seq col-rel-path)
(let [col-rel (get-in rel (expand-join-path col-rel-path))
col-alias (get-in col-rel [:ids->aliases col-id])
full-path (map name (conj col-rel-path col-alias))
[rel-name & col-parts] full-path]
(str (q (get-rel-alias-with-prefix env rel-name)) "." (q (path-prefix-join col-parts))))
(str (q (get-rel-alias-with-prefix env (get-rel-alias rel))) "." (q (:name col-def))))))
(defmulti compile-function-call (fn [acc env rel function-name args] function-name))
(defmulti compile-value-expression (fn [acc env rel [vex-type & _]] vex-type))
(defmethod compile-function-call :default [acc env rel function-name args]
(let [sql-function-name (->snake_case_string function-name)
{:keys [query params]} (reduce
(fn [acc arg]
(compile-value-expression acc env rel arg))
empty-acc
args)]
(-> acc
(update :query conj (str sql-function-name "(" (str/join ", " query) ")"))
(update :params into params))))
(defmethod compile-value-expression :default [acc env rel [vex-type & args]]
(throw
(ex-info
(str "com.verybigthings.penkala.statement.value-expression/compile-value-expression multimethod not implemented for " vex-type)
{:type vex-type
:args args})))
(defmethod compile-value-expression :function-call [acc env rel [_ {:keys [fn args]}]]
(compile-function-call acc env rel fn args))
(defmethod compile-value-expression :resolved-column [acc env rel [_ col]]
(let [col-path (concat (::join-path-prefix env) (:path col))
col-rel (if (seq col-path) (get-in rel (expand-join-path col-path)) rel)
col-def (get-in col-rel [:columns (:id col)])]
(case (:type col-def)
:concrete
(update acc :query conj (get-resolved-column-identifier env rel col col-def))
(:computed :aggregate)
(compile-value-expression acc (if (seq col-path) (assoc env ::join-path-prefix col-path) env) rel (:value-expression col-def)))))
(defmethod compile-value-expression :value [acc _ _ [_ val]]
(-> acc
(update :query conj "?")
(update :params conj val)))
(defmethod compile-value-expression :keyword [acc _ _ [_ val]]
(-> acc
(update :query conj "?")
(update :params conj (name val))))
(defmethod compile-value-expression :literal [acc _ _ [_ val]]
(update acc :query conj val))
(defmethod compile-value-expression :unary-operation [{:keys [query params]} env rel [_ {:keys [op arg1]}]]
(let [sql-op (get-sql-op op)
arg1-acc (compile-value-expression empty-acc env rel arg1)]
{:query (-> query (into (:query arg1-acc)) (conj sql-op))
:params (-> params (into (:params arg1-acc)))}))
(defmethod compile-value-expression :binary-operation [{:keys [query params]} env rel [_ {:keys [op arg1 arg2]}]]
(let [sql-op (get-sql-op op)
arg1-acc (compile-value-expression empty-acc env rel arg1)
arg2-acc (compile-value-expression empty-acc env rel arg2)]
{:query (-> query (into (:query arg1-acc)) (conj sql-op) (into (:query arg2-acc)))
:params (-> params (into (:params arg1-acc)) (into (:params arg2-acc)))}))
(defmethod compile-value-expression :ternary-operation [{:keys [query params]} env rel [_ {:keys [op arg1 arg2 arg3]}]]
(let [sql-op (get-sql-op op)
arg1-acc (compile-value-expression empty-acc env rel arg1)
arg2-acc (compile-value-expression empty-acc env rel arg2)
arg3-acc (compile-value-expression empty-acc env rel arg3)]
{:query (-> query (into (:query arg1-acc)) (conj sql-op) (into (:query arg2-acc)) (conj "AND") (into (:query arg3-acc)))
:params (-> params (into (:params arg1-acc)) (into (:params arg2-acc)) (into (:params arg3-acc)))}))
(defmethod compile-value-expression :inclusion-operation [{:keys [query params]} env rel [_ {:keys [op column in]}]]
(let [[in-type in-payload] in
sql-op ({:in "IN" :not-in "NOT IN"} op)
column-acc (compile-value-expression empty-acc env rel column)
in-acc (if (= :value-expressions in-type)
(-> (reduce #(compile-value-expression %1 env rel %2) empty-acc in-payload)
(update :query #(str "(" (str/join ", " %) ")")))
(-> (compile-value-expression empty-acc env rel in)
(update :query #(str/join " " %))))]
{:query (-> query (into (:query column-acc)) (conj sql-op) (conj (:query in-acc)))
:params (-> params (into (:params column-acc)) (into (:params in-acc)))}))
(defmethod compile-value-expression :boolean [acc _ _ [_ value]]
(update acc :query conj (if value "TRUE" "FALSE")))
(defmethod compile-value-expression :negation [acc env rel [_ {:keys [_ arg1]}]]
(let [arg1-acc (compile-value-expression empty-acc env rel arg1)]
(-> acc
(update :query conj (str "NOT(" (str/join " " (:query arg1-acc)) ")"))
(update :params into (:params arg1-acc)))))
(defmethod compile-value-expression :connective [acc env rel [_ {:keys [op args]}]]
(if (= 1 (count args))
(compile-value-expression acc env rel (first args))
(let [sql-op (->SCREAMING_SNAKE_CASE_STRING op)
{:keys [query params]} (reduce
(fn [acc arg]
(-> acc
(compile-value-expression env rel arg)
(update :query conj sql-op)))
empty-acc
args)]
(-> acc
(update :params into params)
(update :query conj (str "(" (str/join " " (butlast query)) ")"))))))
(defmethod compile-value-expression :param [acc env rel [_ param-name]]
(let [param-getter (fn [param-values]
(when (not (contains? param-values param-name))
(throw (ex-info (str "Missing param " param-name) {:relation rel :param param-name})))
(get param-values param-name))]
(-> acc
(update :query conj "?")
(update :params conj param-getter))))
(defmethod compile-value-expression :parent-scope [acc env rel [_ {:keys [args]}]]
(let [parent-scope (last *scopes*)]
(when-not parent-scope
(throw (ex-info "Parent scope doesn't exist" {:relation rel})))
(binding [*scopes* (vec (drop-last *scopes*))]
(let [{:keys [env rel]} parent-scope]
(reduce
(fn [acc arg]
(let [{:keys [query params]} (compile-value-expression acc env rel arg)]
(-> acc
(update :params into params)
(update :query into query))))
acc
args)))))
(defmethod compile-value-expression :relation [acc env rel [_ inner-rel]]
(let [rel-alias-prefix (make-rel-alias-prefix env)
env' (-> env
(dissoc ::join-path-prefix)
(update ::relation-alias-prefix vec-conj rel-alias-prefix))
[query & params] (binding [*scopes* (conj *scopes* {:env env :rel rel})]
(format-query-without-params-resolution env' (assoc inner-rel :parent rel)))]
(-> acc
(update :query conj (str "(" query ")"))
(update :params into params))))
(defmethod compile-value-expression :fragment-literal [acc env rel [_ {:keys [fragment-literal args]}]]
(reduce
(fn [acc' arg]
(let [{:keys [params]} (compile-value-expression empty-acc env rel arg)]
(update acc' :params into params)))
(update acc :query conj fragment-literal)
args))
(defmethod compile-value-expression :fragment-fn [acc env rel [_ {:keys [fragment-fn args]}]]
(let [compiled-args (mapv
(fn [arg]
(let [{:keys [query params]} (compile-value-expression empty-acc env rel arg)]
(into [(str/join " " query)] params)))
args)
[query & params] (fragment-fn env rel compiled-args)]
(-> acc
(update :query conj query)
(update :params into params))))
(defmethod compile-value-expression :cast [acc env rel [_ {:keys [value cast-type]}]]
(let [{:keys [query params]} (compile-value-expression empty-acc env rel value)]
(-> acc
(update :params into params)
(update :query conj (str "CAST(" (str/join " " query) " AS " cast-type ")")))))
(defn compile-order-by [acc env rel order-by]
(let [{:keys [query params]}
(reduce
(fn [acc {:keys [column order-direction order-nulls]}]
(let [{:keys [query params]} (compile-value-expression empty-acc env rel column)
order (cond-> query
order-direction (conj ({:asc "ASC" :desc "DESC"} order-direction))
order-nulls (conj ({:nulls-first "NULLS FIRST" :nulls-last "NULLS LAST"} order-nulls)))]
(-> acc
(update :query conj (str/join " " order))
(update :params into params))))
empty-acc
order-by)]
(-> acc
(update :params into params)
(update :query conj (str "ORDER BY " (str/join ", " query))))))
(defn with-distinct [acc env rel]
(if-let [dist (:distinct rel)]
(if (boolean? dist)
(update acc :query conj "DISTINCT")
(let [{:keys [query params]} (reduce #(compile-value-expression %1 env rel %2) empty-acc dist)]
(-> acc
(update :params into params)
(update :query conj (str "DISTINCT ON(" (str/join ", " query) ")")))))
acc))
(defn compile-aggregate-projection-value-expression [acc env rel col-def]
(let [{:keys [query params]} (compile-value-expression empty-acc env rel (:value-expression col-def))]
(-> acc
(update :params into params)
(update :query conj (str/join " " query)))))
(defn compile-aggregate-projection-filter [acc env rel {agg-filter :filter}]
(if agg-filter
(let [{:keys [query params]} (compile-value-expression empty-acc env rel agg-filter)]
(-> acc
(update :params into params)
(update :query conj (str "FILTER(WHERE " (str/join " " query) ")"))))
acc))
(defn compile-aggregate-projection [acc env rel col-alias col-def]
(let [{:keys [query params]} (-> empty-acc
(compile-aggregate-projection-value-expression env rel col-def)
(compile-aggregate-projection-filter env rel col-def))]
(-> acc
(update :params into params)
(update :query conj (str (str/join " " query) " AS " (q col-alias))))))
(defn with-projection
([acc env rel]
(let [{:keys [query params]} (with-projection empty-acc env rel [])]
(-> acc
(update :query conj (str/join ", " query))
(update :params into params))))
([acc env rel path-prefix]
(let [projection (get-in rel [:projection])
acc' (reduce
(fn [acc alias]
(let [col-id (get-in rel [:aliases->ids alias])
col-def (get-in rel [:columns col-id])
path-prefix-names (mapv name path-prefix)
col-path (conj path-prefix-names (name alias))
col-alias (if (seq path-prefix) (path-prefix-join col-path) (name alias))
col-name (if (seq path-prefix) (path-prefix-join (rest col-path)) (:name col-def))
rel-alias (if (seq path-prefix) (first path-prefix-names) (get-rel-alias rel))
col-type (:type col-def)]
(cond
(or (seq path-prefix) (= col-type :concrete))
(update acc :query conj (str (q (get-rel-alias-with-prefix env rel-alias)) "." (q col-name) " AS " (q col-alias)))
(and (not (seq path-prefix)) (= :aggregate col-type))
(compile-aggregate-projection acc env rel col-alias col-def)
(and (not (seq path-prefix)) (= :computed col-type))
(let [{:keys [query params]} (compile-value-expression empty-acc env rel (:value-expression col-def))]
(-> acc
(update :params into params)
(update :query conj (str (str/join " " query) " AS " (q col-alias)))))
(and (not (seq path-prefix)) (= :window col-type))
(let [{:keys [value-expression partition-by order-by]} col-def
order-by-query-params (when order-by (compile-order-by empty-acc env rel order-by))
partition-by-query-params (when partition-by (reduce #(compile-value-expression %1 env rel %2) empty-acc partition-by))
{:keys [query params]} (compile-value-expression empty-acc env rel value-expression)]
(cond
(and partition-by-query-params order-by-query-params)
(-> acc
(update :params into params)
(update :params into (:params partition-by-query-params))
(update :params into (:params order-by-query-params))
(update :query conj (str/join " "
[(str/join " " query)
"OVER"
(str "("
"PARTITION BY " (str/join " " (:query partition-by-query-params))
" "
(str/join " " (:query order-by-query-params))
")")
"AS" (q col-alias)])))
partition-by-query-params
(-> acc
(update :params into params)
(update :params into (:params partition-by-query-params))
(update :query conj (str/join " "
[(str/join " " query)
"OVER"
(str "(" "PARTITION BY " (str/join " " (:query partition-by-query-params)) ")")
"AS" (q col-alias)])))
order-by-query-params
(-> acc
(update :params into params)
(update :params into (:params partition-by-query-params))
(update :params into (:params order-by-query-params))
(update :query conj (str/join " "
[(str/join " " query)
"OVER"
(str "(" (str/join " " (:query order-by-query-params)) ")")
"AS" (q col-alias)])))
:else
(-> acc
(update :params into params)
(update :query conj (str (str/join " " query) " OVER () AS " (q col-alias)))))))))
acc
(sort projection))]
(reduce-kv
(fn [acc' alias {:keys [relation]}]
(with-projection acc' env relation (conj path-prefix alias)))
acc'
(get-in rel [:joins])))))
(defn with-from [acc env rel]
(if-let [rel-query (get-in rel [:spec :query])]
(let [rel-alias-prefix (make-rel-alias-prefix env)
subquery-env (-> env
(update ::relation-alias-prefix vec-conj rel-alias-prefix))
[query & params] (if (fn? rel-query)
(binding [*scopes* (conj *scopes* {:env env :rel rel})]
(rel-query subquery-env))
rel-query)
rel-name (get-rel-alias rel)]
(-> acc
(update :params into params)
(update :query into ["FROM" (str "(" query ")") "AS" (q (get-rel-alias-with-prefix env rel-name))])))
(let [rel-name (get-rel-alias rel)]
(update acc :query into [(if (:only rel) "FROM ONLY" "FROM")
(get-schema-qualified-relation-name env rel)
"AS"
(q (get-rel-alias-with-prefix env rel-name))]))))
(defn with-joins
([acc env rel] (with-joins acc env rel []))
([acc env rel path-prefix]
(reduce-kv
(fn [acc' alias j]
(let [join-sql-type (get joins (:type j))
join-alias (->> (conj path-prefix alias) (map name) path-prefix-join)
join-relation (if (contains? #{:left-lateral :right-lateral} (:type j))
(assoc (:relation j) :parent rel)
(:relation j))
[join-query & join-params] (binding [*scopes* (conj *scopes* {:env env :rel rel})]
(format-query-without-params-resolution env join-relation))
join-clause [join-sql-type (str "(" join-query ")") (q (get-rel-alias-with-prefix env join-alias)) "ON"]
{:keys [query params]} (compile-value-expression {:query join-clause :params (vec join-params)} (assoc env ::join-path-prefix path-prefix) rel (:on j))]
(-> acc'
(update :params into params)
(update :query into query))))
acc
(get-in rel [:joins]))))
(defn with-where [acc env rel]
(if-let [where (:where rel)]
(-> acc
(update :query conj "WHERE")
(compile-value-expression env rel where))
acc))
(defn with-having [acc env rel]
(if-let [having (:having rel)]
(-> acc
(update :query conj "HAVING")
(compile-value-expression env rel having))
acc))
(defn with-group-by-and-having
([acc env rel]
(let [group-by-stats (reduce
(fn [acc alias]
(let [col-id (get-in rel [:aliases->ids alias])
col-def (get-in rel [:columns col-id])]
(if (= :aggregate (:type col-def))
(update acc :aggregate inc)
(update acc :group-by inc))))
{:aggregate 0
:group-by 0}
(:projection rel))]
(if (every? pos? (vals group-by-stats))
(let [{:keys [query params]} (with-group-by-and-having empty-acc env rel [])
acc' (-> acc
(update :query conj (str "GROUP BY " (str/join ", " query)))
(update :params into params))]
(with-having acc' env rel))
acc)))
([acc env rel path-prefix]
(let [projection (get-in rel [:projection])
acc' (reduce
(fn [acc alias]
(let [col-id (get-in rel [:aliases->ids alias])
col-def (get-in rel [:columns col-id])
path-prefix-names (mapv name path-prefix)
col-path (conj path-prefix-names (name alias))
col-name (if (seq path-prefix) (path-prefix-join (rest col-path)) (:name col-def))
rel-alias (if (seq path-prefix) (first path-prefix-names) (get-rel-alias rel))
col-type (:type col-def)]
(cond
(or (seq path-prefix) (= col-type :concrete))
(update acc :query conj (str (q (get-rel-alias-with-prefix env rel-alias)) "." (q col-name)))
(and (not (seq path-prefix)) (= :computed col-type))
(let [{:keys [query params]} (compile-value-expression empty-acc env rel (:value-expression col-def))]
(-> acc
(update :params into params)
(update :query conj (str (str/join " " query)))))
:else acc)))
acc
(sort projection))]
(reduce-kv
(fn [acc' alias {:keys [relation]}]
(with-group-by-and-having acc' env relation (conj path-prefix alias)))
acc'
(get-in rel [:joins])))))
(defn with-order-by [acc env rel]
(let [order-by (:order-by rel)]
(if (seq order-by)
(compile-order-by acc env rel order-by)
acc)))
(defn with-lock [acc env rel]
(let [{:keys [type rows]} (:lock rel)]
(cond-> acc
type (update :query conj (str "FOR " (-> type ->SCREAMING_SNAKE_CASE_STRING (str/replace #"_" " "))))
rows (update :query conj (-> rows ->SCREAMING_SNAKE_CASE_STRING (str/replace #"_" " "))))))
(defn with-offset [acc _ rel]
(if-let [offset (:offset rel)]
(update acc :query conj (str "OFFSET " offset))
acc))
(defn with-limit [acc _ rel]
(if-let [limit (:limit rel)]
(update acc :query conj (str "LIMIT " limit))
acc))
(defn format-query-without-params-resolution [env rel]
(let [{:keys [query params]} (-> {:query ["SELECT"] :params []}
(with-distinct env rel)
(with-projection env rel)
(with-from env rel)
(with-joins env rel)
(with-where env rel)
(with-group-by-and-having env rel)
(with-order-by env rel)
(with-lock env rel)
(with-offset env rel)
(with-limit env rel))]
(into [(str/join " " query)] params)))
(defn format-query [env rel param-values]
(let [[query & params] (format-query-without-params-resolution env rel)
resolved-params (if param-values (map (fn [p] (if (fn? p) (p param-values) p)) params) params)]
(into [query] resolved-params)))