Make sure lateral join names do not overlap (#647)

tathougies · kmicklas · web-flow · commit 94461937c5ca · 2023-01-03T07:05:51.000-08:00
* Make sure lateral join names do not overlap

* Fix typo for naming of laterally joined tables.

Co-authored-by: Ken Micklas &lt;git@kmicklas.com&gt;

Co-authored-by: Ken Micklas &lt;git@kmicklas.com&gt;
diff --git a/beam-core/Database/Beam/Query/Combinators.hs b/beam-core/Database/Beam/Query/Combinators.hs
@@ -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) $
@@ -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) $
diff --git a/beam-core/Database/Beam/Query/Internal.hs b/beam-core/Database/Beam/Query/Internal.hs
@@ -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)
diff --git a/beam-core/Database/Beam/Query/SQL92.hs b/beam-core/Database/Beam/Query/SQL92.hs
@@ -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 ->
@@ -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'')
@@ -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)
 
@@ -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
@@ -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
@@ -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)
@@ -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)
@@ -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,
@@ -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))
@@ -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))
@@ -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))
@@ -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
@@ -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 =
diff --git a/beam-postgres/Database/Beam/Postgres/Full.hs b/beam-postgres/Database/Beam/Postgres/Full.hs
@@ -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 ->
