bac704c · rel8 · git.iko.soy

git.iko.soy/rel8

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.

commitbac704ce01c54f21a6df85ff689a0605071b890b authorShane O'Brien <shane.obrien@circuithub.com> dateSat 19 Jun 2021, 23:17 (5 years ago) parentd630639

2 files changed+13−8

compare with master

unifiedsplit

src/Rel8/Query/List.hs+5−4 tests/Main.hs+8−4

src/Rel8/Query/List.hs+5−4

@@ -24,6 +24,7 @@ import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr )

2424import Rel8.Expr.Opaleye ( mapPrimExpr )

2525import Rel8.Query ( Query )

2626import Rel8.Query.Aggregate ( aggregate )

27+import Rel8.Query.Evaluate ( rebind )

2728import Rel8.Query.Maybe ( optional )

2829import Rel8.Schema.HTable.Vectorize ( hunvectorize )

2930import Rel8.Schema.Null ( Sql, Unnullify )

@@ -83,7 +84,7 @@ someExpr = aggregate . fmap nonEmptyAggExpr

8384--

8485-- @catListTable@ is an inverse to 'many'.

8586catListTable :: Table Expr a => ListTable a -> Query a

86−catListTable (ListTable as) = pure $ fromColumns $ runIdentity $

87+catListTable (ListTable as) = rebind $ fromColumns $ runIdentity $

8788 hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) as

8889

8990

@@ -92,7 +93,7 @@ catListTable (ListTable as) = pure $ fromColumns $ runIdentity $

9293--

9394-- @catNonEmptyTable@ is an inverse to 'some'.

9495catNonEmptyTable :: Table Expr a => NonEmptyTable a -> Query a

95−catNonEmptyTable (NonEmptyTable as) = pure $ fromColumns $ runIdentity $

96+catNonEmptyTable (NonEmptyTable as) = rebind $ fromColumns $ runIdentity $

9697 hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) as

9798

9899

@@ -101,7 +102,7 @@ catNonEmptyTable (NonEmptyTable as) = pure $ fromColumns $ runIdentity $

101102--

102103-- @catList@ is an inverse to 'manyExpr'.

103104catList :: Sql DBType a => Expr [a] -> Query (Expr a)

104−catList = pure . sunnest typeInformation

105+catList = rebind . sunnest typeInformation

105106

106107

107108-- | Expand an expression that contains a non-empty list into a 'Query', where

@@ -109,7 +110,7 @@ catList = pure . sunnest typeInformation

109110--

110111-- @catNonEmpty@ is an inverse to 'someExpr'.

111112catNonEmpty :: Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)

112−catNonEmpty = pure . sunnest typeInformation

113+catNonEmpty = rebind . sunnest typeInformation

113114

114115

115116sunnest :: TypeInformation (Unnullify a) -> Expr (list a) -> Expr a

tests/Main.hs+8−4

@@ -701,10 +701,14 @@ testSelectArray = databasePropertyTest "Can SELECT Arrays (with aggregation)" \t

701701

702702 selected === [foldMap pure rows]

703703

704− selected' <- liftIO $ Rel8.select connection $ Rel8.catListTable =<< do

705− Rel8.many $ Rel8.values (map Rel8.lit rows)

706−

707− selected' === rows

704+ selected' <- liftIO $ Rel8.select connection $ do

705+ a <- Rel8.catListTable =<< do

706+ Rel8.many $ Rel8.values (map Rel8.lit rows)

707+ b <- Rel8.catListTable =<< do

708+ Rel8.many $ Rel8.values (map Rel8.lit rows)

709+ pure (a, b)

710+

711+ selected' === liftA2 (,) rows rows

708712

709713

710714data NestedMaybeTable f = NestedMaybeTable