Skip to content

Commit 9446193

Browse files
tathougieskmicklas
andauthored
Make sure lateral join names do not overlap (#647)
* Make sure lateral join names do not overlap * Fix typo for naming of laterally joined tables. Co-authored-by: Ken Micklas <[email protected]> Co-authored-by: Ken Micklas <[email protected]>
1 parent 6b3e4c9 commit 9446193

File tree

4 files changed

+83
-75
lines changed

4 files changed

+83
-75
lines changed

beam-core/Database/Beam/Query/Combinators.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -152,7 +152,7 @@ perhaps_ :: forall s r be db.
152152
-> Q be db s (Retag Nullable (WithRewrittenThread (QNested s) s r))
153153
perhaps_ (Q sub) =
154154
Q $ liftF (QArbitraryJoin
155-
sub leftJoin
155+
sub "" leftJoin
156156
(\_ -> Nothing)
157157
(\r -> retag (\(Columnar' (QExpr e) :: Columnar' (QExpr be s) a) ->
158158
Columnar' (QExpr e) :: Columnar' (Nullable (QExpr be s)) a) $
@@ -232,7 +232,7 @@ leftJoin_' :: forall s r be db.
232232
-> Q be db s (Retag Nullable (WithRewrittenThread (QNested s) s r))
233233
leftJoin_' (Q sub) on_ =
234234
Q $ liftF (QArbitraryJoin
235-
sub leftJoin
235+
sub "" leftJoin
236236
(\r -> let QExpr e = on_ (rewriteThread (Proxy @s) r) in Just e)
237237
(\r -> retag (\(Columnar' (QExpr e) :: Columnar' (QExpr be s) a) ->
238238
Columnar' (QExpr e) :: Columnar' (Nullable (QExpr be s)) a) $

beam-core/Database/Beam/Query/Internal.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,7 @@ data QF be (db :: (Type -> Type) -> Type) s next where
4747

4848
QArbitraryJoin :: Projectible be r
4949
=> QM be db (QNested s) r
50+
-> T.Text -- Table namespace
5051
-> (BeamSqlBackendFromSyntax be -> BeamSqlBackendFromSyntax be ->
5152
Maybe (BeamSqlBackendExpressionSyntax be) ->
5253
BeamSqlBackendFromSyntax be)

beam-core/Database/Beam/Query/SQL92.hs

Lines changed: 79 additions & 73 deletions
Original file line numberDiff line numberDiff line change
@@ -212,28 +212,29 @@ buildSql92Query' :: forall be db s a
212212
-> T.Text {-^ Table prefix -}
213213
-> Q be db s a
214214
-> 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))
217217
where
218218
be :: Proxy be
219219
be = Proxy
220220

221221
buildQuery :: forall s x
222222
. Projectible be x
223-
=> Free (QF be db s) x
223+
=> T.Text
224+
-> Free (QF be db s) x
224225
-> 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')
232233
(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)) =
235236
let (proj, qb, gp, hv) =
236-
case buildQuery (fromF q') of
237+
case buildQuery tblPfx (fromF q') of
237238
SelectBuilderQ proj qb ->
238239
( proj, qb, Nothing, Nothing)
239240
SelectBuilderGrouping proj qb gp hv Nothing ->
@@ -244,25 +245,25 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
244245
in case next proj of
245246
Pure x -> SelectBuilderGrouping x qb gp hv (Just (exprWithContext tblPfx (nubType proj)))
246247
_ -> 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')
250251
(groupingSyntax, aggProj) = mkAgg (sbProj sb) (nextTblPfx tblPfx)
251-
in case tryBuildGuardsOnly (next aggProj) Nothing of
252+
in case tryBuildGuardsOnly tblPfx (next aggProj) Nothing of
252253
Just (proj, having) ->
253254
case sb of
254255
SelectBuilderQ _ q'' -> SelectBuilderGrouping proj q'' groupingSyntax having Nothing
255256

256257
-- We'll have to generate a subselect
257258
_ -> let (subProj, qb) = selectBuilderToQueryBuilder tblPfx sb --(setSelectBuilderProjection sb aggProj)
258259
(groupingSyntax, aggProj') = mkAgg subProj (nextTblPfx tblPfx)
259-
in case tryBuildGuardsOnly (next aggProj') Nothing of
260+
in case tryBuildGuardsOnly tblPfx (next aggProj') Nothing of
260261
Nothing -> error "buildQuery (Free (QAggregate ...)): Impossible"
261262
Just (aggProj'', having') ->
262263
SelectBuilderGrouping aggProj'' qb groupingSyntax having' Nothing
263264
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
266267
(groupingSyntax', aggProj', qb) =
267268
case sb of
268269
SelectBuilderQ _ q'' -> (groupingSyntax, aggProj, q'')
@@ -271,10 +272,10 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
271272
in (groupingSyntax', aggProj', qb''')
272273
(x', qb') = selectBuilderToQueryBuilder tblPfx $
273274
SelectBuilderGrouping aggProj' qb groupingSyntax' having Nothing
274-
in buildJoinedQuery next' qb'
275+
in buildJoinedQuery tblPfx next' qb'
275276

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')
278279
proj = sbProj sb
279280
ordering = exprWithContext tblPfx (mkOrdering proj)
280281

@@ -296,7 +297,7 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
296297
| otherwise -> error "buildQuery (Free (QOrderBy ...)): query inspected expression"
297298

298299
(joinedProj, qb) = selectBuilderToQueryBuilder tblPfx sb'
299-
in buildJoinedQuery (next joinedProj) qb
300+
in buildJoinedQuery tblPfx (next joinedProj) qb
300301
in case next proj of
301302
Pure proj' ->
302303
case ordering of
@@ -320,8 +321,8 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
320321
| otherwise -> error "buildQuery (Free (QOrderBy ...)): query inspected expression"
321322
_ -> doJoined
322323

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')
325326

326327
x = sbProj sb
327328
windows = mkWindows x
@@ -334,34 +335,34 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
334335
sb' -> SelectBuilderTopLevel Nothing Nothing [] sb' Nothing
335336
_ ->
336337
let (x', qb) = selectBuilderToQueryBuilder tblPfx (setSelectBuilderProjection sb projection)
337-
in buildJoinedQuery (next x') qb
338+
in buildJoinedQuery tblPfx (next x') qb
338339

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'))
341342
x = sbProj sb
342343
-- In the case of limit, we must directly return whatever was given
343344
in case next x of
344345
Pure x' -> setSelectBuilderProjection sb x'
345346

346347
-- Otherwise, this is going to be part of a join...
347348
_ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb
348-
in buildJoinedQuery (next x') qb
349+
in buildJoinedQuery tblPfx (next x') qb
349350

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'))
352353
x = sbProj sb
353354
-- In the case of limit, we must directly return whatever was given
354355
in case next x of
355356
Pure x' -> setSelectBuilderProjection sb x'
356357
-- Otherwise, this is going to be part of a join...
357358
_ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb
358-
in buildJoinedQuery (next x') qb
359+
in buildJoinedQuery tblPfx (next x') qb
359360

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
362363

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)
365366
x = sbProj sb
366367

367368
selectStmt'' = selectStmt' (sbProj sb)
@@ -375,33 +376,36 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
375376
in case next (sbProj sb') of
376377
Pure x' -> setSelectBuilderProjection sb' x'
377378
_ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb'
378-
in buildJoinedQuery (next x') qb
379+
in buildJoinedQuery tblPfx (next x') qb
379380

380381
tryBuildGuardsOnly :: forall s x
381-
. Free (QF be db s) x
382+
. T.Text
383+
-> Free (QF be db s) x
382384
-> Maybe (BeamSqlBackendExpressionSyntax be)
383385
-> 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
386388
(Pure x, having') -> Just (x, having')
387389
_ -> Nothing
388390

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
391394
-> Maybe (BeamSqlBackendExpressionSyntax be)
392395
-> (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)
395398

396399
buildTableCombination
397400
:: forall s x r
398401
. ( Projectible be r, Projectible be x )
399-
=> (BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be)
402+
=> T.Text
403+
-> (BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be)
400404
-> 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)
403407
leftTb = selectBuilderToTableSource tblPfx leftSb
404-
rightSb = buildQuery (fromF right)
408+
rightSb = buildQuery tblPfx (fromF right)
405409
rightTb = selectBuilderToTableSource tblPfx rightSb
406410

407411
proj = reproject be (fieldNameFunc unqualifiedField) (sbProj leftSb)
@@ -423,16 +427,16 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
423427
| projOrder be proj (nextTblPfx tblPfx) == projOrder be proj' (nextTblPfx tblPfx) ->
424428
setSelectBuilderProjection sb proj'
425429
_ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb
426-
in buildJoinedQuery (next x') qb
430+
in buildJoinedQuery tblPfx (next x') qb
427431

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 =
433437
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 =
436440
case fromF q of
437441
Free (QAll mkDbFrom dbMkTbl on' next')
438442
| (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbMkTbl,
@@ -444,10 +448,12 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
444448
case qbFrom qb' of
445449
Nothing -> (Just newSource, andE' (qbWhere qb) on'')
446450
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' })
448452

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
451457
newTblNm = tblPfx <> fromString (show (qbNextTblRef qb))
452458

453459
newSource = fromTable (tableFromSubSelect tblSource) (Just (newTblNm, Nothing))
@@ -460,17 +466,17 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
460466
Nothing -> (Just newSource, andE' (qbWhere qb) on')
461467
Just oldFrom -> (Just (mkJoin oldFrom newSource on'), qbWhere qb)
462468

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 =
466472
let (aProj, aSource, qb') =
467473
case fromF a of
468474
Free (QAll mkDbFrom dbMkTbl on' next')
469475
| (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbMkTbl,
470476
Nothing <- on' newTbl, Pure proj <- next' (newTblNm, newTbl) ->
471477
(proj, mkDbFrom (nextTblPfx tblPfx) newTblNm, qb')
472478

473-
a -> let sb = buildQuery a
479+
a -> let sb = buildQuery tblPfx a
474480
tblSource = buildSelect tblPfx sb
475481

476482
newTblNm = tblPfx <> fromString (show (qbNextTblRef qb))
@@ -485,7 +491,7 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
485491
Nothing <- on' newTbl, Pure proj <- next' (newTblNm, newTbl) ->
486492
(proj, mkDbFrom (nextTblPfx tblPfx) newTblNm, qb'')
487493

488-
b -> let sb = buildQuery b
494+
b -> let sb = buildQuery tblPfx b
489495
tblSource = buildSelect tblPfx sb
490496

491497
newTblNm = tblPfx <> fromString (show (qbNextTblRef qb))
@@ -500,16 +506,16 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
500506
Nothing -> Just abSource
501507
Just oldFrom -> Just (innerJoin oldFrom abSource Nothing)
502508

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 =
507513
onlyQ now
508514
(\now' next ->
509-
let sb = buildQuery now'
515+
let sb = buildQuery tblPfx now'
510516
tblSource = buildSelect tblPfx sb
511517
(x', qb') = buildJoinTableSourceQuery tblPfx tblSource (sbProj sb) qb
512-
in buildJoinedQuery (next x') qb')
518+
in buildJoinedQuery tblPfx (next x') qb')
513519

514520
onlyQ :: forall s x.
515521
Free (QF be db s) x
@@ -518,8 +524,8 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
518524
onlyQ (Free (QAll entityNm mkTbl mkOn next)) f =
519525
f (Free (QAll entityNm mkTbl mkOn (Pure . PreserveLeft))) (next . unPreserveLeft)
520526
-- 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
523529
onlyQ (Free (QTwoWayJoin a b mkJoin mkOn next)) f =
524530
f (Free (QTwoWayJoin a b mkJoin mkOn Pure)) next
525531
onlyQ (Free (QSubSelect q' next)) f =

beam-postgres/Database/Beam/Postgres/Full.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -260,6 +260,7 @@ lateral_ :: forall s a b db
260260
lateral_ using mkSubquery = do
261261
let Q subquery = mkSubquery (rewriteThread (Proxy @(QNested s)) using)
262262
Q (liftF (QArbitraryJoin subquery
263+
"lat_"
263264
(\a b on' ->
264265
case on' of
265266
Nothing ->

0 commit comments

Comments
 (0)