circuithub/rel8
1
1
Fork 0
mirror of https://github.com/circuithub/rel8.git synced 2024-09-11 16:05:41 +03:00
Code Issues Projects Releases Wiki Activity

Slightler safer/more correct listAgg and nonEmptyAgg

Browse Source
This commit is contained in:
Shane 2021-03-04 10:37:23 +00:00
parent 0deacafaac
commit 3e88e09a31
No known key found for this signature in database
GPG Key ID: C1D5BF1DE4F6D319
1 changed files with 7 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/Rel8.hs
View File

@ -1877,6 +1877,7 @@ newtype Aggregate a = Aggregate a
instance Functor Aggregate where
fmap f (Aggregate a) = Aggregate $ f a
instance Applicative Aggregate where
pure = Aggregate
Aggregate f <*> Aggregate a = Aggregate $ f a
@ -1887,17 +1888,17 @@ groupBy = pure
listAgg :: Table Expr exprs => exprs -> Aggregate (ListTable exprs)
listAgg = Aggregate . ListTable . mapTable (mapC (ComposeInner . go))
listAgg = fmap ListTable . traverseTable (traverseC (fmap ComposeInner . go))
where
go :: Expr a -> Expr [a]
go (Expr a) = Expr $ Opaleye.AggrExpr Opaleye.AggrAll Opaleye.AggrArr a []
go :: Expr a -> Aggregate (Expr [a])
go (Expr a) = Aggregate $ Expr $ Opaleye.AggrExpr Opaleye.AggrAll Opaleye.AggrArr a []
nonEmptyAgg :: Table Expr exprs => exprs -> Aggregate (NonEmptyTable exprs)
nonEmptyAgg = Aggregate . NonEmptyTable . mapTable (mapC (ComposeInner . go))
nonEmptyAgg = fmap NonEmptyTable . traverseTable (traverseC (fmap ComposeInner . go))
where
go :: Expr a -> Expr (NonEmpty a)
go (Expr a) = Expr $ Opaleye.AggrExpr Opaleye.AggrAll Opaleye.AggrArr a []
go :: Expr a -> Aggregate (Expr (NonEmpty a))
go (Expr a) = Aggregate $ Expr $ Opaleye.AggrExpr Opaleye.AggrAll Opaleye.AggrArr a []
class DBMax a where
@ -2186,13 +2187,6 @@ newtype ComposeInner f g a = ComposeInner
}
mapComposeInner :: forall f g t a. ()
=> (forall x. C f x -> C g x)
-> C (ComposeInner f t) a -> C (ComposeInner g t) a
mapComposeInner f (MkC (ComposeInner a)) =
mapC ComposeInner $ f (MkC @_ @(t a) a)
traverseComposeInner :: forall f g t m a. Applicative m
=> (forall x. C f x -> m (C g x))
-> C (ComposeInner f t) a -> m (C (ComposeInner g t) a)