Skip to content

Commit

Permalink
Make sure lateral join names do not overlap (#647)
Browse files Browse the repository at this point in the history 
* 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]>
  • Loading branch information
@tathougies @kmicklas
tathougies and kmicklas authored Jan 3, 2023
1 parent 6b3e4c9 commit 9446193
Show file tree
Hide file tree
Showing 4 changed files with 83 additions and 75 deletions.
4 changes: 2 additions & 2 deletions beam-core/Database/Beam/Query/Combinators.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -152,7 +152,7 @@ perhaps_ :: forall s r be db.
-> Q be db s (Retag Nullable (WithRewrittenThread (QNested s) s r))
perhaps_ (Q sub) =
Q $ liftF (QArbitraryJoin
sub leftJoin
sub "" leftJoin
(\_ -> Nothing)
(\r -> retag (\(Columnar' (QExpr e) :: Columnar' (QExpr be s) a) ->
Columnar' (QExpr e) :: Columnar' (Nullable (QExpr be s)) a) $
Expand Down Expand Up @@ -232,7 +232,7 @@ leftJoin_' :: forall s r be db.
-> Q be db s (Retag Nullable (WithRewrittenThread (QNested s) s r))
leftJoin_' (Q sub) on_ =
Q $ liftF (QArbitraryJoin
sub leftJoin
sub "" leftJoin
(\r -> let QExpr e = on_ (rewriteThread (Proxy @s) r) in Just e)
(\r -> retag (\(Columnar' (QExpr e) :: Columnar' (QExpr be s) a) ->
Columnar' (QExpr e) :: Columnar' (Nullable (QExpr be s)) a) $
Expand Down
1 change: 1 addition & 0 deletions beam-core/Database/Beam/Query/Internal.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,7 @@ data QF be (db :: (Type -> Type) -> Type) s next where

QArbitraryJoin :: Projectible be r
=> QM be db (QNested s) r
-> T.Text -- Table namespace
-> (BeamSqlBackendFromSyntax be -> BeamSqlBackendFromSyntax be ->
Maybe (BeamSqlBackendExpressionSyntax be) ->
BeamSqlBackendFromSyntax be)
Expand Down
152 changes: 79 additions & 73 deletions beam-core/Database/Beam/Query/SQL92.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -212,28 +212,29 @@ buildSql92Query' :: forall be db s a
-> T.Text {-^ Table prefix -}
-> Q be db s a
-> BeamSqlBackendSelectSyntax be
buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
buildSelect tblPfx (buildQuery (fromF q))
buildSql92Query' arbitrarilyNestedCombinations baseTblPfx (Q q) =
buildSelect baseTblPfx (buildQuery baseTblPfx (fromF q))
where
be :: Proxy be
be = Proxy

buildQuery :: forall s x
. Projectible be x
=> Free (QF be db s) x
=> T.Text
-> Free (QF be db s) x
-> SelectBuilder be db x
buildQuery (Pure x) = SelectBuilderQ x emptyQb
buildQuery (Free (QGuard _ next)) = buildQuery next
buildQuery f@(Free QAll {}) = buildJoinedQuery f emptyQb
buildQuery f@(Free QArbitraryJoin {}) = buildJoinedQuery f emptyQb
buildQuery f@(Free QTwoWayJoin {}) = buildJoinedQuery f emptyQb
buildQuery (Free (QSubSelect q' next)) =
let sb = buildQuery (fromF q')
buildQuery _ (Pure x) = SelectBuilderQ x emptyQb
buildQuery tblPfx (Free (QGuard _ next)) = buildQuery tblPfx next
buildQuery tblPfx f@(Free QAll {}) = buildJoinedQuery tblPfx f emptyQb
buildQuery tblPfx f@(Free QArbitraryJoin {}) = buildJoinedQuery tblPfx f emptyQb
buildQuery tblPfx f@(Free QTwoWayJoin {}) = buildJoinedQuery tblPfx f emptyQb
buildQuery tblPfx (Free (QSubSelect q' next)) =
let sb = buildQuery tblPfx (fromF q')
(proj, qb) = selectBuilderToQueryBuilder tblPfx sb
in buildJoinedQuery (next proj) qb
buildQuery (Free (QDistinct nubType q' next)) =
in buildJoinedQuery tblPfx (next proj) qb
buildQuery tblPfx (Free (QDistinct nubType q' next)) =
let (proj, qb, gp, hv) =
case buildQuery (fromF q') of
case buildQuery tblPfx (fromF q') of
SelectBuilderQ proj qb ->
( proj, qb, Nothing, Nothing)
SelectBuilderGrouping proj qb gp hv Nothing ->
Expand All @@ -244,25 +245,25 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
in case next proj of
Pure x -> SelectBuilderGrouping x qb gp hv (Just (exprWithContext tblPfx (nubType proj)))
_ -> let ( proj', qb' ) = selectBuilderToQueryBuilder tblPfx (SelectBuilderGrouping proj qb gp hv (Just (exprWithContext tblPfx (nubType proj))))
in buildJoinedQuery (next proj') qb'
buildQuery (Free (QAggregate mkAgg q' next)) =
let sb = buildQuery (fromF q')
in buildJoinedQuery tblPfx (next proj') qb'
buildQuery tblPfx (Free (QAggregate mkAgg q' next)) =
let sb = buildQuery tblPfx (fromF q')
(groupingSyntax, aggProj) = mkAgg (sbProj sb) (nextTblPfx tblPfx)
in case tryBuildGuardsOnly (next aggProj) Nothing of
in case tryBuildGuardsOnly tblPfx (next aggProj) Nothing of
Just (proj, having) ->
case sb of
SelectBuilderQ _ q'' -> SelectBuilderGrouping proj q'' groupingSyntax having Nothing

-- We'll have to generate a subselect
_ -> let (subProj, qb) = selectBuilderToQueryBuilder tblPfx sb --(setSelectBuilderProjection sb aggProj)
(groupingSyntax, aggProj') = mkAgg subProj (nextTblPfx tblPfx)
in case tryBuildGuardsOnly (next aggProj') Nothing of
in case tryBuildGuardsOnly tblPfx (next aggProj') Nothing of
Nothing -> error "buildQuery (Free (QAggregate ...)): Impossible"
Just (aggProj'', having') ->
SelectBuilderGrouping aggProj'' qb groupingSyntax having' Nothing
Nothing ->
let (_, having) = tryCollectHaving (next aggProj') Nothing
(next', _) = tryCollectHaving (next x') Nothing
let (_, having) = tryCollectHaving tblPfx (next aggProj') Nothing
(next', _) = tryCollectHaving tblPfx (next x') Nothing
(groupingSyntax', aggProj', qb) =
case sb of
SelectBuilderQ _ q'' -> (groupingSyntax, aggProj, q'')
Expand All @@ -271,10 +272,10 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
in (groupingSyntax', aggProj', qb''')
(x', qb') = selectBuilderToQueryBuilder tblPfx $
SelectBuilderGrouping aggProj' qb groupingSyntax' having Nothing
in buildJoinedQuery next' qb'
in buildJoinedQuery tblPfx next' qb'

buildQuery (Free (QOrderBy mkOrdering q' next)) =
let sb = buildQuery (fromF q')
buildQuery tblPfx (Free (QOrderBy mkOrdering q' next)) =
let sb = buildQuery tblPfx (fromF q')
proj = sbProj sb
ordering = exprWithContext tblPfx (mkOrdering proj)

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

(joinedProj, qb) = selectBuilderToQueryBuilder tblPfx sb'
in buildJoinedQuery (next joinedProj) qb
in buildJoinedQuery tblPfx (next joinedProj) qb
in case next proj of
Pure proj' ->
case ordering of
Expand All @@ -320,8 +321,8 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
| otherwise -> error "buildQuery (Free (QOrderBy ...)): query inspected expression"
_ -> doJoined

buildQuery (Free (QWindowOver mkWindows mkProjection q' next)) =
let sb = buildQuery (fromF q')
buildQuery tblPfx (Free (QWindowOver mkWindows mkProjection q' next)) =
let sb = buildQuery tblPfx (fromF q')

x = sbProj sb
windows = mkWindows x
Expand All @@ -334,34 +335,34 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
sb' -> SelectBuilderTopLevel Nothing Nothing [] sb' Nothing
_ ->
let (x', qb) = selectBuilderToQueryBuilder tblPfx (setSelectBuilderProjection sb projection)
in buildJoinedQuery (next x') qb
in buildJoinedQuery tblPfx (next x') qb

buildQuery (Free (QLimit limit q' next)) =
let sb = limitSelectBuilder limit (buildQuery (fromF q'))
buildQuery tblPfx (Free (QLimit limit q' next)) =
let sb = limitSelectBuilder limit (buildQuery tblPfx (fromF q'))
x = sbProj sb
-- In the case of limit, we must directly return whatever was given
in case next x of
Pure x' -> setSelectBuilderProjection sb x'

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

buildQuery (Free (QOffset offset q' next)) =
let sb = offsetSelectBuilder offset (buildQuery (fromF q'))
buildQuery tblPfx (Free (QOffset offset q' next)) =
let sb = offsetSelectBuilder offset (buildQuery tblPfx (fromF q'))
x = sbProj sb
-- In the case of limit, we must directly return whatever was given
in case next x of
Pure x' -> setSelectBuilderProjection sb x'
-- Otherwise, this is going to be part of a join...
_ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb
in buildJoinedQuery (next x') qb
in buildJoinedQuery tblPfx (next x') qb

buildQuery (Free (QSetOp combine left right next)) =
buildTableCombination combine left right next
buildQuery tblPfx (Free (QSetOp combine left right next)) =
buildTableCombination tblPfx combine left right next

buildQuery (Free (QForceSelect selectStmt' over next)) =
let sb = buildQuery (fromF over)
buildQuery tblPfx (Free (QForceSelect selectStmt' over next)) =
let sb = buildQuery tblPfx (fromF over)
x = sbProj sb

selectStmt'' = selectStmt' (sbProj sb)
Expand All @@ -375,33 +376,36 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
in case next (sbProj sb') of
Pure x' -> setSelectBuilderProjection sb' x'
_ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb'
in buildJoinedQuery (next x') qb
in buildJoinedQuery tblPfx (next x') qb

tryBuildGuardsOnly :: forall s x
. Free (QF be db s) x
. T.Text
-> Free (QF be db s) x
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe (x, Maybe (BeamSqlBackendExpressionSyntax be))
tryBuildGuardsOnly next having =
case tryCollectHaving next having of
tryBuildGuardsOnly tblPfx next having =
case tryCollectHaving tblPfx next having of
(Pure x, having') -> Just (x, having')
_ -> Nothing

tryCollectHaving :: forall s x.
Free (QF be db s) x
tryCollectHaving :: forall s x
. T.Text
-> Free (QF be db s) x
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> (Free (QF be db s) x, Maybe (BeamSqlBackendExpressionSyntax be))
tryCollectHaving (Free (QGuard cond next)) having = tryCollectHaving next (andE' having (Just (exprWithContext tblPfx cond)))
tryCollectHaving next having = (next, having)
tryCollectHaving tblPfx (Free (QGuard cond next)) having = tryCollectHaving tblPfx next (andE' having (Just (exprWithContext tblPfx cond)))
tryCollectHaving _ next having = (next, having)

buildTableCombination
:: forall s x r
. ( Projectible be r, Projectible be x )
=> (BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be)
=> T.Text
-> (BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be)
-> QM be db (QNested s) x -> QM be db (QNested s) x -> (x -> Free (QF be db s) r) -> SelectBuilder be db r
buildTableCombination combineTables left right next =
let leftSb = buildQuery (fromF left)
buildTableCombination tblPfx combineTables left right next =
let leftSb = buildQuery tblPfx (fromF left)
leftTb = selectBuilderToTableSource tblPfx leftSb
rightSb = buildQuery (fromF right)
rightSb = buildQuery tblPfx (fromF right)
rightTb = selectBuilderToTableSource tblPfx rightSb

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

buildJoinedQuery :: forall s x.
Projectible be x =>
Free (QF be db s) x -> QueryBuilder be -> SelectBuilder be db x
buildJoinedQuery (Pure x) qb = SelectBuilderQ x qb
buildJoinedQuery (Free (QAll mkFrom mkTbl on next)) qb =
buildJoinedQuery :: forall s x
. Projectible be x
=> T.Text -> Free (QF be db s) x -> QueryBuilder be -> SelectBuilder be db x
buildJoinedQuery _ (Pure x) qb = SelectBuilderQ x qb
buildJoinedQuery tblPfx (Free (QAll mkFrom mkTbl on next)) qb =
let (newTblNm, newTbl, qb') = buildInnerJoinQuery tblPfx mkFrom mkTbl on qb
in buildJoinedQuery (next (newTblNm, newTbl)) qb'
buildJoinedQuery (Free (QArbitraryJoin q mkJoin on next)) qb =
in buildJoinedQuery tblPfx (next (newTblNm, newTbl)) qb'
buildJoinedQuery tblPfx (Free (QArbitraryJoin q tblNs mkJoin on next)) qb =
case fromF q of
Free (QAll mkDbFrom dbMkTbl on' next')
| (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbMkTbl,
Expand All @@ -444,10 +448,12 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
case qbFrom qb' of
Nothing -> (Just newSource, andE' (qbWhere qb) on'')
Just oldFrom -> (Just (mkJoin oldFrom newSource on''), qbWhere qb)
in buildJoinedQuery (next proj) (qb' { qbFrom = from', qbWhere = where' })
in buildJoinedQuery tblPfx (next proj) (qb' { qbFrom = from', qbWhere = where' })

q' -> let sb = buildQuery q'
tblSource = buildSelect tblPfx sb
q' -> let tblPfx' = tblPfx <> tblNs

sb = buildQuery tblPfx' q'
tblSource = buildSelect tblPfx' sb
newTblNm = tblPfx <> fromString (show (qbNextTblRef qb))

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

in buildJoinedQuery (next proj') (qb { qbNextTblRef = qbNextTblRef qb + 1
, qbFrom = from', qbWhere = where' })
buildJoinedQuery (Free (QTwoWayJoin a b mkJoin on next)) qb =
in buildJoinedQuery tblPfx (next proj') (qb { qbNextTblRef = qbNextTblRef qb + 1
, qbFrom = from', qbWhere = where' })
buildJoinedQuery tblPfx (Free (QTwoWayJoin a b mkJoin on next)) qb =
let (aProj, aSource, qb') =
case fromF a of
Free (QAll mkDbFrom dbMkTbl on' next')
| (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbMkTbl,
Nothing <- on' newTbl, Pure proj <- next' (newTblNm, newTbl) ->
(proj, mkDbFrom (nextTblPfx tblPfx) newTblNm, qb')

a -> let sb = buildQuery a
a -> let sb = buildQuery tblPfx a
tblSource = buildSelect tblPfx sb

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

b -> let sb = buildQuery b
b -> let sb = buildQuery tblPfx b
tblSource = buildSelect tblPfx sb

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

in buildJoinedQuery (next (aProj, bProj)) (qb'' { qbFrom = from' })
buildJoinedQuery (Free (QGuard cond next)) qb =
buildJoinedQuery next (qb { qbWhere = andE' (qbWhere qb) (Just (exprWithContext tblPfx cond)) })
buildJoinedQuery now qb =
in buildJoinedQuery tblPfx (next (aProj, bProj)) (qb'' { qbFrom = from' })
buildJoinedQuery tblPfx (Free (QGuard cond next)) qb =
buildJoinedQuery tblPfx next (qb { qbWhere = andE' (qbWhere qb) (Just (exprWithContext tblPfx cond)) })
buildJoinedQuery tblPfx now qb =
onlyQ now
(\now' next ->
let sb = buildQuery now'
let sb = buildQuery tblPfx now'
tblSource = buildSelect tblPfx sb
(x', qb') = buildJoinTableSourceQuery tblPfx tblSource (sbProj sb) qb
in buildJoinedQuery (next x') qb')
in buildJoinedQuery tblPfx (next x') qb')

onlyQ :: forall s x.
Free (QF be db s) x
Expand All @@ -518,8 +524,8 @@ buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =
onlyQ (Free (QAll entityNm mkTbl mkOn next)) f =
f (Free (QAll entityNm mkTbl mkOn (Pure . PreserveLeft))) (next . unPreserveLeft)
-- f (Free (QAll entityNm mkTbl mkOn (Pure . PreserveLeft))) (next . unPreserveLeft)
onlyQ (Free (QArbitraryJoin entity mkJoin mkOn next)) f =
f (Free (QArbitraryJoin entity mkJoin mkOn Pure)) next
onlyQ (Free (QArbitraryJoin entity tblNs mkJoin mkOn next)) f =
f (Free (QArbitraryJoin entity tblNs mkJoin mkOn Pure)) next
onlyQ (Free (QTwoWayJoin a b mkJoin mkOn next)) f =
f (Free (QTwoWayJoin a b mkJoin mkOn Pure)) next
onlyQ (Free (QSubSelect q' next)) f =
Expand Down
1 change: 1 addition & 0 deletions beam-postgres/Database/Beam/Postgres/Full.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -260,6 +260,7 @@ lateral_ :: forall s a b db
lateral_ using mkSubquery = do
let Q subquery = mkSubquery (rewriteThread (Proxy @(QNested s)) using)
Q (liftF (QArbitraryJoin subquery
"lat_"
(\a b on' ->
case on' of
Nothing ->
Expand Down

0 comments on commit 9446193

Please sign in to comment.