git.iko.soy/rel8
on master help sign in
Add ability to specify ordering with list aggregations
commit5160431df30c800210ddd6fe9b4254152a9c2fe0 authorShane O'Brien <shane.obrien@circuithub.com> dateThu 22 Apr 2021, 15:48 (6 years ago) parent675dc60
4 files changed+62−7
compare with master
unifiedsplit
src/Rel8.hs+2−2 src/Rel8/Expr/Aggregate.hs+25 src/Rel8/Order.hs+7 src/Rel8/Table/Aggregate.hs+28−5
src/Rel8.hs+2−2
@@ -179,8 +179,8 @@ module Rel8
179179 , aggregate
180180 , countRows
181181 , array1DAggExpr
182− , listAgg, listAggExpr
183− , nonEmptyAgg, nonEmptyAggExpr
182+ , listAgg, listAggWithOrder, listAggExpr
183+ , nonEmptyAgg, nonEmptyAggWithOrder, nonEmptyAggExpr
184184 , groupBy
185185 , DBMax, max
186186 , DBMin, min
src/Rel8/Expr/Aggregate.hs+25
@@ -13,6 +13,7 @@ module Rel8.Expr.Aggregate
1313 , stringAgg
1414 , groupByExpr
1515 , array1DAggExpr, listAggExpr, nonEmptyAggExpr
16+ , listAggExprWithOrder, nonEmptyAggExprWithOrder
1617 )
1718where
1819
@@ -36,6 +37,7 @@ import Rel8.Expr.Opaleye
3637 )
3738import Rel8.Expr.Null ( null )
3839import Rel8.Expr.Serialize ( litExpr )
40+import Rel8.Order ( Order, toOrderExprs )
3941import Rel8.Schema.Null ( Sql )
4042import Rel8.Type.Array ( fromPrimArray )
4143import Rel8.Type.Array1D ( Array1D, NotArray )
@@ -185,3 +187,26 @@ nonEmptyAggExpr = unsafeMakeAggregate toPrimExpr from $ Just
185187 }
186188 where
187189 from = fromPrimExpr . fromPrimArray
190+
191+
192+listAggExprWithOrder :: o -> Order o -> Expr a -> Aggregate (Expr [a])
193+listAggExprWithOrder o order = unsafeMakeAggregate toPrimExpr from $ Just
194+ Aggregator
195+ { operation = Opaleye.AggrArr
196+ , ordering = toOrderExprs order o
197+ , distinction = Opaleye.AggrAll
198+ }
199+ where
200+ from = fromPrimExpr . fromPrimArray
201+
202+
203+nonEmptyAggExprWithOrder :: ()
204+ => o -> Order o -> Expr a -> Aggregate (Expr (NonEmpty a))
205+nonEmptyAggExprWithOrder o order = unsafeMakeAggregate toPrimExpr from $ Just
206+ Aggregator
207+ { operation = Opaleye.AggrArr
208+ , ordering = toOrderExprs order o
209+ , distinction = Opaleye.AggrAll
210+ }
211+ where
212+ from = fromPrimExpr . fromPrimArray
src/Rel8/Order.hs+7
@@ -4,6 +4,7 @@
44
55module Rel8.Order
66 ( Order(..)
7+ , toOrderExprs
78 )
89where
910
@@ -16,6 +17,7 @@ import Prelude
1617import Data.Functor.Contravariant.Divisible ( Decidable, Divisible )
1718
1819-- opaleye
20+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
1921import qualified Opaleye.Internal.Order as Opaleye
2022
2123
@@ -28,3 +30,8 @@ import qualified Opaleye.Internal.Order as Opaleye
2830type Order :: Type -> Type
2931newtype Order a = Order (Opaleye.Order a)
3032 deriving newtype (Contravariant, Divisible, Decidable, Semigroup, Monoid)
33+
34+
35+toOrderExprs :: Order a -> a -> [Opaleye.OrderExpr]
36+toOrderExprs (Order (Opaleye.Order order)) a =
37+ uncurry Opaleye.OrderExpr <$> order a
src/Rel8/Table/Aggregate.hs+28−5
@@ -6,8 +6,8 @@
66
77module Rel8.Table.Aggregate
88 ( groupBy
9− , listAgg
10− , nonEmptyAgg
9+ , listAgg, nonEmptyAgg
10+ , listAggWithOrder, nonEmptyAggWithOrder
1111 )
1212where
1313
@@ -18,7 +18,14 @@ import Prelude
1818-- rel8
1919import Rel8.Aggregate ( Aggregate, Col(..) )
2020import Rel8.Expr ( Expr, Col(..) )
21−import Rel8.Expr.Aggregate ( groupByExpr, listAggExpr, nonEmptyAggExpr )
21+import Rel8.Expr.Aggregate
22+ ( groupByExpr
23+ , listAggExpr
24+ , listAggExprWithOrder
25+ , nonEmptyAggExpr
26+ , nonEmptyAggExprWithOrder
27+ )
28+import Rel8.Order ( Order )
2229import Rel8.Schema.Dict ( Dict( Dict ) )
2330import Rel8.Schema.HTable ( htabulate, hfield )
2431import Rel8.Schema.HTable.Vectorize ( hvectorize )
@@ -53,7 +60,7 @@ groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
5360-- items <- aggregate $ listAgg <$> itemsFromOrder order
5461-- return (order, items)
5562-- @
56−listAgg :: Table Expr exprs => exprs -> Aggregate (ListTable exprs)
63+listAgg :: Table Expr a => a -> Aggregate (ListTable a)
5764listAgg (toColumns -> exprs) = fromColumns $
5865 hvectorize
5966 (\_ (Identity (DB a)) -> Aggregation $ listAggExpr a)
@@ -61,8 +68,24 @@ listAgg (toColumns -> exprs) = fromColumns $
6168
6269
6370-- | Like 'listAgg', but the result is guaranteed to be a non-empty list.
64−nonEmptyAgg :: Table Expr exprs => exprs -> Aggregate (NonEmptyTable exprs)
71+nonEmptyAgg :: Table Expr a => a -> Aggregate (NonEmptyTable a)
6572nonEmptyAgg (toColumns -> exprs) = fromColumns $
6673 hvectorize
6774 (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)
6875 (pure exprs)
76+
77+
78+listAggWithOrder :: Table Expr b
79+ => (a -> o) -> (a -> b) -> Order o -> a -> Aggregate (ListTable b)
80+listAggWithOrder o b order a = fromColumns $
81+ hvectorize
82+ (\_ (Identity (DB x)) -> Aggregation $ listAggExprWithOrder (o a) order x)
83+ (pure (toColumns (b a)))
84+
85+
86+nonEmptyAggWithOrder :: Table Expr b
87+ => (a -> o) -> (a -> b) -> Order o -> a -> Aggregate (NonEmptyTable b)
88+nonEmptyAggWithOrder o b order a = fromColumns $
89+ hvectorize
90+ (\_ (Identity (DB x)) -> Aggregation $ nonEmptyAggExprWithOrder (o a) order x)
91+ (pure (toColumns (b a)))