@@ -212,28 +212,29 @@ buildSql92Query' :: forall be db s a
212
212
-> T. Text {-^ Table prefix -}
213
213
-> Q be db s a
214
214
-> BeamSqlBackendSelectSyntax be
215
- buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
216
- buildSelect tblPfx (buildQuery (fromF q))
215
+ buildSql92Query' arbitrarilyNestedCombinations baseTblPfx (Q q) =
216
+ buildSelect baseTblPfx (buildQuery baseTblPfx (fromF q))
217
217
where
218
218
be :: Proxy be
219
219
be = Proxy
220
220
221
221
buildQuery :: forall s x
222
222
. Projectible be x
223
- => Free (QF be db s ) x
223
+ => T. Text
224
+ -> Free (QF be db s ) x
224
225
-> SelectBuilder be db x
225
- buildQuery (Pure x) = SelectBuilderQ x emptyQb
226
- buildQuery (Free (QGuard _ next)) = buildQuery next
227
- buildQuery f@ (Free QAll {}) = buildJoinedQuery f emptyQb
228
- buildQuery f@ (Free QArbitraryJoin {}) = buildJoinedQuery f emptyQb
229
- buildQuery f@ (Free QTwoWayJoin {}) = buildJoinedQuery f emptyQb
230
- buildQuery (Free (QSubSelect q' next)) =
231
- let sb = buildQuery (fromF q')
226
+ buildQuery _ (Pure x) = SelectBuilderQ x emptyQb
227
+ buildQuery tblPfx (Free (QGuard _ next)) = buildQuery tblPfx next
228
+ buildQuery tblPfx f@ (Free QAll {}) = buildJoinedQuery tblPfx f emptyQb
229
+ buildQuery tblPfx f@ (Free QArbitraryJoin {}) = buildJoinedQuery tblPfx f emptyQb
230
+ buildQuery tblPfx f@ (Free QTwoWayJoin {}) = buildJoinedQuery tblPfx f emptyQb
231
+ buildQuery tblPfx (Free (QSubSelect q' next)) =
232
+ let sb = buildQuery tblPfx (fromF q')
232
233
(proj, qb) = selectBuilderToQueryBuilder tblPfx sb
233
- in buildJoinedQuery (next proj) qb
234
- buildQuery (Free (QDistinct nubType q' next)) =
234
+ in buildJoinedQuery tblPfx (next proj) qb
235
+ buildQuery tblPfx (Free (QDistinct nubType q' next)) =
235
236
let (proj, qb, gp, hv) =
236
- case buildQuery (fromF q') of
237
+ case buildQuery tblPfx (fromF q') of
237
238
SelectBuilderQ proj qb ->
238
239
( proj, qb, Nothing , Nothing )
239
240
SelectBuilderGrouping proj qb gp hv Nothing ->
@@ -244,25 +245,25 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
244
245
in case next proj of
245
246
Pure x -> SelectBuilderGrouping x qb gp hv (Just (exprWithContext tblPfx (nubType proj)))
246
247
_ -> let ( proj', qb' ) = selectBuilderToQueryBuilder tblPfx (SelectBuilderGrouping proj qb gp hv (Just (exprWithContext tblPfx (nubType proj))))
247
- in buildJoinedQuery (next proj') qb'
248
- buildQuery (Free (QAggregate mkAgg q' next)) =
249
- let sb = buildQuery (fromF q')
248
+ in buildJoinedQuery tblPfx (next proj') qb'
249
+ buildQuery tblPfx (Free (QAggregate mkAgg q' next)) =
250
+ let sb = buildQuery tblPfx (fromF q')
250
251
(groupingSyntax, aggProj) = mkAgg (sbProj sb) (nextTblPfx tblPfx)
251
- in case tryBuildGuardsOnly (next aggProj) Nothing of
252
+ in case tryBuildGuardsOnly tblPfx (next aggProj) Nothing of
252
253
Just (proj, having) ->
253
254
case sb of
254
255
SelectBuilderQ _ q'' -> SelectBuilderGrouping proj q'' groupingSyntax having Nothing
255
256
256
257
-- We'll have to generate a subselect
257
258
_ -> let (subProj, qb) = selectBuilderToQueryBuilder tblPfx sb -- (setSelectBuilderProjection sb aggProj)
258
259
(groupingSyntax, aggProj') = mkAgg subProj (nextTblPfx tblPfx)
259
- in case tryBuildGuardsOnly (next aggProj') Nothing of
260
+ in case tryBuildGuardsOnly tblPfx (next aggProj') Nothing of
260
261
Nothing -> error " buildQuery (Free (QAggregate ...)): Impossible"
261
262
Just (aggProj'', having') ->
262
263
SelectBuilderGrouping aggProj'' qb groupingSyntax having' Nothing
263
264
Nothing ->
264
- let (_, having) = tryCollectHaving (next aggProj') Nothing
265
- (next', _) = tryCollectHaving (next x') Nothing
265
+ let (_, having) = tryCollectHaving tblPfx (next aggProj') Nothing
266
+ (next', _) = tryCollectHaving tblPfx (next x') Nothing
266
267
(groupingSyntax', aggProj', qb) =
267
268
case sb of
268
269
SelectBuilderQ _ q'' -> (groupingSyntax, aggProj, q'')
@@ -271,10 +272,10 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
271
272
in (groupingSyntax', aggProj', qb''')
272
273
(x', qb') = selectBuilderToQueryBuilder tblPfx $
273
274
SelectBuilderGrouping aggProj' qb groupingSyntax' having Nothing
274
- in buildJoinedQuery next' qb'
275
+ in buildJoinedQuery tblPfx next' qb'
275
276
276
- buildQuery (Free (QOrderBy mkOrdering q' next)) =
277
- let sb = buildQuery (fromF q')
277
+ buildQuery tblPfx (Free (QOrderBy mkOrdering q' next)) =
278
+ let sb = buildQuery tblPfx (fromF q')
278
279
proj = sbProj sb
279
280
ordering = exprWithContext tblPfx (mkOrdering proj)
280
281
@@ -296,7 +297,7 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
296
297
| otherwise -> error " buildQuery (Free (QOrderBy ...)): query inspected expression"
297
298
298
299
(joinedProj, qb) = selectBuilderToQueryBuilder tblPfx sb'
299
- in buildJoinedQuery (next joinedProj) qb
300
+ in buildJoinedQuery tblPfx (next joinedProj) qb
300
301
in case next proj of
301
302
Pure proj' ->
302
303
case ordering of
@@ -320,8 +321,8 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
320
321
| otherwise -> error " buildQuery (Free (QOrderBy ...)): query inspected expression"
321
322
_ -> doJoined
322
323
323
- buildQuery (Free (QWindowOver mkWindows mkProjection q' next)) =
324
- let sb = buildQuery (fromF q')
324
+ buildQuery tblPfx (Free (QWindowOver mkWindows mkProjection q' next)) =
325
+ let sb = buildQuery tblPfx (fromF q')
325
326
326
327
x = sbProj sb
327
328
windows = mkWindows x
@@ -334,34 +335,34 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
334
335
sb' -> SelectBuilderTopLevel Nothing Nothing [] sb' Nothing
335
336
_ ->
336
337
let (x', qb) = selectBuilderToQueryBuilder tblPfx (setSelectBuilderProjection sb projection)
337
- in buildJoinedQuery (next x') qb
338
+ in buildJoinedQuery tblPfx (next x') qb
338
339
339
- buildQuery (Free (QLimit limit q' next)) =
340
- let sb = limitSelectBuilder limit (buildQuery (fromF q'))
340
+ buildQuery tblPfx (Free (QLimit limit q' next)) =
341
+ let sb = limitSelectBuilder limit (buildQuery tblPfx (fromF q'))
341
342
x = sbProj sb
342
343
-- In the case of limit, we must directly return whatever was given
343
344
in case next x of
344
345
Pure x' -> setSelectBuilderProjection sb x'
345
346
346
347
-- Otherwise, this is going to be part of a join...
347
348
_ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb
348
- in buildJoinedQuery (next x') qb
349
+ in buildJoinedQuery tblPfx (next x') qb
349
350
350
- buildQuery (Free (QOffset offset q' next)) =
351
- let sb = offsetSelectBuilder offset (buildQuery (fromF q'))
351
+ buildQuery tblPfx (Free (QOffset offset q' next)) =
352
+ let sb = offsetSelectBuilder offset (buildQuery tblPfx (fromF q'))
352
353
x = sbProj sb
353
354
-- In the case of limit, we must directly return whatever was given
354
355
in case next x of
355
356
Pure x' -> setSelectBuilderProjection sb x'
356
357
-- Otherwise, this is going to be part of a join...
357
358
_ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb
358
- in buildJoinedQuery (next x') qb
359
+ in buildJoinedQuery tblPfx (next x') qb
359
360
360
- buildQuery (Free (QSetOp combine left right next)) =
361
- buildTableCombination combine left right next
361
+ buildQuery tblPfx (Free (QSetOp combine left right next)) =
362
+ buildTableCombination tblPfx combine left right next
362
363
363
- buildQuery (Free (QForceSelect selectStmt' over next)) =
364
- let sb = buildQuery (fromF over)
364
+ buildQuery tblPfx (Free (QForceSelect selectStmt' over next)) =
365
+ let sb = buildQuery tblPfx (fromF over)
365
366
x = sbProj sb
366
367
367
368
selectStmt'' = selectStmt' (sbProj sb)
@@ -375,33 +376,36 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
375
376
in case next (sbProj sb') of
376
377
Pure x' -> setSelectBuilderProjection sb' x'
377
378
_ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb'
378
- in buildJoinedQuery (next x') qb
379
+ in buildJoinedQuery tblPfx (next x') qb
379
380
380
381
tryBuildGuardsOnly :: forall s x
381
- . Free (QF be db s ) x
382
+ . T. Text
383
+ -> Free (QF be db s ) x
382
384
-> Maybe (BeamSqlBackendExpressionSyntax be )
383
385
-> Maybe (x , Maybe (BeamSqlBackendExpressionSyntax be ))
384
- tryBuildGuardsOnly next having =
385
- case tryCollectHaving next having of
386
+ tryBuildGuardsOnly tblPfx next having =
387
+ case tryCollectHaving tblPfx next having of
386
388
(Pure x, having') -> Just (x, having')
387
389
_ -> Nothing
388
390
389
- tryCollectHaving :: forall s x .
390
- Free (QF be db s ) x
391
+ tryCollectHaving :: forall s x
392
+ . T. Text
393
+ -> Free (QF be db s ) x
391
394
-> Maybe (BeamSqlBackendExpressionSyntax be )
392
395
-> (Free (QF be db s ) x , Maybe (BeamSqlBackendExpressionSyntax be ))
393
- tryCollectHaving (Free (QGuard cond next)) having = tryCollectHaving next (andE' having (Just (exprWithContext tblPfx cond)))
394
- tryCollectHaving next having = (next, having)
396
+ tryCollectHaving tblPfx (Free (QGuard cond next)) having = tryCollectHaving tblPfx next (andE' having (Just (exprWithContext tblPfx cond)))
397
+ tryCollectHaving _ next having = (next, having)
395
398
396
399
buildTableCombination
397
400
:: forall s x r
398
401
. ( Projectible be r , Projectible be x )
399
- => (BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be )
402
+ => T. Text
403
+ -> (BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be )
400
404
-> QM be db (QNested s ) x -> QM be db (QNested s ) x -> (x -> Free (QF be db s ) r ) -> SelectBuilder be db r
401
- buildTableCombination combineTables left right next =
402
- let leftSb = buildQuery (fromF left)
405
+ buildTableCombination tblPfx combineTables left right next =
406
+ let leftSb = buildQuery tblPfx (fromF left)
403
407
leftTb = selectBuilderToTableSource tblPfx leftSb
404
- rightSb = buildQuery (fromF right)
408
+ rightSb = buildQuery tblPfx (fromF right)
405
409
rightTb = selectBuilderToTableSource tblPfx rightSb
406
410
407
411
proj = reproject be (fieldNameFunc unqualifiedField) (sbProj leftSb)
@@ -423,16 +427,16 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
423
427
| projOrder be proj (nextTblPfx tblPfx) == projOrder be proj' (nextTblPfx tblPfx) ->
424
428
setSelectBuilderProjection sb proj'
425
429
_ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb
426
- in buildJoinedQuery (next x') qb
430
+ in buildJoinedQuery tblPfx (next x') qb
427
431
428
- buildJoinedQuery :: forall s x .
429
- Projectible be x =>
430
- Free (QF be db s ) x -> QueryBuilder be -> SelectBuilder be db x
431
- buildJoinedQuery (Pure x) qb = SelectBuilderQ x qb
432
- buildJoinedQuery (Free (QAll mkFrom mkTbl on next)) qb =
432
+ buildJoinedQuery :: forall s x
433
+ . Projectible be x
434
+ => T. Text -> Free (QF be db s ) x -> QueryBuilder be -> SelectBuilder be db x
435
+ buildJoinedQuery _ (Pure x) qb = SelectBuilderQ x qb
436
+ buildJoinedQuery tblPfx (Free (QAll mkFrom mkTbl on next)) qb =
433
437
let (newTblNm, newTbl, qb') = buildInnerJoinQuery tblPfx mkFrom mkTbl on qb
434
- in buildJoinedQuery (next (newTblNm, newTbl)) qb'
435
- buildJoinedQuery (Free (QArbitraryJoin q mkJoin on next)) qb =
438
+ in buildJoinedQuery tblPfx (next (newTblNm, newTbl)) qb'
439
+ buildJoinedQuery tblPfx (Free (QArbitraryJoin q tblNs mkJoin on next)) qb =
436
440
case fromF q of
437
441
Free (QAll mkDbFrom dbMkTbl on' next')
438
442
| (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbMkTbl,
@@ -444,10 +448,12 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
444
448
case qbFrom qb' of
445
449
Nothing -> (Just newSource, andE' (qbWhere qb) on'')
446
450
Just oldFrom -> (Just (mkJoin oldFrom newSource on''), qbWhere qb)
447
- in buildJoinedQuery (next proj) (qb' { qbFrom = from', qbWhere = where' })
451
+ in buildJoinedQuery tblPfx (next proj) (qb' { qbFrom = from', qbWhere = where' })
448
452
449
- q' -> let sb = buildQuery q'
450
- tblSource = buildSelect tblPfx sb
453
+ q' -> let tblPfx' = tblPfx <> tblNs
454
+
455
+ sb = buildQuery tblPfx' q'
456
+ tblSource = buildSelect tblPfx' sb
451
457
newTblNm = tblPfx <> fromString (show (qbNextTblRef qb))
452
458
453
459
newSource = fromTable (tableFromSubSelect tblSource) (Just (newTblNm, Nothing ))
@@ -460,17 +466,17 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
460
466
Nothing -> (Just newSource, andE' (qbWhere qb) on')
461
467
Just oldFrom -> (Just (mkJoin oldFrom newSource on'), qbWhere qb)
462
468
463
- in buildJoinedQuery (next proj') (qb { qbNextTblRef = qbNextTblRef qb + 1
464
- , qbFrom = from', qbWhere = where' })
465
- buildJoinedQuery (Free (QTwoWayJoin a b mkJoin on next)) qb =
469
+ in buildJoinedQuery tblPfx (next proj') (qb { qbNextTblRef = qbNextTblRef qb + 1
470
+ , qbFrom = from', qbWhere = where' })
471
+ buildJoinedQuery tblPfx (Free (QTwoWayJoin a b mkJoin on next)) qb =
466
472
let (aProj, aSource, qb') =
467
473
case fromF a of
468
474
Free (QAll mkDbFrom dbMkTbl on' next')
469
475
| (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbMkTbl,
470
476
Nothing <- on' newTbl, Pure proj <- next' (newTblNm, newTbl) ->
471
477
(proj, mkDbFrom (nextTblPfx tblPfx) newTblNm, qb')
472
478
473
- a -> let sb = buildQuery a
479
+ a -> let sb = buildQuery tblPfx a
474
480
tblSource = buildSelect tblPfx sb
475
481
476
482
newTblNm = tblPfx <> fromString (show (qbNextTblRef qb))
@@ -485,7 +491,7 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
485
491
Nothing <- on' newTbl, Pure proj <- next' (newTblNm, newTbl) ->
486
492
(proj, mkDbFrom (nextTblPfx tblPfx) newTblNm, qb'')
487
493
488
- b -> let sb = buildQuery b
494
+ b -> let sb = buildQuery tblPfx b
489
495
tblSource = buildSelect tblPfx sb
490
496
491
497
newTblNm = tblPfx <> fromString (show (qbNextTblRef qb))
@@ -500,16 +506,16 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
500
506
Nothing -> Just abSource
501
507
Just oldFrom -> Just (innerJoin oldFrom abSource Nothing )
502
508
503
- in buildJoinedQuery (next (aProj, bProj)) (qb'' { qbFrom = from' })
504
- buildJoinedQuery (Free (QGuard cond next)) qb =
505
- buildJoinedQuery next (qb { qbWhere = andE' (qbWhere qb) (Just (exprWithContext tblPfx cond)) })
506
- buildJoinedQuery now qb =
509
+ in buildJoinedQuery tblPfx (next (aProj, bProj)) (qb'' { qbFrom = from' })
510
+ buildJoinedQuery tblPfx (Free (QGuard cond next)) qb =
511
+ buildJoinedQuery tblPfx next (qb { qbWhere = andE' (qbWhere qb) (Just (exprWithContext tblPfx cond)) })
512
+ buildJoinedQuery tblPfx now qb =
507
513
onlyQ now
508
514
(\ now' next ->
509
- let sb = buildQuery now'
515
+ let sb = buildQuery tblPfx now'
510
516
tblSource = buildSelect tblPfx sb
511
517
(x', qb') = buildJoinTableSourceQuery tblPfx tblSource (sbProj sb) qb
512
- in buildJoinedQuery (next x') qb')
518
+ in buildJoinedQuery tblPfx (next x') qb')
513
519
514
520
onlyQ :: forall s x .
515
521
Free (QF be db s ) x
@@ -518,8 +524,8 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
518
524
onlyQ (Free (QAll entityNm mkTbl mkOn next)) f =
519
525
f (Free (QAll entityNm mkTbl mkOn (Pure . PreserveLeft ))) (next . unPreserveLeft)
520
526
-- f (Free (QAll entityNm mkTbl mkOn (Pure . PreserveLeft))) (next . unPreserveLeft)
521
- onlyQ (Free (QArbitraryJoin entity mkJoin mkOn next)) f =
522
- f (Free (QArbitraryJoin entity mkJoin mkOn Pure )) next
527
+ onlyQ (Free (QArbitraryJoin entity tblNs mkJoin mkOn next)) f =
528
+ f (Free (QArbitraryJoin entity tblNs mkJoin mkOn Pure )) next
523
529
onlyQ (Free (QTwoWayJoin a b mkJoin mkOn next)) f =
524
530
f (Free (QTwoWayJoin a b mkJoin mkOn Pure )) next
525
531
onlyQ (Free (QSubSelect q' next)) f =
0 commit comments