git.iko.soy/rel8
on master help sign in
Fix catListTable and friends
bac704cShane O'Brien
src/Rel8/Query/List.hs+5−4
compare with master
unifiedsplit
@@ -24,6 +24,7 @@ import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr )
24import Rel8.Expr.Opaleye ( mapPrimExpr )
24import Rel8.Expr.Opaleye ( mapPrimExpr )
25import Rel8.Query ( Query )
25import Rel8.Query ( Query )
26import Rel8.Query.Aggregate ( aggregate )
26import Rel8.Query.Aggregate ( aggregate )
27+import Rel8.Query.Evaluate ( rebind )
27import Rel8.Query.Maybe ( optional )
28import Rel8.Query.Maybe ( optional )
28import Rel8.Schema.HTable.Vectorize ( hunvectorize )
29import Rel8.Schema.HTable.Vectorize ( hunvectorize )
29import Rel8.Schema.Null ( Sql, Unnullify )
30import Rel8.Schema.Null ( Sql, Unnullify )
@@ -83,7 +84,7 @@ someExpr = aggregate . fmap nonEmptyAggExpr
83--
84--
84-- @catListTable@ is an inverse to 'many'.
85-- @catListTable@ is an inverse to 'many'.
85catListTable :: Table Expr a => ListTable a -> Query a
86catListTable :: Table Expr a => ListTable a -> Query a
86−catListTable (ListTable as) = pure $ fromColumns $ runIdentity $
87+catListTable (ListTable as) = rebind $ fromColumns $ runIdentity $
87 hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) as
88 hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) as
88
89
89
90
@@ -92,7 +93,7 @@ catListTable (ListTable as) = pure $ fromColumns $ runIdentity $
92--
93--
93-- @catNonEmptyTable@ is an inverse to 'some'.
94-- @catNonEmptyTable@ is an inverse to 'some'.
94catNonEmptyTable :: Table Expr a => NonEmptyTable a -> Query a
95catNonEmptyTable :: Table Expr a => NonEmptyTable a -> Query a
95−catNonEmptyTable (NonEmptyTable as) = pure $ fromColumns $ runIdentity $
96+catNonEmptyTable (NonEmptyTable as) = rebind $ fromColumns $ runIdentity $
96 hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) as
97 hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) as
97
98
98
99
@@ -101,7 +102,7 @@ catNonEmptyTable (NonEmptyTable as) = pure $ fromColumns $ runIdentity $
101--
102--
102-- @catList@ is an inverse to 'manyExpr'.
103-- @catList@ is an inverse to 'manyExpr'.
103catList :: Sql DBType a => Expr [a] -> Query (Expr a)
104catList :: Sql DBType a => Expr [a] -> Query (Expr a)
104−catList = pure . sunnest typeInformation
105+catList = rebind . sunnest typeInformation
105
106
106
107
107-- | Expand an expression that contains a non-empty list into a 'Query', where
108-- | Expand an expression that contains a non-empty list into a 'Query', where
@@ -109,7 +110,7 @@ catList = pure . sunnest typeInformation
109--
110--
110-- @catNonEmpty@ is an inverse to 'someExpr'.
111-- @catNonEmpty@ is an inverse to 'someExpr'.
111catNonEmpty :: Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)
112catNonEmpty :: Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)
112−catNonEmpty = pure . sunnest typeInformation
113+catNonEmpty = rebind . sunnest typeInformation
113
114
114
115
115sunnest :: TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
116sunnest :: 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
701
701
702 selected === [foldMap pure rows]
702 selected === [foldMap pure rows]
703
703
704− selected' <- liftIO $ Rel8.select connection $ Rel8.catListTable =<< do
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
705− Rel8.many $ Rel8.values (map Rel8.lit rows)
708+ Rel8.many $ Rel8.values (map Rel8.lit rows)
706−
709+ pure (a, b)
710+
707− selected' === rows
711+ selected' === liftA2 (,) rows rows
708
712
709
713
710data NestedMaybeTable f = NestedMaybeTable
714data NestedMaybeTable f = NestedMaybeTable