a9f500e · rel8 · git.iko.soy

git.iko.soy/rel8

Abandon Apply Aggregate experiment, support only Context Aggregate

commita9f500eb9e8eb363dff8c6cf2422b56fb8065c86 authorShane O'Brien <shane.obrien@circuithub.com> dateSun 13 Jun 2021, 00:28 (5 years ago) parent9903886

22 files changed+136−407

compare with master

unifiedsplit

rel8.cabal−3

@@ -41,9 +41,6 @@ library

4141 Rel8.Expr.Time

4242 Rel8.Tabulate

4343

44− -- deprecated

45− Rel8.Aggregate.Legacy

46−

4744 other-modules:

4845 Rel8.Aggregate

4946

src/Rel8.hs+1−3

@@ -59,7 +59,6 @@ module Rel8

5959 , catMaybeTable

6060 , bindMaybeTable

6161 , traverseMaybeTable

62− , aggregateMaybeTable

6362 , insertMaybeTable

6463 , nameMaybeTable

6564

@@ -71,7 +70,6 @@ module Rel8

7170 , keepRightTable

7271 , bindEitherTable

7372 , bitraverseEitherTable

74− , aggregateEitherTable

7573 , insertEitherTable

7674 , nameEitherTable

7775

@@ -89,7 +87,6 @@ module Rel8

8987 , keepThoseTable, loseThoseTable

9088 , bindTheseTable

9189 , bitraverseTheseTable

92− , aggregateTheseTable

9390 , insertTheseTable

9491 , nameTheseTable

9592

@@ -218,6 +215,7 @@ module Rel8

218215

219216 -- ** Aggregation

220217 , Aggregate

218+ , Aggregates

221219 , aggregate

222220 , countRows

223221 , groupBy

src/Rel8/Aggregate.hs+19−33

@@ -31,15 +31,15 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

3131import qualified Opaleye.Internal.PackMap as Opaleye

3232

3333-- rel8

34−import Rel8.Expr ( Expr, Col( E, unE ) )

34+import Rel8.Expr ( Expr )

3535import Rel8.Schema.Context ( Interpretation(..) )

3636import Rel8.Schema.Context.Label ( Labelable(..) )

37−import Rel8.Schema.HTable ( hfield, htabulate, htabulateA, hspecs )

37+import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )

3838import Rel8.Schema.Name ( Name )

3939import Rel8.Schema.Null ( Sql )

4040import Rel8.Schema.Reify ( notReify )

4141import Rel8.Schema.Result ( Result )

42−import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

42+import Rel8.Schema.Spec ( Spec( Spec ) )

4343import Rel8.Table

