5160431 · rel8 · git.iko.soy

git.iko.soy/rel8

on master help sign in

Add ability to specify ordering with list aggregations

5160431Shane O'Brien6 years ago

src/Rel8.hs+2−2

compare with master

unifiedsplit

@@ -179,8 +179,8 @@ module Rel8

179 , aggregate

180 , countRows

181 , array1DAggExpr

182− , listAgg, listAggExpr

182+ , listAgg, listAggWithOrder, listAggExpr

183− , nonEmptyAgg, nonEmptyAggExpr

183+ , nonEmptyAgg, nonEmptyAggWithOrder, nonEmptyAggExpr

184 , groupBy

185 , DBMax, max

186 , DBMin, min

src/Rel8/Expr/Aggregate.hs+25

@@ -13,6 +13,7 @@ module Rel8.Expr.Aggregate

13 , stringAgg

14 , groupByExpr

15 , array1DAggExpr, listAggExpr, nonEmptyAggExpr

16+ , listAggExprWithOrder, nonEmptyAggExprWithOrder

16 )

17 )

17where

18where

@@ -36,6 +37,7 @@ import Rel8.Expr.Opaleye

36 )

37 )

37import Rel8.Expr.Null ( null )

38import Rel8.Expr.Null ( null )

38import Rel8.Expr.Serialize ( litExpr )

39import Rel8.Expr.Serialize ( litExpr )

40+import Rel8.Order ( Order, toOrderExprs )

39import Rel8.Schema.Null ( Sql )

41import Rel8.Schema.Null ( Sql )

40import Rel8.Type.Array ( fromPrimArray )

42import Rel8.Type.Array ( fromPrimArray )

41import Rel8.Type.Array1D ( Array1D, NotArray )

43import Rel8.Type.Array1D ( Array1D, NotArray )

@@ -185,3 +187,26 @@ nonEmptyAggExpr = unsafeMakeAggregate toPrimExpr from $ Just

185 }

187 }

186 where

188 where

187 from = fromPrimExpr . fromPrimArray

189 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 @@

5module Rel8.Order

6 ( Order(..)

7+ , toOrderExprs

7 )

8 )

8where

9where

@@ -16,6 +17,7 @@ import Prelude

16import Data.Functor.Contravariant.Divisible ( Decidable, Divisible )

17import Data.Functor.Contravariant.Divisible ( Decidable, Divisible )

18-- opaleye

19-- opaleye

20+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

19import qualified Opaleye.Internal.Order as Opaleye

21import qualified Opaleye.Internal.Order as Opaleye

@@ -28,3 +30,8 @@ import qualified Opaleye.Internal.Order as Opaleye

28type Order :: Type -> Type

30type Order :: Type -> Type

29newtype Order a = Order (Opaleye.Order a)

31newtype Order a = Order (Opaleye.Order a)

30 deriving newtype (Contravariant, Divisible, Decidable, Semigroup, Monoid)

32 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 @@

7module Rel8.Table.Aggregate

8 ( groupBy

9− , listAgg

9+ , listAgg, nonEmptyAgg

10− , nonEmptyAgg

10+ , listAggWithOrder, nonEmptyAggWithOrder

11 )

12where

@@ -18,7 +18,14 @@ import Prelude

18-- rel8

19import Rel8.Aggregate ( Aggregate, Col(..) )

20import 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 )

22import Rel8.Schema.Dict ( Dict( Dict ) )

29import Rel8.Schema.Dict ( Dict( Dict ) )

23import Rel8.Schema.HTable ( htabulate, hfield )

30import Rel8.Schema.HTable ( htabulate, hfield )

24import Rel8.Schema.HTable.Vectorize ( hvectorize )

31import Rel8.Schema.HTable.Vectorize ( hvectorize )

@@ -53,7 +60,7 @@ groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->

53-- items <- aggregate $ listAgg <$> itemsFromOrder order

60-- items <- aggregate $ listAgg <$> itemsFromOrder order

54-- return (order, items)

61-- return (order, items)

55-- @

62-- @

56−listAgg :: Table Expr exprs => exprs -> Aggregate (ListTable exprs)

63+listAgg :: Table Expr a => a -> Aggregate (ListTable a)

57listAgg (toColumns -> exprs) = fromColumns $

64listAgg (toColumns -> exprs) = fromColumns $

58 hvectorize

65 hvectorize

59 (\_ (Identity (DB a)) -> Aggregation $ listAggExpr a)

66 (\_ (Identity (DB a)) -> Aggregation $ listAggExpr a)

@@ -61,8 +68,24 @@ listAgg (toColumns -> exprs) = fromColumns $

63-- | Like 'listAgg', but the result is guaranteed to be a non-empty list.

70-- | 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)

65nonEmptyAgg (toColumns -> exprs) = fromColumns $

72nonEmptyAgg (toColumns -> exprs) = fromColumns $

66 hvectorize

73 hvectorize

67 (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)

74 (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)

68 (pure exprs)

75 (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)))