Fix catListTable and friends

The implemtation before would produce incorrect results if tried to get the cartesian product of two queries built out of `unnest`. Which makes sense, because Postgres seems to special case products of `unnest` to have a `ZipList` semantics rather than the normal `[]`.

The solution is to use `rebind` (from `Rel8.Query.Evaluate`) to rebind the results of such queries, so there is no `unnest` in the expressions we're `<*>`ing.
This commit is contained in:
Shane O'Brien 2021-06-19 23:17:46 +01:00
parent d63063940d
commit bac704ce01
No known key found for this signature in database
GPG Key ID: 35A00ED1B695C1A1
2 changed files with 12 additions and 7 deletions

View File

@ -24,6 +24,7 @@ import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr )
import Rel8.Expr.Opaleye ( mapPrimExpr )
import Rel8.Query ( Query )
import Rel8.Query.Aggregate ( aggregate )
import Rel8.Query.Evaluate ( rebind )
import Rel8.Query.Maybe ( optional )
import Rel8.Schema.HTable.Vectorize ( hunvectorize )
import Rel8.Schema.Null ( Sql, Unnullify )
@ -83,7 +84,7 @@ someExpr = aggregate . fmap nonEmptyAggExpr
--
-- @catListTable@ is an inverse to 'many'.
catListTable :: Table Expr a => ListTable a -> Query a
catListTable (ListTable as) = pure $ fromColumns $ runIdentity $
catListTable (ListTable as) = rebind $ fromColumns $ runIdentity $
hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) as
@ -92,7 +93,7 @@ catListTable (ListTable as) = pure $ fromColumns $ runIdentity $
--
-- @catNonEmptyTable@ is an inverse to 'some'.
catNonEmptyTable :: Table Expr a => NonEmptyTable a -> Query a
catNonEmptyTable (NonEmptyTable as) = pure $ fromColumns $ runIdentity $
catNonEmptyTable (NonEmptyTable as) = rebind $ fromColumns $ runIdentity $
hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) as
@ -101,7 +102,7 @@ catNonEmptyTable (NonEmptyTable as) = pure $ fromColumns $ runIdentity $
--
-- @catList@ is an inverse to 'manyExpr'.
catList :: Sql DBType a => Expr [a] -> Query (Expr a)
catList = pure . sunnest typeInformation
catList = rebind . sunnest typeInformation
-- | Expand an expression that contains a non-empty list into a 'Query', where
@ -109,7 +110,7 @@ catList = pure . sunnest typeInformation
--
-- @catNonEmpty@ is an inverse to 'someExpr'.
catNonEmpty :: Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)
catNonEmpty = pure . sunnest typeInformation
catNonEmpty = rebind . sunnest typeInformation
sunnest :: TypeInformation (Unnullify a) -> Expr (list a) -> Expr a

View File

@ -701,10 +701,14 @@ testSelectArray = databasePropertyTest "Can SELECT Arrays (with aggregation)" \t
selected === [foldMap pure rows]
selected' <- liftIO $ Rel8.select connection $ Rel8.catListTable =<< do
Rel8.many $ Rel8.values (map Rel8.lit rows)
selected' <- liftIO $ Rel8.select connection $ do
a <- Rel8.catListTable =<< do
Rel8.many $ Rel8.values (map Rel8.lit rows)
b <- Rel8.catListTable =<< do
Rel8.many $ Rel8.values (map Rel8.lit rows)
pure (a, b)
selected' === rows
selected' === liftA2 (,) rows rows
data NestedMaybeTable f = NestedMaybeTable