4444 ( Table, Columns, Context, fromColumns, toColumns

4545 , reify, unreify

@@ -47,9 +47,6 @@ import Rel8.Table

4747import Rel8.Table.Recontextualize ( Recontextualize )

4848import Rel8.Type ( DBType )

4949

50−-- semigroupoids

51−import Data.Functor.Apply ( Apply, (<.>) )

52−

5350

5451-- | An @Aggregate a@ describes how to aggregate @Table@s of type @a@. You can

5552-- unpack an @Aggregate@ back to @a@ by running it with 'Rel8.aggregate'. As

@@ -58,64 +55,53 @@ import Data.Functor.Apply ( Apply, (<.>) )

5855-- combine @Aggregate@s using the @<.>@ combinator.

5956type Aggregate :: k -> Type

6057data Aggregate a where

61− Aggregate :: !(Opaleye.Aggregator () a) -> Aggregate a

62−

63−

64−instance Functor Aggregate where

65− fmap f (Aggregate a) = Aggregate (fmap f a)

66−

67−

68−instance Apply Aggregate where

69− Aggregate f <.> Aggregate a = Aggregate (f <*> a)

58+ Aggregate :: !(Opaleye.Aggregator () (Expr a)) -> Aggregate a

7059

7160

7261instance Interpretation Aggregate where

7362 data Col Aggregate _spec where

7463 A :: ()

75− => { unA :: !(Aggregate (Expr a)) }

64+ => { unA :: !(Aggregate a) }

7665 -> Col Aggregate ('Spec labels necessity a)

7766

7867

79−instance Table Expr a => Table Aggregate (Aggregate a) where

80− type Columns (Aggregate a) = Columns a

68+instance Sql DBType a => Table Aggregate (Aggregate a) where

69+ type Columns (Aggregate a) = HType a

8170 type Context (Aggregate a) = Aggregate

8271

83− toColumns a = htabulate $ \field -> case hfield hspecs field of

84− SSpec {} -> A $ unE . (`hfield` field) . toColumns <$> a

85− fromColumns as = fmap fromColumns $ htabulateA $ \field ->

86− case hfield as field of

87− A a -> E <$> a

72+ toColumns = HIdentity . A

73+ fromColumns (HIdentity (A a)) = a

8874

8975 reify = notReify

9076 unreify = notReify

9177

9278

9379instance Sql DBType a =>

94− Recontextualize Aggregate Aggregate (Aggregate (Expr a)) (Aggregate (Expr a))

80+ Recontextualize Aggregate Aggregate (Aggregate a) (Aggregate a)

9581

9682

9783instance Sql DBType a =>

98− Recontextualize Aggregate Expr (Aggregate (Expr a)) (Expr a)

84+ Recontextualize Aggregate Expr (Aggregate a) (Expr a)

9985

10086

10187instance Sql DBType a =>

102− Recontextualize Aggregate Result (Aggregate (Expr a)) (Identity a)

88+ Recontextualize Aggregate Result (Aggregate a) (Identity a)

10389

10490

10591instance Sql DBType a =>

106− Recontextualize Aggregate Name (Aggregate (Expr a)) (Name a)

92+ Recontextualize Aggregate Name (Aggregate a) (Name a)

10793

10894

10995instance Sql DBType a =>

110− Recontextualize Expr Aggregate (Expr a) (Aggregate (Expr a))

96+ Recontextualize Expr Aggregate (Expr a) (Aggregate a)

11197

11298

11399instance Sql DBType a =>

114− Recontextualize Result Aggregate (Identity a) (Aggregate (Expr a))

100+ Recontextualize Result Aggregate (Identity a) (Aggregate a)

115101

116102

117103instance Sql DBType a =>

118− Recontextualize Name Aggregate (Name a) (Aggregate (Expr a))

104+ Recontextualize Name Aggregate (Name a) (Aggregate a)

119105

120106

121107instance Labelable Aggregate where

@@ -156,10 +142,10 @@ data Aggregator = Aggregator

156142

157143

158144unsafeMakeAggregate :: ()

159− => (input -> Opaleye.PrimExpr)

160− -> (Opaleye.PrimExpr -> output)

145+ => (Expr input -> Opaleye.PrimExpr)

146+ -> (Opaleye.PrimExpr -> Expr output)

161147 -> Maybe Aggregator

162− -> input

148+ -> Expr input

163149 -> Aggregate output

164150unsafeMakeAggregate input output aggregator expr =

165151 Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ \f _ ->

src/Rel8/Aggregate/Legacy.hsdeleted−135

@@ -1,135 +0,0 @@

1−{-# language AllowAmbiguousTypes #-}

2−{-# language DataKinds #-}

3−{-# language FlexibleContexts #-}

4−{-# language NamedFieldPuns #-}

5−{-# language RankNTypes #-}

6−{-# language ScopedTypeVariables #-}

7−{-# language StandaloneKindSignatures #-}

8−{-# language TypeApplications #-}

9−{-# language TypeFamilies #-}

10−{-# language ViewPatterns #-}

11−

12−module Rel8.Aggregate.Legacy

13− ( Aggregates

14− , aggregate

15− , aggregateTabulation

16− , groupBy

17− , listAgg

18− , nonEmptyAgg

19−

20− , AggregateADT, aggregateADT

21− , AggregateHKD, aggregateHKD

22− )

23−where

24−

25−-- base

26−import Data.Functor.Identity ( Identity( Identity ) )

27−import Data.Kind ( Type )

28−import GHC.Generics ( Rep )

29−import Prelude

30−

31−-- opaleye

32−import qualified Opaleye.Aggregate as Opaleye

33−

34−-- rel8

35−import Rel8.Aggregate ( Aggregate, Aggregates, Col( A ) )

36−import Rel8.Expr ( Col( E ), Expr )

37−import Rel8.Expr.Aggregate

38− ( groupByExpr

39− , slistAggExpr

40− , snonEmptyAggExpr

41− )

42−import Rel8.Generic.Construction ( GGAggregate', ggaggregate' )

43−import Rel8.Generic.Table ( GAlgebra )

44−import Rel8.Kind.Algebra ( Algebra( Sum ) )

45−import Rel8.Query ( Query )

46−import Rel8.Query.Opaleye ( mapOpaleye )

47−import Rel8.Schema.Dict ( Dict( Dict ) )

48−import Rel8.Schema.HTable ( hfield, htabulate )

49−import Rel8.Schema.HTable.Vectorize ( hvectorize )

50−import Rel8.Schema.Kind ( Rel8able )

51−import Rel8.Schema.Spec ( SSpec( SSpec, info ) )

52−import Rel8.Table ( toColumns, fromColumns )

53−import Rel8.Table.ADT ( ConstructableADT, ADT( ADT ), ADTRep )

54−import Rel8.Table.Eq ( EqTable, eqTable )

55−import Rel8.Table.HKD ( ConstructableHKD, HKD( HKD ), HKDRep )

56−import Rel8.Table.List ( ListTable )

57−import Rel8.Table.NonEmpty ( NonEmptyTable )

58−import Rel8.Table.Opaleye ( aggregator )

59−import Rel8.Tabulate ( Tabulation )

60−import qualified Rel8.Tabulate

61−

62−

63−-- | Apply an aggregation to all rows returned by a 'Query'.

64−aggregate :: Aggregates aggregates exprs => Query aggregates -> Query exprs

65−aggregate = mapOpaleye (Opaleye.aggregate aggregator) . fmap (fromColumns . toColumns)

66−

67−

68−aggregateTabulation

69− :: (EqTable k, Aggregates aggregates exprs)

70− => Tabulation k aggregates -> Tabulation k exprs

71−aggregateTabulation =

72− Rel8.Tabulate.aggregateTabulation . fmap (fromColumns . toColumns)

73−

74−

75−-- | Group equal tables together. This works by aggregating each column in the

76−-- given table with 'groupByExpr'.

77−groupBy :: forall exprs aggregates. (EqTable exprs, Aggregates aggregates exprs)

78− => exprs -> aggregates

79−groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->

80− case hfield (eqTable @exprs) field of

81− Dict -> case hfield exprs field of

82− E expr -> A $ groupByExpr expr

83−

84−

85−-- | Aggregate rows into a single row containing an array of all aggregated

86−-- rows. This can be used to associate multiple rows with a single row, without

87−-- changing the over cardinality of the query. This allows you to essentially

88−-- return a tree-like structure from queries.

89−--

90−-- For example, if we have a table of orders and each orders contains multiple

91−-- items, we could aggregate the table of orders, pairing each order with its

92−-- items:

93−--

94−-- @

95−-- ordersWithItems :: Query (Order Expr, ListTable (Item Expr))

96−-- ordersWithItems = do

97−-- order <- each orderSchema

98−-- items <- aggregate $ listAgg <$> itemsFromOrder order

99−-- return (order, items)

100−-- @

101−listAgg :: Aggregates aggregates exprs => exprs -> ListTable aggregates

102−listAgg (toColumns -> exprs) = fromColumns $

103− hvectorize

104− (\SSpec {info} (Identity (E a)) -> A $ slistAggExpr info a)

105− (pure exprs)

106−

107−

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

109−nonEmptyAgg :: Aggregates aggregates exprs => exprs -> NonEmptyTable aggregates

110−nonEmptyAgg (toColumns -> exprs) = fromColumns $

111− hvectorize

112− (\SSpec {info} (Identity (E a)) -> A $ snonEmptyAggExpr info a)

113− (pure exprs)

114−

115−

116−type AggregateADT :: Rel8able -> Type

117−type AggregateADT t = forall r. GGAggregate' 'Sum (ADTRep t) r

118−

119−

120−aggregateADT :: forall t. ConstructableADT t

121− => AggregateADT t -> ADT t Expr -> ADT t Aggregate

122−aggregateADT f =

123− ggaggregate' @'Sum @(ADTRep t) @(ADT t Expr) @(ADT t Aggregate) ADT (\(ADT a) -> a)

124− (f @(ADT t Aggregate))

125−

126−

127−type AggregateHKD :: Type -> Type

128−type AggregateHKD a = forall r. GGAggregate' (GAlgebra (Rep a)) (HKDRep a) r

129−

130−

131−aggregateHKD :: forall a. ConstructableHKD a

132− => AggregateHKD a -> HKD a Expr -> HKD a Aggregate

133−aggregateHKD f =

134− ggaggregate' @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Expr) @(HKD a Aggregate) HKD (\(HKD a) -> a)

135− (f @(HKD a Aggregate))

src/Rel8/Column/Field.hs+1−1

@@ -42,7 +42,7 @@ import Rel8.Type ( DBType )

4242type Field :: K.Context -> Necessity -> Type -> Type

4343type family Field context necessity a where

4444 Field (Reify context) necessity a = AField context necessity a

45− Field Aggregate _necessity a = Aggregate (Expr a)

45+ Field Aggregate _necessity a = Aggregate a

4646 Field Expr _necessity a = Expr a

4747 Field Insert 'Required a = Expr a

4848 Field Insert 'Optional a = Maybe (Expr a)

src/Rel8/Expr/Aggregate.hs+16−16

@@ -49,7 +49,7 @@ import Rel8.Type.Sum ( DBSum )

4949

5050

5151-- | Count the occurances of a single column. Corresponds to @COUNT(a)@

52−count :: Expr a -> Aggregate (Expr Int64)

52+count :: Expr a -> Aggregate Int64

5353count = unsafeMakeAggregate toPrimExpr fromPrimExpr $

5454 Just Aggregator

5555 { operation = Opaleye.AggrCount

@@ -60,7 +60,7 @@ count = unsafeMakeAggregate toPrimExpr fromPrimExpr $

6060

6161-- | Count the number of distinct occurances of a single column. Corresponds to

6262-- @COUNT(DISTINCT a)@

63−countDistinct :: Sql DBEq a => Expr a -> Aggregate (Expr Int64)

63+countDistinct :: Sql DBEq a => Expr a -> Aggregate Int64

6464countDistinct = unsafeMakeAggregate toPrimExpr fromPrimExpr $

6565 Just Aggregator

6666 { operation = Opaleye.AggrCount

@@ -70,17 +70,17 @@ countDistinct = unsafeMakeAggregate toPrimExpr fromPrimExpr $

7070

7171

7272-- | Corresponds to @COUNT(*)@.

73−countStar :: Aggregate (Expr Int64)

73+countStar :: Aggregate Int64

7474countStar = count (litExpr True)

7575

7676

7777-- | A count of the number of times a given expression is @true@.

78−countWhere :: Expr Bool -> Aggregate (Expr Int64)

78+countWhere :: Expr Bool -> Aggregate Int64

7979countWhere condition = count (caseExpr [(condition, litExpr (Just True))] null)

8080

8181

8282-- | Corresponds to @bool_and@.

83−and :: Expr Bool -> Aggregate (Expr Bool)

83+and :: Expr Bool -> Aggregate Bool

8484and = unsafeMakeAggregate toPrimExpr fromPrimExpr $

8585 Just Aggregator

8686 { operation = Opaleye.AggrBoolAnd

@@ -90,7 +90,7 @@ and = unsafeMakeAggregate toPrimExpr fromPrimExpr $

9090

9191

9292-- | Corresponds to @bool_or@.

93−or :: Expr Bool -> Aggregate (Expr Bool)

93+or :: Expr Bool -> Aggregate Bool

9494or = unsafeMakeAggregate toPrimExpr fromPrimExpr $

9595 Just Aggregator

9696 { operation = Opaleye.AggrBoolOr

@@ -100,7 +100,7 @@ or = unsafeMakeAggregate toPrimExpr fromPrimExpr $

100100

101101

102102-- | Produce an aggregation for @Expr a@ using the @max@ function.

103−max :: Sql DBMax a => Expr a -> Aggregate (Expr a)

103+max :: Sql DBMax a => Expr a -> Aggregate a

104104max = unsafeMakeAggregate toPrimExpr fromPrimExpr $

105105 Just Aggregator

106106 { operation = Opaleye.AggrMax

@@ -110,7 +110,7 @@ max = unsafeMakeAggregate toPrimExpr fromPrimExpr $

110110

111111

112112-- | Produce an aggregation for @Expr a@ using the @max@ function.

113−min :: Sql DBMin a => Expr a -> Aggregate (Expr a)

113+min :: Sql DBMin a => Expr a -> Aggregate a

114114min = unsafeMakeAggregate toPrimExpr fromPrimExpr $

115115 Just Aggregator

116116 { operation = Opaleye.AggrMin

@@ -123,7 +123,7 @@ min = unsafeMakeAggregate toPrimExpr fromPrimExpr $

123123-- this, and will add explicit cast back to the original input type. This can

124124-- lead to overflows, and if you anticipate very large sums, you should upcast

125125-- your input.

126−sum :: Sql DBSum a => Expr a -> Aggregate (Expr a)

126+sum :: Sql DBSum a => Expr a -> Aggregate a

127127sum = unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) $

128128 Just Aggregator

129129 { operation = Opaleye.AggrSum

@@ -134,13 +134,13 @@ sum = unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) $

134134

135135-- | Take the sum of all expressions that satisfy a predicate.

136136sumWhere :: (Sql DBNum a, Sql DBSum a)

137− => Expr Bool -> Expr a -> Aggregate (Expr a)

137+ => Expr Bool -> Expr a -> Aggregate a

138138sumWhere condition a = sum (caseExpr [(condition, a)] 0)

139139

140140

141141-- | Corresponds to @string_agg()@.

142142stringAgg :: Sql DBString a

143− => Expr db -> Expr a -> Aggregate (Expr a)

143+ => Expr db -> Expr a -> Aggregate a

144144stringAgg delimiter =

145145 unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) $

146146 Just Aggregator

@@ -151,22 +151,22 @@ stringAgg delimiter =

151151

152152

153153-- | Aggregate a value by grouping by it.

154−groupByExpr :: Sql DBEq a => Expr a -> Aggregate (Expr a)

154+groupByExpr :: Sql DBEq a => Expr a -> Aggregate a

155155groupByExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr Nothing

156156

157157

158158-- | Collect expressions values as a list.

159−listAggExpr :: Sql DBType a => Expr a -> Aggregate (Expr [a])

159+listAggExpr :: Sql DBType a => Expr a -> Aggregate [a]

160160listAggExpr = slistAggExpr typeInformation

161161

162162

163163-- | Collect expressions values as a non-empty list.

164−nonEmptyAggExpr :: Sql DBType a => Expr a -> Aggregate (Expr (NonEmpty a))

164+nonEmptyAggExpr :: Sql DBType a => Expr a -> Aggregate (NonEmpty a)

165165nonEmptyAggExpr = snonEmptyAggExpr typeInformation

166166

167167

168168slistAggExpr :: ()

169− => TypeInformation (Unnullify a) -> Expr a -> Aggregate (Expr [a])

169+ => TypeInformation (Unnullify a) -> Expr a -> Aggregate [a]

170170slistAggExpr info = unsafeMakeAggregate to fromPrimExpr $ Just

171171 Aggregator

172172 { operation = Opaleye.AggrArr

@@ -178,7 +178,7 @@ slistAggExpr info = unsafeMakeAggregate to fromPrimExpr $ Just

178178

179179

180180snonEmptyAggExpr :: ()

181− => TypeInformation (Unnullify a) -> Expr a -> Aggregate (Expr (NonEmpty a))

181+ => TypeInformation (Unnullify a) -> Expr a -> Aggregate (NonEmpty a)

182182snonEmptyAggExpr info = unsafeMakeAggregate to fromPrimExpr $ Just

183183 Aggregator

184184 { operation = Opaleye.AggrArr

src/Rel8/Generic/Construction.hs+11−110

@@ -22,7 +22,6 @@ module Rel8.Generic.Construction

2222 , GGDeconstruct, ggdeconstruct

2323 , GGName, ggname

2424 , GGAggregate, ggaggregate

25− , GGAggregate', ggaggregate'

2625 )

2726where

2827

@@ -35,25 +34,25 @@ import GHC.TypeLits ( Symbol )

3534import Prelude

3635

3736-- rel8

38−import Rel8.Aggregate ( Col( A ), Aggregate )

37+import Rel8.Aggregate ( Col( A ), Aggregate( Aggregate ) )

3938import Rel8.Expr ( Col( E ), Expr )

4039import Rel8.Expr.Aggregate ( groupByExpr )

4140import Rel8.Expr.Eq ( (==.) )

4241import Rel8.Expr.Null ( nullify, snull, unsafeUnnullify )

4342import Rel8.Expr.Serialize ( litExpr )

44−import Rel8.FCF ( Compose, Eval, Exp )

43+import Rel8.FCF ( Eval, Exp )

4544import Rel8.Generic.Construction.ADT

4645 ( GConstructorADT, GMakeableADT, gmakeADT

4746 , GConstructableADT

4847 , GBuildADT, gbuildADT, gunbuildADT

4948 , GConstructADT, gconstructADT, gdeconstructADT

5049 , RepresentableConstructors, GConstructors, gcindex, gctabulate

51− , RepresentableFields, gfindex, gftabulate, gftraverse

50+ , RepresentableFields, gfindex, gftabulate

5251 )

5352import Rel8.Generic.Construction.Record

5453 ( GConstructor

5554 , GConstructable, GConstruct, gconstruct, gdeconstruct

56− , Representable, gindex, gtabulate, gtraverse

55+ , Representable, gindex, gtabulate

5756 )

5857import Rel8.Generic.Table ( GGColumns )

5958import Rel8.Kind.Algebra

@@ -78,9 +77,6 @@ import Rel8.Table

7877import Rel8.Table.Bool ( case_ )

7978import Rel8.Type.Tag ( Tag )

8079

81−-- semigroupoids

82−import Data.Functor.Apply ( Apply, MaybeApply( MaybeApply ), liftF2 )

83−

8480

8581type GGBuildable :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Constraint

8682type GGBuildable algebra name rep =

@@ -213,8 +209,7 @@ type GGConstructable algebra rep =

213209type GGConstructable' :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Constraint

214210type family GGConstructable' algebra rep where

215211 GGConstructable' 'K.Product rep =

216− ( Representable (Compose Aggregate TUnreify) (Eval (rep (Reify Expr)))

217− , Representable TUnreify (Eval (rep (Reify Aggregate)))

212+ ( Representable TUnreify (Eval (rep (Reify Aggregate)))

218213 , Representable TUnreify (Eval (rep (Reify Expr)))

219214 , Representable TUnreify (Eval (rep (Reify Insert)))

220215 , Representable TUnreify (Eval (rep (Reify Name)))

@@ -226,7 +221,6 @@ type family GGConstructable' algebra rep where

226221 GGConstructable' 'K.Sum rep =

227222 ( RepresentableConstructors TUnreify (Eval (rep (Reify Expr)))

228223 , RepresentableConstructors TUnreify (Eval (rep (Reify Insert)))

229− , RepresentableFields (Compose Aggregate TUnreify) (Eval (rep (Reify Expr)))

230224 , RepresentableFields TUnreify (Eval (rep (Reify Aggregate)))

231225 , RepresentableFields TUnreify (Eval (rep (Reify Expr)))

232226 , RepresentableFields TUnreify (Eval (rep (Reify Name)))

@@ -365,99 +359,18 @@ ggname gfromColumns = case algebraSing @algebra of

365359type GGAggregate :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type

366360type family GGAggregate algebra rep r where

367361 GGAggregate 'K.Product rep r =

368− GConstruct (Compose Aggregate TUnreify) (Eval (rep (Reify Expr))) r ->

369− GConstruct TUnreify (Eval (rep (Reify Expr))) r

370− GGAggregate 'K.Sum rep r =

371− GBuildADT (Compose Aggregate TUnreify) (Eval (rep (Reify Expr))) r ->

372− GBuildADT TUnreify (Eval (rep (Reify Expr))) r

373−

374−

375−ggaggregate :: forall algebra rep a. GGConstructable algebra rep

376− => (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Expr) -> a)

377− -> (a -> Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Expr))

378− -> GGAggregate algebra rep (Aggregate a) -> a -> Aggregate a

379−ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of

380− SProduct -> flip f exprs $

381− fmap

382− ( gfromColumns

383− . hunreify

384− . gconstruct

385− @(TTable (Reify Expr))

386− @TColumns

387− @TUnreify

388− @(Col (Reify Expr))

389− @(Eval (rep (Reify Expr)))

390− (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)

391− ) .

392− liftF½ .

393− gtraverse @TUnreify @(Eval (rep (Reify Expr))) @_ @Aggregate (MaybeApply . Left)

394− where

395− f =

396− gindex @TUnreify @(Eval (rep (Reify Expr))) @(Aggregate a) .

397− agg .

398− gtabulate @(Compose Aggregate TUnreify) @(Eval (rep (Reify Expr))) @(Aggregate a)

399− exprs =

400− gdeconstruct

401− @(TTable (Reify Expr))

402− @TColumns

403− @TUnreify

404− @(Col (Reify Expr))

405− @(Eval (rep (Reify Expr)))

406− (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns) $

407− hreify $

408− gtoColumns es

409− SSum -> flip f exprs $

410− liftF1½

411− (\tag' ->

412− gfromColumns .

413− hunreify .

414− gbuildADT

415− @(TTable (Reify Expr))

416− @TColumns

417− @TUnreify

418− @(Col (Reify Expr))

419− @(Eval (rep (Reify Expr)))

420− (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)

421− (\tag'' SSpec {nullity} (Reify (E a)) ->

422− Reify $ E $ runTag nullity (tag ==. litExpr tag'') a)

423− (HType (Reify (E tag'))))

424− (groupByExpr tag) .

425− gftraverse @TUnreify @(Eval (rep (Reify Expr))) @_ @Aggregate (MaybeApply . Left)

426− where

427− f =

428− gfindex @TUnreify @(Eval (rep (Reify Expr))) @(Aggregate a) .

429− agg .

430− gftabulate @(Compose Aggregate TUnreify) @(Eval (rep (Reify Expr))) @(Aggregate a)

431− (HType (Reify (E tag)), exprs) =

432− gunbuildADT

433− @(TTable (Reify Expr))

434− @TColumns

435− @TUnreify

436− @(Col (Reify Expr))

437− @(Eval (rep (Reify Expr)))

438− (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns)

439− (\SSpec {nullity} -> case nullity of

440− Null -> id

441− NotNull -> \(Reify (E a)) -> Reify (E (unsafeUnnullify a))) $

442− hreify $

443− gtoColumns es

444−

445−

446−type GGAggregate' :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type

447−type family GGAggregate' algebra rep r where

448− GGAggregate' 'K.Product rep r =

449362 GConstruct TUnreify (Eval (rep (Reify Aggregate))) r ->

450363 GConstruct TUnreify (Eval (rep (Reify Expr))) r

451− GGAggregate' 'K.Sum rep r =

364+ GGAggregate 'K.Sum rep r =

452365 GBuildADT TUnreify (Eval (rep (Reify Aggregate))) r ->

453366 GBuildADT TUnreify (Eval (rep (Reify Expr))) r

454367

455368

456−ggaggregate' :: forall algebra rep exprs agg. GGConstructable algebra rep

369+ggaggregate :: forall algebra rep exprs agg. GGConstructable algebra rep

457370 => (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Aggregate) -> agg)

458371 -> (exprs -> Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Expr))

459− -> GGAggregate' algebra rep agg -> exprs -> agg

460−ggaggregate' gfromColumns gtoColumns agg es = case algebraSing @algebra of

372+ -> GGAggregate algebra rep agg -> exprs -> agg

373+ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of

461374 SProduct -> flip f exprs $

462375 gfromColumns .

463376 hunreify .

@@ -493,8 +406,8 @@ ggaggregate' gfromColumns gtoColumns agg es = case algebraSing @algebra of

493406 @(Col (Reify Aggregate))

494407 @(Eval (rep (Reify Aggregate)))

495408 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)

496− (\tag' SSpec {nullity} (Reify (A a)) ->

497− Reify $ A $ runTag nullity (tag ==. litExpr tag') <$> a)

409+ (\tag' SSpec {nullity} (Reify (A (Aggregate a))) ->

410+ Reify $ A $ Aggregate $ runTag nullity (tag ==. litExpr tag') <$> a)

498411 (HType (Reify (A (groupByExpr tag))))

499412 where

500413 f =

@@ -514,15 +427,3 @@ ggaggregate' gfromColumns gtoColumns agg es = case algebraSing @algebra of

514427 NotNull -> \(Reify (E a)) -> Reify (E (unsafeUnnullify a))) $

515428 hreify $

516429 gtoColumns es

517−

518−

519−liftF½ :: MaybeApply Aggregate a -> Aggregate a

520−liftF½ (MaybeApply ma) = case ma of

521− Left a -> a

522− Right a -> a <$ groupByExpr (litExpr False)

523−

524−

525−liftF1½ :: Apply v => (a -> b -> c) -> v a -> MaybeApply v b -> v c

526−liftF1½ f a (MaybeApply eb) = case eb of

527− Left b -> liftF2 f a b

528− Right b -> fmap (`f` b) a

src/Rel8/Generic/Construction/ADT.hs+3−10

@@ -16,14 +16,13 @@ module Rel8.Generic.Construction.ADT

1616 ( GConstructableADT

1717 , GBuildADT, gbuildADT, gunbuildADT

1818 , GConstructADT, gconstructADT, gdeconstructADT

19− , GFields, RepresentableFields, gftabulate, gfindex, gftraverse

19+ , GFields, RepresentableFields, gftabulate, gfindex

2020 , GConstructors, RepresentableConstructors, gctabulate, gcindex

2121 , GConstructorADT, GMakeableADT, gmakeADT

2222 )

2323where

2424

2525-- base

26−import Control.Applicative ( liftA2 )

2726import Data.Bifunctor ( first )

2827import Data.Functor.Identity ( runIdentity )

2928import Data.Kind ( Constraint, Type )

@@ -41,10 +40,10 @@ import GHC.TypeLits

4140import Prelude hiding ( null )

4241

4342-- rel8

44−import Rel8.FCF ( Compose, Exp )

43+import Rel8.FCF ( Exp )

4544import Rel8.Generic.Construction.Record

4645 ( GConstruct, GConstructable, gconstruct, gdeconstruct

47− , GFields, Representable, gtabulate, gindex, gtraverse

46+ , GFields, Representable, gtabulate, gindex

4847 , FromColumns, ToColumns

4948 )

5049import Rel8.Generic.Table.ADT ( GColumnsADT, GColumnsADT' )

@@ -168,28 +167,22 @@ type RepresentableFields :: (Type -> Exp Type) -> (Type -> Type) -> Constraint

168167class RepresentableFields f rep where

169168 gftabulate :: (GFieldsADT f rep -> a) -> GBuildADT f rep a

170169 gfindex :: GBuildADT f rep a -> GFieldsADT f rep -> a

171− gftraverse :: Applicative m

172− => (forall a. g a -> m a)

173− -> GFieldsADT (Compose g f) rep -> m (GFieldsADT f rep)

174170

175171

176172instance RepresentableFields f rep => RepresentableFields f (M1 D meta rep) where

177173 gftabulate = gftabulate @f @rep

178174 gfindex = gfindex @f @rep

179− gftraverse = gftraverse @f @rep

180175

181176

182177instance (RepresentableFields f a, RepresentableFields f b) => RepresentableFields f (a :+: b) where

183178 gftabulate f =

184179 gftabulate @f @a \a -> gftabulate @f @b \b -> f (a, b)

185180 gfindex f (a, b) = gfindex @f @b (gfindex @f @a f a) b

186− gftraverse f (a, b) = liftA2 (,) (gftraverse @f @a f a) (gftraverse @f @b f b)

187181

188182

189183instance Representable f rep => RepresentableFields f (M1 C meta rep) where

190184 gftabulate = gtabulate @f @rep

191185 gfindex = gindex @f @rep

192− gftraverse = gtraverse @f @rep

193186

194187

195188type GConstructableADT

src/Rel8/Generic/Construction/Record.hs+2−10

@@ -13,13 +13,12 @@

1313

1414module Rel8.Generic.Construction.Record

1515 ( GConstructor, GConstruct, GConstructable, gconstruct, gdeconstruct

16− , GFields, Representable, gtabulate, gindex, gtraverse

16+ , GFields, Representable, gtabulate, gindex

1717 , FromColumns, ToColumns

1818 )

1919where

2020

2121-- base

22−import Control.Applicative ( liftA2 )

2322import Data.Kind ( Constraint, Type )

2423import Data.Proxy ( Proxy( Proxy ) )

2524import GHC.Generics

@@ -33,7 +32,7 @@ import GHC.TypeLits

3332import Prelude

3433

3534-- rel8

36−import Rel8.FCF ( Compose, Eval, Exp )

35+import Rel8.FCF ( Eval, Exp )

3736import Rel8.Generic.Table.Record ( GColumns )

3837import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )

3938import Rel8.Schema.HTable ( HTable )

@@ -92,15 +91,11 @@ type Representable :: (Type -> Exp Type) -> (Type -> Type) -> Constraint

9291class Representable f rep where

9392 gtabulate :: (GFields f rep -> a) -> GConstruct f rep a

9493 gindex :: GConstruct f rep a -> GFields f rep -> a

95− gtraverse :: Applicative m

96− => (forall a. g a -> m a)

97− -> GFields (Compose g f) rep -> m (GFields f rep)

9894

9995

10096instance Representable f rep => Representable f (M1 i meta rep) where

10197 gtabulate = gtabulate @f @rep

10298 gindex = gindex @f @rep

103− gtraverse = gtraverse @f @rep

10499

105100

106101instance (Representable f a, Representable f b) =>

@@ -108,19 +103,16 @@ instance (Representable f a, Representable f b) =>

108103 where

109104 gtabulate f = gtabulate @f @a \a -> gtabulate @f @b \b -> f (a, b)

110105 gindex f (a, b) = gindex @f @b (gindex @f @a f a) b

111− gtraverse f (a, b) = liftA2 (,) (gtraverse @f @a f a) (gtraverse @f @b f b)

112106

113107

114108instance Representable f U1 where

115109 gtabulate = ($ ())

116110 gindex = const

117− gtraverse = const pure

118111

119112

120113instance Representable f (K1 i a) where

121114 gtabulate = id

122115 gindex = id

123− gtraverse = id

124116

125117

126118type GConstructable

src/Rel8/Query/Aggregate.hs+3−2

@@ -1,4 +1,5 @@

11{-# language FlexibleContexts #-}

2+{-# language MonoLocalBinds #-}

34module Rel8.Query.Aggregate

45 ( aggregate

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

1415import qualified Opaleye.Aggregate as Opaleye

1516

1617-- rel8

17−import Rel8.Aggregate ( Aggregate )

18+import Rel8.Aggregate ( Aggregates )

1819import Rel8.Expr ( Expr )

1920import Rel8.Expr.Aggregate ( countStar )

2021import Rel8.Query ( Query )

@@ -25,7 +26,7 @@ import Rel8.Table.Maybe ( maybeTable )

2526

2627

2728-- | Apply an aggregation to all rows returned by a 'Query'.

28−aggregate :: Query (Aggregate exprs) -> Query exprs

29+aggregate :: Aggregates aggregates exprs => Query aggregates -> Query exprs

2930aggregate = mapOpaleye (Opaleye.aggregate aggregator)

3031

3132

src/Rel8/Query/List.hs+10−3

@@ -28,7 +28,7 @@ import Rel8.Query.Maybe ( optional )

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

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

3030import Rel8.Schema.Spec ( SSpec( SSpec, info ) )

31−import Rel8.Table ( Table, fromColumns )

31+import Rel8.Table ( Table, fromColumns, toColumns )

3232import Rel8.Table.Aggregate ( listAgg, nonEmptyAgg )

3333import Rel8.Table.List ( ListTable( ListTable ) )

3434import Rel8.Table.Maybe ( maybeTable )

@@ -46,7 +46,11 @@ import Rel8.Type.Information ( TypeInformation )

4646-- @many@ is analogous to 'Control.Applicative.many' from

4747-- @Control.Applicative@.

4848many :: Table Expr a => Query a -> Query (ListTable a)

49−many = fmap (maybeTable mempty id) . optional . aggregate . fmap listAgg

49+many =

50+ fmap (maybeTable mempty (\(ListTable a) -> ListTable a)) .

51+ optional .

52+ aggregate .

53+ fmap (listAgg . toColumns)

5054

5155

5256-- | Aggregate a 'Query' into a 'NonEmptyTable'. If the supplied query returns

@@ -58,7 +62,10 @@ many = fmap (maybeTable mempty id) . optional . aggregate . fmap listAgg

5862-- @some@ is analogous to 'Control.Applicative.some' from

5963-- @Control.Applicative@.

6064some :: Table Expr a => Query a -> Query (NonEmptyTable a)

61−some = aggregate . fmap nonEmptyAgg

65+some =

66+ fmap (\(NonEmptyTable a) -> NonEmptyTable a) .

67+ aggregate .

68+ fmap (nonEmptyAgg . toColumns)

6269

6370

6471-- | A version of 'many' specialised to single expressions.

src/Rel8/Schema/Context/Nullify.hs+6−5

@@ -25,7 +25,7 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

2525

2626-- rel8

2727import Rel8.Aggregate

28− ( Aggregate, Col( A )

28+ ( Aggregate( Aggregate ), Col( A )

2929 , mapInputs

3030 , unsafeMakeAggregate

3131 )

@@ -85,15 +85,16 @@ instance Nullifiable Aggregate where

8585

8686 decodeTag (A aggregate) = fromAggregate aggregate

8787

88− nullifier Tag {expr} test SSpec {nullity} (A aggregate) =

88+ nullifier Tag {expr} test SSpec {nullity} (A (Aggregate a)) =

8989 A $

9090 mapInputs (toPrimExpr . runTag nullity condition . fromPrimExpr) $

91− runTag nullity condition <$> aggregate

91+ Aggregate $

92+ runTag nullity condition <$> a

9293 where

9394 condition = test expr

9495

95− unnullifier SSpec {nullity} (A aggregate) =

96− A $ unnull nullity <$> aggregate

96+ unnullifier SSpec {nullity} (A (Aggregate a)) =

97+ A (Aggregate (unnull nullity <$> a))

9798

9899 {-# INLINABLE encodeTag #-}

99100 {-# INLINABLE decodeTag #-}

src/Rel8/Schema/Insert.hs+2−2

@@ -101,7 +101,7 @@ instance (KnownNecessity necessity, Sql DBType a) =>

101101

102102

103103instance Sql DBType a =>

104− Recontextualize Aggregate Insert (Aggregate (Expr a)) (Create 'Required a)

104+ Recontextualize Aggregate Insert (Aggregate a) (Create 'Required a)

105105

106106

107107instance Sql DBType a => Recontextualize Expr Insert (Expr a) (Create 'Required a)

@@ -112,7 +112,7 @@ instance Sql DBType a =>

112112

113113

114114instance Sql DBType a =>

115− Recontextualize Insert Aggregate (Create 'Required a) (Aggregate (Expr a))

115+ Recontextualize Insert Aggregate (Create 'Required a) (Aggregate a)

116116

117117

118118instance Sql DBType a => Recontextualize Insert Expr (Create 'Required a) (Expr a)

src/Rel8/Table/ADT.hs+3−3

@@ -203,10 +203,10 @@ type AggregateADT t = forall r. GGAggregate 'K.Sum (ADTRep t) r

203203

204204

205205aggregateADT :: forall t. ConstructableADT t

206− => AggregateADT t -> ADT t Expr -> Aggregate (ADT t Expr)

206+ => AggregateADT t -> ADT t Expr -> ADT t Aggregate

207207aggregateADT f =

208− ggaggregate @'K.Sum @(ADTRep t) @(ADT t Expr) ADT (\(ADT a) -> a)

209− (f @(Aggregate (ADT t Expr)))

208+ ggaggregate @'K.Sum @(ADTRep t) @(ADT t Expr) @(ADT t Aggregate) ADT (\(ADT a) -> a)

209+ (f @(ADT t Aggregate))

210210

211211

212212data ADTRep :: K.Rel8able -> K.Context -> Exp (Type -> Type)

src/Rel8/Table/Aggregate.hs+17−9

@@ -6,7 +6,7 @@

66{-# language ViewPatterns #-}

88module Rel8.Table.Aggregate

9− ( groupBy

9+ ( groupBy, hgroupBy

1010 , listAgg, nonEmptyAgg

1111 )

1212where

@@ -16,7 +16,7 @@ import Data.Functor.Identity ( Identity( Identity ) )

1616import Prelude

1717

1818-- rel8

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

19+import Rel8.Aggregate ( Aggregate, Aggregates, Col( A ) )

2020import Rel8.Expr ( Expr, Col( E ) )

2121import Rel8.Expr.Aggregate

2222 ( groupByExpr

@@ -24,20 +24,28 @@ import Rel8.Expr.Aggregate

2424 , snonEmptyAggExpr

2525 )

2626import Rel8.Schema.Dict ( Dict( Dict ) )

27−import Rel8.Schema.HTable ( hfield, htabulate )

27+import Rel8.Schema.HTable ( HTable, hfield, htabulate )

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

2929import Rel8.Schema.Spec ( SSpec( SSpec, info ) )

30−import Rel8.Table ( Table, toColumns, fromColumns )

30+import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )

31+import Rel8.Table ( toColumns, fromColumns )

3132import Rel8.Table.Eq ( EqTable, eqTable )

3233import Rel8.Table.List ( ListTable )

3334import Rel8.Table.NonEmpty ( NonEmptyTable )

35+import Rel8.Type.Eq ( DBEq )

3436

3537

3638-- | Group equal tables together. This works by aggregating each column in the

3739-- given table with 'groupByExpr'.

38−groupBy :: forall exprs. EqTable exprs => exprs -> Aggregate exprs

39−groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->

40− case hfield (eqTable @exprs) field of

40+groupBy :: forall exprs aggregates. (EqTable exprs, Aggregates aggregates exprs)

41+ => exprs -> aggregates

42+groupBy = fromColumns . hgroupBy (eqTable @exprs) . toColumns

43+

44+

45+hgroupBy :: HTable t

46+ => t (Dict (ConstrainDBType DBEq)) -> t (Col Expr) -> t (Col Aggregate)

47+hgroupBy eqs exprs = fromColumns $ htabulate $ \field ->

48+ case hfield eqs field of

4149 Dict -> case hfield exprs field of

4250 E expr -> A $ groupByExpr expr

4351

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

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

5967-- return (order, items)

6068-- @

61−listAgg :: Table Expr a => a -> Aggregate (ListTable a)

69+listAgg :: Aggregates aggregates exprs => exprs -> ListTable aggregates

6270listAgg (toColumns -> exprs) = fromColumns $

6371 hvectorize

6472 (\SSpec {info} (Identity (E a)) -> A $ slistAggExpr info a)

@@ -66,7 +74,7 @@ listAgg (toColumns -> exprs) = fromColumns $

6674

6775

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

69−nonEmptyAgg :: Table Expr a => a -> Aggregate (NonEmptyTable a)

77+nonEmptyAgg :: Aggregates aggregates exprs => exprs -> NonEmptyTable aggregates

7078nonEmptyAgg (toColumns -> exprs) = fromColumns $

7179 hvectorize

7280 (\SSpec {info} (Identity (E a)) -> A $ snonEmptyAggExpr info a)

src/Rel8/Table/Either.hs+2−16

@@ -18,7 +18,7 @@ module Rel8.Table.Either

1818 ( EitherTable(..)

1919 , eitherTable, leftTable, rightTable

2020 , isLeftTable, isRightTable

21− , aggregateEitherTable, insertEitherTable, nameEitherTable

21+ , insertEitherTable, nameEitherTable

2222 )

2323where

2424

@@ -30,9 +30,7 @@ import Data.Kind ( Type )

3030import Prelude hiding ( undefined )

3131

3232-- rel8

33−import Rel8.Aggregate ( Aggregate, unsafeMakeAggregate )

3433import Rel8.Expr ( Expr )

35−import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )

3634import Rel8.Expr.Serialize ( litExpr )

3735import Rel8.Schema.Context.Label

3836 ( Labelable

@@ -66,7 +64,7 @@ import Rel8.Table.Undefined ( undefined )

6664import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ), isLeft, isRight )

6765

6866-- semigroupoids

69−import Data.Functor.Apply ( Apply, (<.>), liftF3 )

67+import Data.Functor.Apply ( Apply, (<.>) )

7068import Data.Functor.Bind ( Bind, (>>-) )

7169

7270

@@ -179,18 +177,6 @@ rightTableWith :: a -> b -> EitherTable a b

179177rightTableWith = EitherTable (fromExpr (litExpr IsRight))

180178

181179

182−aggregateEitherTable :: ()

183− => (a -> Aggregate c)

184− -> (b -> Aggregate d)

185− -> EitherTable a b

186− -> Aggregate (EitherTable c d)

187−aggregateEitherTable f g EitherTable {tag, left, right} =

188− liftF3 EitherTable (tag <$ aggregate) (f left) (g right)

189− where

190− Tag {aggregator, expr} = tag

191− aggregate = unsafeMakeAggregate toPrimExpr fromPrimExpr aggregator expr

192−

193−

194180insertEitherTable :: (Table Insert a, Table Insert b)

195181 => Either a b -> EitherTable a b

196182insertEitherTable = \case

src/Rel8/Table/HKD.hs+3−3

@@ -269,10 +269,10 @@ type AggregateHKD a = forall r. GGAggregate (GAlgebra (Rep a)) (HKDRep a) r

269269

270270

271271aggregateHKD :: forall a. ConstructableHKD a

272− => AggregateHKD a -> HKD a Expr -> Aggregate (HKD a Expr)

272+ => AggregateHKD a -> HKD a Expr -> HKD a Aggregate

273273aggregateHKD f =

274− ggaggregate @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Expr) HKD (\(HKD a) -> a)

275− (f @(Aggregate (HKD a Expr)))

274+ ggaggregate @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Expr) @(HKD a Aggregate) HKD (\(HKD a) -> a)

275+ (f @(HKD a Aggregate))

276276

277277

278278data HKDRep :: Type -> K.Context -> Exp (Type -> Type)

src/Rel8/Table/Maybe.hs+2−12

@@ -17,7 +17,7 @@ module Rel8.Table.Maybe

1717 , maybeTable, nothingTable, justTable

1818 , isNothingTable, isJustTable

1919 , ($?)

20− , aggregateMaybeTable, insertMaybeTable, nameMaybeTable

20+ , insertMaybeTable, nameMaybeTable

2121 )

2222where

2323

@@ -27,11 +27,9 @@ import Data.Kind ( Type )

2727import Prelude hiding ( null, undefined )

2828

2929-- rel8

30−import Rel8.Aggregate ( Aggregate, unsafeMakeAggregate )

3130import Rel8.Expr ( Expr )

3231import Rel8.Expr.Bool ( boolExpr )

3332import Rel8.Expr.Null ( isNull, isNonNull, null, nullify )

34−import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )

3533import Rel8.Schema.Context.Label

3634 ( Labelable, HLabelable, hlabeler, hunlabeler

3735 )

@@ -69,7 +67,7 @@ import Rel8.Type ( DBType )

6967import Rel8.Type.Tag ( MaybeTag )

7068

7169-- semigroupoids

72−import Data.Functor.Apply ( Apply, (<.>), liftF2 )

70+import Data.Functor.Apply ( Apply, (<.>) )

7371import Data.Functor.Bind ( Bind, (>>-) )

7472

7573

@@ -211,14 +209,6 @@ f $? ma@(MaybeTable _ a) = case nullable @b of

211209infixl 4 $?

212210

213211

214−aggregateMaybeTable :: ()

215− => (a -> Aggregate b) -> MaybeTable a -> Aggregate (MaybeTable b)

216−aggregateMaybeTable f MaybeTable {tag = tag@Tag {aggregator, expr}, just} =

217− liftF2 MaybeTable (tag <$ aggregate) (f just)

218− where

219− aggregate = unsafeMakeAggregate toPrimExpr fromPrimExpr aggregator expr

220−

221−

222212insertMaybeTable :: Table Insert a => Maybe a -> MaybeTable a

223213insertMaybeTable = \case

224214 Nothing -> MaybeTable (fromExpr null) (fromColumns (toInsert undefined))

src/Rel8/Table/Opaleye.hs+7−4

@@ -35,7 +35,7 @@ import qualified Opaleye.Internal.Table as Opaleye

3535import Data.Profunctor ( dimap, lmap )

3636

3737-- rel8

38−import Rel8.Aggregate ( Aggregate( Aggregate ) )

38+import Rel8.Aggregate ( Col( A ), Aggregate( Aggregate ), Aggregates )

3939import Rel8.Expr ( Expr, Col(..) )

4040import Rel8.Expr.Opaleye

4141 ( fromPrimExpr, toPrimExpr

@@ -56,9 +56,12 @@ import Rel8.Table.Undefined ( undefined )

5656import Data.Functor.Apply ( WrappedApplicative(..) )

5757

5858

59−aggregator :: Opaleye.Aggregator (Aggregate exprs) exprs

60−aggregator = Opaleye.Aggregator $ Opaleye.PackMap $

61− \f (Aggregate (Opaleye.Aggregator (Opaleye.PackMap inner))) -> inner f ()

59+aggregator :: Aggregates aggregates exprs => Opaleye.Aggregator aggregates exprs

60+aggregator = Opaleye.Aggregator $ Opaleye.PackMap $ \f aggregates ->

61+ fmap fromColumns $ unwrapApplicative $ htabulateA $ \field ->

62+ WrapApplicative $ case hfield (toColumns aggregates) field of

63+ A (Aggregate (Opaleye.Aggregator (Opaleye.PackMap inner))) ->

64+ E <$> inner f ()

6265

6366

6467binaryspec :: Table Expr a => Opaleye.Binaryspec a a

src/Rel8/Table/Tag.hs+1−1

@@ -79,7 +79,7 @@ instance (KnownSymbol label, Taggable a) => Monoid (Tag label a) where

7979

8080

8181fromAggregate :: forall a label. (KnownSymbol label, Taggable a)

82− => Aggregate (Expr a) -> Tag label a

82+ => Aggregate a -> Tag label a

8383fromAggregate = fold . getFirst . foldInputs go

8484 where

8585 go aggregator primExpr = pure $ (tempty @a @label)

src/Rel8/Table/These.hs+3−13

@@ -21,7 +21,7 @@ module Rel8.Table.These

2121 , isThisTable, isThatTable, isThoseTable

2222 , hasHereTable, hasThereTable

2323 , justHereTable, justThereTable

24− , aggregateTheseTable, insertTheseTable, nameTheseTable

24+ , insertTheseTable, nameTheseTable

2525 )

2626where

2727

@@ -33,7 +33,6 @@ import Data.Kind ( Type )

3333import Prelude hiding ( undefined )

3434

3535-- rel8

36−import Rel8.Aggregate ( Aggregate )

3736import Rel8.Expr ( Expr )

3837import Rel8.Expr.Bool ( (&&.), not_ )

3938import Rel8.Expr.Null ( isNonNull )

@@ -63,7 +62,7 @@ import Rel8.Table.Maybe

6362 ( MaybeTable(..)

6463 , maybeTable, justTable, nothingTable

6564 , isJustTable

66− , aggregateMaybeTable, insertMaybeTable, nameMaybeTable

65+ , insertMaybeTable, nameMaybeTable

6766 )

6867import Rel8.Table.Ord ( OrdTable, ordTable )

6968import Rel8.Table.Recontextualize ( Recontextualize )

@@ -73,7 +72,7 @@ import Rel8.Table.Undefined ( undefined )

7372import Rel8.Type.Tag ( MaybeTag )

7473

7574-- semigroupoids

76−import Data.Functor.Apply ( Apply, (<.>), liftF2 )

75+import Data.Functor.Apply ( Apply, (<.>) )

7776import Data.Functor.Bind ( Bind, (>>-) )

7877

7978-- these

@@ -232,15 +231,6 @@ theseTable f g h TheseTable {here, there} =

232231 there

233232

234233

235−aggregateTheseTable :: ()

236− => (a -> Aggregate c)

237− -> (b -> Aggregate d)

238− -> TheseTable a b

239− -> Aggregate (TheseTable c d)

240−aggregateTheseTable f g TheseTable {here, there} =

241− liftF2 TheseTable (aggregateMaybeTable f here) (aggregateMaybeTable g there)

242−

243−

244234insertTheseTable :: (Table Insert a, Table Insert b)

245235 => These a b -> TheseTable a b

246236insertTheseTable =

src/Rel8/Tabulate.hs+24−13

@@ -1,6 +1,9 @@

11{-# language DeriveFunctor #-}

22{-# language DerivingStrategies #-}

33{-# language FlexibleContexts #-}

4+{-# language MonoLocalBinds #-}

5+{-# language ScopedTypeVariables #-}

6+{-# language TypeApplications #-}

47{-# language TupleSections #-}

58{-# language UndecidableInstances #-}

@@ -43,7 +46,7 @@ import Data.Maybe ( fromMaybe )

4346import Prelude hiding ( filter, lookup, zip, zipWith )

4447

4548-- rel8

46−import Rel8.Aggregate ( Aggregate )

49+import Rel8.Aggregate ( Aggregates )

4750import Rel8.Expr ( Expr )

4851import Rel8.Order ( Order )

4952import Rel8.Query ( Query )

@@ -54,16 +57,16 @@ import Rel8.Query.Filter ( filter, where_ )

5457import Rel8.Query.Maybe ( optional )

5558import Rel8.Query.Order ( orderBy )

5659import Rel8.Query.These ( alignBy )

57−import Rel8.Table ( Table )

58−import Rel8.Table.Aggregate ( groupBy, listAgg, nonEmptyAgg )

60+import Rel8.Table ( Table, fromColumns, toColumns )

61+import Rel8.Table.Aggregate ( hgroupBy, listAgg, nonEmptyAgg )

5962import Rel8.Table.Alternative

6063 ( AltTable, (<|>:)

6164 , AlternativeTable, emptyTable

6265 )

63−import Rel8.Table.Eq ( EqTable, (==:) )

64−import Rel8.Table.List ( ListTable )

66+import Rel8.Table.Eq ( EqTable, (==:), eqTable )

67+import Rel8.Table.List ( ListTable( ListTable ) )

6568import Rel8.Table.Maybe ( MaybeTable, maybeTable )

66−import Rel8.Table.NonEmpty ( NonEmptyTable )

69+import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )

6770import Rel8.Table.Ord ( OrdTable )

6871import Rel8.Table.Order ( ascTable )

6972import Rel8.Table.These ( TheseTable, theseTable )

@@ -72,7 +75,6 @@ import Rel8.Table.These ( TheseTable, theseTable )

7275import Data.Functor.Apply ( Apply, liftF2 )

7376import Data.Functor.Bind ( Bind )

7477import qualified Data.Functor.Bind

75−import Data.Semigroup.Traversable.Class ( bitraverse1 )

7678

7779

7880-- | @'Tabulation' k a@ is denotionally a @MultiMap k a@ — a @Map@ where each

@@ -338,9 +340,15 @@ difference kas kbs = do

338340 fromQuery $ as >>= withoutBy (\(k, _) (l, _) -> k ==: l) bs

339341

340342

341−aggregateTabulation :: EqTable k

342− => Tabulation k (Aggregate a) -> Tabulation k a

343−aggregateTabulation = mapQuery (aggregate . fmap (bitraverse1 groupBy id))

343+aggregateTabulation :: forall k aggregates exprs.

344+ ( EqTable k

345+ , Aggregates aggregates exprs

346+ )

347+ => Tabulation k aggregates -> Tabulation k exprs

348+aggregateTabulation = mapQuery $

349+ fmap (first fromColumns) .

350+ aggregate .

351+ fmap (first (hgroupBy (eqTable @k) . toColumns))

344352

345353

346354-- | 'orderTabulation' orders the /values/ of a 'Tabulation' within each key.

@@ -372,15 +380,18 @@ optionalTabulation as = Tabulation $ \k -> do

372380manyTabulation :: (EqTable k, Table Expr a)

373381 => Tabulation k a -> Tabulation k (ListTable a)

374382manyTabulation =

375− fmap (maybeTable mempty id) .

383+ fmap (maybeTable mempty (\(ListTable a) -> ListTable a)) .

376384 optionalTabulation .

377385 aggregateTabulation .

378− fmap listAgg

386+ fmap (listAgg . toColumns)

379387

380388

381389someTabulation :: (EqTable k, Table Expr a)

382390 => Tabulation k a -> Tabulation k (NonEmptyTable a)

383−someTabulation = aggregateTabulation . fmap nonEmptyAgg

391+someTabulation =

392+ fmap (\(NonEmptyTable a) -> NonEmptyTable a) .

393+ aggregateTabulation .

394+ fmap (nonEmptyAgg . toColumns)

384395

385396

386397mapQuery :: (Query (k, a) -> Query (k, b)) -> Tabulation k a -> Tabulation k b