a9f500e · rel8 · git.iko.soy

rel8.cabal−3

compare with master

unifiedsplit

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

41 Rel8.Expr.Time

42 Rel8.Tabulate

43

44− -- deprecated

45− Rel8.Aggregate.Legacy

46−

47 other-modules:

44 other-modules:

48 Rel8.Aggregate

45 Rel8.Aggregate

49

46

src/Rel8.hs+1−3

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

59 , catMaybeTable

60 , bindMaybeTable

61 , traverseMaybeTable

62− , aggregateMaybeTable

63 , insertMaybeTable

62 , insertMaybeTable

64 , nameMaybeTable

63 , nameMaybeTable

65

64

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

71 , keepRightTable

70 , keepRightTable

72 , bindEitherTable

71 , bindEitherTable

73 , bitraverseEitherTable

72 , bitraverseEitherTable

74− , aggregateEitherTable

75 , insertEitherTable

73 , insertEitherTable

76 , nameEitherTable

74 , nameEitherTable

77

75

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

89 , keepThoseTable, loseThoseTable

87 , keepThoseTable, loseThoseTable

90 , bindTheseTable

88 , bindTheseTable

91 , bitraverseTheseTable

89 , bitraverseTheseTable

92− , aggregateTheseTable

93 , insertTheseTable

90 , insertTheseTable

94 , nameTheseTable

91 , nameTheseTable

95

92

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

218

215

219 -- ** Aggregation

216 -- ** Aggregation

220 , Aggregate

217 , Aggregate

218+ , Aggregates

221 , aggregate

219 , aggregate

222 , countRows

220 , countRows

223 , groupBy

221 , groupBy

src/Rel8/Aggregate.hs+19−33

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

31import qualified Opaleye.Internal.PackMap as Opaleye

32

33-- rel8

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

34+import Rel8.Expr ( Expr )

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

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

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

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

38import Rel8.Schema.Name ( Name )

39import Rel8.Schema.Null ( Sql )

40import Rel8.Schema.Reify ( notReify )

41import Rel8.Schema.Result ( Result )

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

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

43import Rel8.Table

44 ( Table, Columns, Context, fromColumns, toColumns

45 , reify, unreify

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

47import Rel8.Table.Recontextualize ( Recontextualize )

48import Rel8.Type ( DBType )

49

50−-- semigroupoids

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

52−

53

50

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

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

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

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

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

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

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

59type Aggregate :: k -> Type

56type Aggregate :: k -> Type

60data Aggregate a where

57data Aggregate a where

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

58+ Aggregate :: !(Opaleye.Aggregator () (Expr 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)

70

59

71

60

72instance Interpretation Aggregate where

61instance Interpretation Aggregate where

73 data Col Aggregate _spec where

62 data Col Aggregate _spec where

74 A :: ()

63 A :: ()

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

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

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

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

77

66

78

67

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

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

80− type Columns (Aggregate a) = Columns a

69+ type Columns (Aggregate a) = HType a

81 type Context (Aggregate a) = Aggregate

70 type Context (Aggregate a) = Aggregate

82

71

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

72+ toColumns = HIdentity . A

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

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

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

86− case hfield as field of

87− A a -> E <$> a

88

74

89 reify = notReify

75 reify = notReify

90 unreify = notReify

76 unreify = notReify

91

77

92

78

93instance Sql DBType a =>

79instance Sql DBType a =>

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

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

95

81

96

82

97instance Sql DBType a =>

83instance Sql DBType a =>

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

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

99

85

100

86

101instance Sql DBType a =>

87instance Sql DBType a =>

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

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

103

89

104

90

105instance Sql DBType a =>

91instance Sql DBType a =>

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

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

107

93

108

94

109instance Sql DBType a =>

95instance Sql DBType a =>

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

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

111

97

112

98

113instance Sql DBType a =>

99instance Sql DBType a =>

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

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

115

101

116

102

117instance Sql DBType a =>

103instance Sql DBType a =>

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

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

119

105

120

106

121instance Labelable Aggregate where

107instance Labelable Aggregate where

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

156

142

157

143

158unsafeMakeAggregate :: ()

144unsafeMakeAggregate :: ()

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

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

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

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

161 -> Maybe Aggregator

147 -> Maybe Aggregator

162− -> input

148+ -> Expr input

163 -> Aggregate output

149 -> Aggregate output

164unsafeMakeAggregate input output aggregator expr =

150unsafeMakeAggregate input output aggregator expr =

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

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

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

43type family Field context necessity a where

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

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

45+ Field Aggregate _necessity a = Aggregate a

46 Field Expr _necessity a = Expr a

47 Field Insert 'Required a = Expr a

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

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

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

49

50

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

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

52+count :: Expr a -> Aggregate Int64

53count = unsafeMakeAggregate toPrimExpr fromPrimExpr $

54 Just Aggregator

55 { operation = Opaleye.AggrCount

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

60

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

62-- @COUNT(DISTINCT a)@

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

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

64countDistinct = unsafeMakeAggregate toPrimExpr fromPrimExpr $

65 Just Aggregator

66 { operation = Opaleye.AggrCount

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

70

71

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

73−countStar :: Aggregate (Expr Int64)

73+countStar :: Aggregate Int64

74countStar = count (litExpr True)

75

76

77-- | 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

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

80

81

82-- | Corresponds to @bool_and@.

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

83+and :: Expr Bool -> Aggregate Bool

84and = unsafeMakeAggregate toPrimExpr fromPrimExpr $

85 Just Aggregator

86 { operation = Opaleye.AggrBoolAnd

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

90

91

92-- | Corresponds to @bool_or@.

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

93+or :: Expr Bool -> Aggregate Bool

94or = unsafeMakeAggregate toPrimExpr fromPrimExpr $

95 Just Aggregator

96 { operation = Opaleye.AggrBoolOr

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

100

101

102-- | 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

104max = unsafeMakeAggregate toPrimExpr fromPrimExpr $

105 Just Aggregator

106 { operation = Opaleye.AggrMax

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

110

111

112-- | 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

114min = unsafeMakeAggregate toPrimExpr fromPrimExpr $

115 Just Aggregator

116 { operation = Opaleye.AggrMin

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

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

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

125-- your input.

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

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

127sum = unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) $

128 Just Aggregator

129 { operation = Opaleye.AggrSum

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

134

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

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

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

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

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

139

140

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

142stringAgg :: Sql DBString a

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

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

144stringAgg delimiter =

145 unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) $

146 Just Aggregator

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

151

152

153-- | 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

155groupByExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr Nothing

156

157

158-- | 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]

160listAggExpr = slistAggExpr typeInformation

161

162

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

165nonEmptyAggExpr = snonEmptyAggExpr typeInformation

166

167

168slistAggExpr :: ()

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

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

170slistAggExpr info = unsafeMakeAggregate to fromPrimExpr $ Just

171 Aggregator

172 { operation = Opaleye.AggrArr

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

178

179

180snonEmptyAggExpr :: ()

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

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

182snonEmptyAggExpr info = unsafeMakeAggregate to fromPrimExpr $ Just

183 Aggregator

184 { operation = Opaleye.AggrArr

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

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

22 , GGDeconstruct, ggdeconstruct

23 , GGName, ggname

24 , GGAggregate, ggaggregate

25− , GGAggregate', ggaggregate'

26 )

25 )

27where

26where

28

27

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

35import Prelude

34import Prelude

36

35

37-- rel8

36-- rel8

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

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

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

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

40import Rel8.Expr.Aggregate ( groupByExpr )

39import Rel8.Expr.Aggregate ( groupByExpr )

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

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

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

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

43import Rel8.Expr.Serialize ( litExpr )

42import Rel8.Expr.Serialize ( litExpr )

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

43+import Rel8.FCF ( Eval, Exp )

45import Rel8.Generic.Construction.ADT

44import Rel8.Generic.Construction.ADT

46 ( GConstructorADT, GMakeableADT, gmakeADT

45 ( GConstructorADT, GMakeableADT, gmakeADT

47 , GConstructableADT

46 , GConstructableADT

48 , GBuildADT, gbuildADT, gunbuildADT

47 , GBuildADT, gbuildADT, gunbuildADT

49 , GConstructADT, gconstructADT, gdeconstructADT

48 , GConstructADT, gconstructADT, gdeconstructADT

50 , RepresentableConstructors, GConstructors, gcindex, gctabulate

49 , RepresentableConstructors, GConstructors, gcindex, gctabulate

51− , RepresentableFields, gfindex, gftabulate, gftraverse

50+ , RepresentableFields, gfindex, gftabulate

52 )

51 )

53import Rel8.Generic.Construction.Record

52import Rel8.Generic.Construction.Record

54 ( GConstructor

53 ( GConstructor

55 , GConstructable, GConstruct, gconstruct, gdeconstruct

54 , GConstructable, GConstruct, gconstruct, gdeconstruct

56− , Representable, gindex, gtabulate, gtraverse

55+ , Representable, gindex, gtabulate

57 )

56 )

58import Rel8.Generic.Table ( GGColumns )

57import Rel8.Generic.Table ( GGColumns )

59import Rel8.Kind.Algebra

58import Rel8.Kind.Algebra

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

78import Rel8.Table.Bool ( case_ )

77import Rel8.Table.Bool ( case_ )

79import Rel8.Type.Tag ( Tag )

78import Rel8.Type.Tag ( Tag )

80

79

81−-- semigroupoids

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

83−

84

80

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

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

86type GGBuildable algebra name rep =

82type GGBuildable algebra name rep =

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

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

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

214type family GGConstructable' algebra rep where

210type family GGConstructable' algebra rep where

215 GGConstructable' 'K.Product rep =

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

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

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

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

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

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

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

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

226 GGConstructable' 'K.Sum rep =

221 GGConstructable' 'K.Sum rep =

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

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

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

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

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

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

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

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

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

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

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

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

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

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

366type family GGAggregate algebra rep r where

360type family GGAggregate algebra rep r where

367 GGAggregate 'K.Product rep r =

361 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 =

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

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

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

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

451− GGAggregate' 'K.Sum rep r =

364+ GGAggregate 'K.Sum rep r =

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

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

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

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

454

367

455

368

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

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

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

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

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

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

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

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

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

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

461 SProduct -> flip f exprs $

374 SProduct -> flip f exprs $

462 gfromColumns .

375 gfromColumns .

463 hunreify .

376 hunreify .

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

493 @(Col (Reify Aggregate))

406 @(Col (Reify Aggregate))

494 @(Eval (rep (Reify Aggregate)))

407 @(Eval (rep (Reify Aggregate)))

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

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

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

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

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

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

498 (HType (Reify (A (groupByExpr tag))))

411 (HType (Reify (A (groupByExpr tag))))

499 where

412 where

500 f =

413 f =

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

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

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

515 hreify $

428 hreify $

516 gtoColumns es

429 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

16 ( GConstructableADT

17 , GBuildADT, gbuildADT, gunbuildADT

18 , GConstructADT, gconstructADT, gdeconstructADT

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

19+ , GFields, RepresentableFields, gftabulate, gfindex

20 , GConstructors, RepresentableConstructors, gctabulate, gcindex

21 , GConstructorADT, GMakeableADT, gmakeADT

22 )

23where

24

25-- base

26−import Control.Applicative ( liftA2 )

27import Data.Bifunctor ( first )

26import Data.Bifunctor ( first )

28import Data.Functor.Identity ( runIdentity )

27import Data.Functor.Identity ( runIdentity )

29import Data.Kind ( Constraint, Type )

28import Data.Kind ( Constraint, Type )

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

41import Prelude hiding ( null )

40import Prelude hiding ( null )

42

41

43-- rel8

42-- rel8

44−import Rel8.FCF ( Compose, Exp )

43+import Rel8.FCF ( Exp )

45import Rel8.Generic.Construction.Record

44import Rel8.Generic.Construction.Record

46 ( GConstruct, GConstructable, gconstruct, gdeconstruct

45 ( GConstruct, GConstructable, gconstruct, gdeconstruct

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

46+ , GFields, Representable, gtabulate, gindex

48 , FromColumns, ToColumns

47 , FromColumns, ToColumns

49 )

48 )

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

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

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

168class RepresentableFields f rep where

167class RepresentableFields f rep where

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

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

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

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

174

170

175

171

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

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

177 gftabulate = gftabulate @f @rep

173 gftabulate = gftabulate @f @rep

178 gfindex = gfindex @f @rep

174 gfindex = gfindex @f @rep

179− gftraverse = gftraverse @f @rep

180

175

181

176

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

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

183 gftabulate f =

178 gftabulate f =

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

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

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

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

187

181

188

182

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

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

190 gftabulate = gtabulate @f @rep

184 gftabulate = gtabulate @f @rep

191 gfindex = gindex @f @rep

185 gfindex = gindex @f @rep

192− gftraverse = gtraverse @f @rep

193

186

194

187

195type GConstructableADT

188type GConstructableADT

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

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

13

14module Rel8.Generic.Construction.Record

15 ( GConstructor, GConstruct, GConstructable, gconstruct, gdeconstruct

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

16+ , GFields, Representable, gtabulate, gindex

17 , FromColumns, ToColumns

18 )

19where

20

21-- base

22−import Control.Applicative ( liftA2 )

23import Data.Kind ( Constraint, Type )

22import Data.Kind ( Constraint, Type )

24import Data.Proxy ( Proxy( Proxy ) )

23import Data.Proxy ( Proxy( Proxy ) )

25import GHC.Generics

24import GHC.Generics

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

33import Prelude

32import Prelude

34

33

35-- rel8

34-- rel8

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

35+import Rel8.FCF ( Eval, Exp )

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

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

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

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

39import Rel8.Schema.HTable ( HTable )

38import Rel8.Schema.HTable ( HTable )

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

92class Representable f rep where

91class Representable f rep where

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

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

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

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

98

94

99

95

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

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

101 gtabulate = gtabulate @f @rep

97 gtabulate = gtabulate @f @rep

102 gindex = gindex @f @rep

98 gindex = gindex @f @rep

103− gtraverse = gtraverse @f @rep

104

99

105

100

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

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

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

108 where

103 where

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

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

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

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

112

106

113

107

114instance Representable f U1 where

108instance Representable f U1 where

115 gtabulate = ($ ())

109 gtabulate = ($ ())

116 gindex = const

110 gindex = const

117− gtraverse = const pure

118

111

119

112

120instance Representable f (K1 i a) where

113instance Representable f (K1 i a) where

121 gtabulate = id

114 gtabulate = id

122 gindex = id

115 gindex = id

123− gtraverse = id

124

116

125

117

126type GConstructable

118type GConstructable

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

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

1{-# language FlexibleContexts #-}

2+{-# language MonoLocalBinds #-}

2

3

3module Rel8.Query.Aggregate

4module Rel8.Query.Aggregate

4 ( aggregate

5 ( aggregate

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

14import qualified Opaleye.Aggregate as Opaleye

15import qualified Opaleye.Aggregate as Opaleye

15

16

16-- rel8

17-- rel8

17−import Rel8.Aggregate ( Aggregate )

18+import Rel8.Aggregate ( Aggregates )

18import Rel8.Expr ( Expr )

19import Rel8.Expr ( Expr )

19import Rel8.Expr.Aggregate ( countStar )

20import Rel8.Expr.Aggregate ( countStar )

20import Rel8.Query ( Query )

21import Rel8.Query ( Query )

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

25

26

27

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

28-- | 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

29aggregate = mapOpaleye (Opaleye.aggregate aggregator)

30aggregate = mapOpaleye (Opaleye.aggregate aggregator)

30

31

32

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

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

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

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

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

31−import Rel8.Table ( Table, fromColumns )

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

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

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

34import Rel8.Table.Maybe ( maybeTable )

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

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

47-- @Control.Applicative@.

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

49+many =

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

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

51+ optional .

52+ aggregate .

53+ fmap (listAgg . toColumns)

50

54

51

55

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

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

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

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

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

59-- @Control.Applicative@.

63-- @Control.Applicative@.

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

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

65+some =

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

67+ aggregate .

61−some = aggregate . fmap nonEmptyAgg

68+ fmap (nonEmptyAgg . toColumns)

62

69

63

70

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

71-- | 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

25

26-- rel8

27import Rel8.Aggregate

28− ( Aggregate, Col( A )

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

29 , mapInputs

30 , unsafeMakeAggregate

31 )

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

85

86 decodeTag (A aggregate) = fromAggregate aggregate

87

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

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

89 A $

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

91+ Aggregate $

91− runTag nullity condition <$> aggregate

92+ runTag nullity condition <$> a

92 where

93 where

93 condition = test expr

94 condition = test expr

94

95

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

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

96− A $ unnull nullity <$> aggregate

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

97

98

98 {-# INLINABLE encodeTag #-}

99 {-# INLINABLE encodeTag #-}

99 {-# INLINABLE decodeTag #-}

100 {-# INLINABLE decodeTag #-}

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

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

101

102

103instance Sql DBType a =>

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

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

105

106

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

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

112

113

114instance Sql DBType a =>

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

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

116

117

118instance 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

203

204

205aggregateADT :: forall t. ConstructableADT t

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

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

207aggregateADT f =

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

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

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

209+ (f @(ADT t Aggregate))

210

211

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

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

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

6{-# language ViewPatterns #-}

7

8module Rel8.Table.Aggregate

9− ( groupBy

9+ ( groupBy, hgroupBy

10 , listAgg, nonEmptyAgg

11 )

12where

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

16import Prelude

17

18-- rel8

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

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

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

21import Rel8.Expr.Aggregate

22 ( groupByExpr

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

24 , snonEmptyAggExpr

25 )

26import Rel8.Schema.Dict ( Dict( Dict ) )

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

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

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

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

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

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

31+import Rel8.Table ( toColumns, fromColumns )

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

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

32import Rel8.Table.List ( ListTable )

33import Rel8.Table.List ( ListTable )

33import Rel8.Table.NonEmpty ( NonEmptyTable )

34import Rel8.Table.NonEmpty ( NonEmptyTable )

35+import Rel8.Type.Eq ( DBEq )

34

36

35

37

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

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

37-- given table with 'groupByExpr'.

39-- given table with 'groupByExpr'.

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

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)

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

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

40− case hfield (eqTable @exprs) field of

48+ case hfield eqs field of

41 Dict -> case hfield exprs field of

49 Dict -> case hfield exprs field of

42 E expr -> A $ groupByExpr expr

50 E expr -> A $ groupByExpr expr

43

51

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

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

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

59-- return (order, items)

67-- return (order, items)

60-- @

68-- @

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

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

62listAgg (toColumns -> exprs) = fromColumns $

70listAgg (toColumns -> exprs) = fromColumns $

63 hvectorize

71 hvectorize

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

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

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

66

74

67

75

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

76-- | 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

70nonEmptyAgg (toColumns -> exprs) = fromColumns $

78nonEmptyAgg (toColumns -> exprs) = fromColumns $

71 hvectorize

79 hvectorize

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

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

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

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

18 ( EitherTable(..)

19 , eitherTable, leftTable, rightTable

20 , isLeftTable, isRightTable

21− , aggregateEitherTable, insertEitherTable, nameEitherTable

21+ , insertEitherTable, nameEitherTable

22 )

23where

24

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

30import Prelude hiding ( undefined )

31

32-- rel8

33−import Rel8.Aggregate ( Aggregate, unsafeMakeAggregate )

34import Rel8.Expr ( Expr )

33import Rel8.Expr ( Expr )

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

36import Rel8.Expr.Serialize ( litExpr )

34import Rel8.Expr.Serialize ( litExpr )

37import Rel8.Schema.Context.Label

35import Rel8.Schema.Context.Label

38 ( Labelable

36 ( Labelable

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

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

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

67

65

68-- semigroupoids

66-- semigroupoids

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

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

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

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

71

69

72

70

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

179rightTableWith = EitherTable (fromExpr (litExpr IsRight))

177rightTableWith = EitherTable (fromExpr (litExpr IsRight))

180

178

181

179

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−

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

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

195 => Either a b -> EitherTable a b

181 => Either a b -> EitherTable a b

196insertEitherTable = \case

182insertEitherTable = \case

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

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

269

270

271aggregateHKD :: forall a. ConstructableHKD a

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

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

273aggregateHKD f =

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

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

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

275+ (f @(HKD a Aggregate))

276

277

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

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

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

17 , maybeTable, nothingTable, justTable

18 , isNothingTable, isJustTable

19 , ($?)

20− , aggregateMaybeTable, insertMaybeTable, nameMaybeTable

20+ , insertMaybeTable, nameMaybeTable

21 )

22where

23

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

27import Prelude hiding ( null, undefined )

28

29-- rel8

30−import Rel8.Aggregate ( Aggregate, unsafeMakeAggregate )

31import Rel8.Expr ( Expr )

30import Rel8.Expr ( Expr )

32import Rel8.Expr.Bool ( boolExpr )

31import Rel8.Expr.Bool ( boolExpr )

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

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

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

35import Rel8.Schema.Context.Label

33import Rel8.Schema.Context.Label

36 ( Labelable, HLabelable, hlabeler, hunlabeler

34 ( Labelable, HLabelable, hlabeler, hunlabeler

37 )

35 )

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

69import Rel8.Type.Tag ( MaybeTag )

67import Rel8.Type.Tag ( MaybeTag )

70

68

71-- semigroupoids

69-- semigroupoids

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

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

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

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

74

72

75

73

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

211infixl 4 $?

209infixl 4 $?

212

210

213

211

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−

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

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

223insertMaybeTable = \case

213insertMaybeTable = \case

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

214 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

35import Data.Profunctor ( dimap, lmap )

36

37-- rel8

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

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

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

40import Rel8.Expr.Opaleye

41 ( fromPrimExpr, toPrimExpr

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

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

57

58

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

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

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

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

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

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

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

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

64+ E <$> inner f ()

62

65

63

66

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

67binaryspec :: 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

79

80

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

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

82+ => Aggregate a -> Tag label a

83fromAggregate = fold . getFirst . foldInputs go

84 where

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

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

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

21 , isThisTable, isThatTable, isThoseTable

22 , hasHereTable, hasThereTable

23 , justHereTable, justThereTable

24− , aggregateTheseTable, insertTheseTable, nameTheseTable

24+ , insertTheseTable, nameTheseTable

25 )

26where

27

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

33import Prelude hiding ( undefined )

34

35-- rel8

36−import Rel8.Aggregate ( Aggregate )

37import Rel8.Expr ( Expr )

36import Rel8.Expr ( Expr )

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

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

39import Rel8.Expr.Null ( isNonNull )

38import Rel8.Expr.Null ( isNonNull )

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

63 ( MaybeTable(..)

62 ( MaybeTable(..)

64 , maybeTable, justTable, nothingTable

63 , maybeTable, justTable, nothingTable

65 , isJustTable

64 , isJustTable

66− , aggregateMaybeTable, insertMaybeTable, nameMaybeTable

65+ , insertMaybeTable, nameMaybeTable

67 )

66 )

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

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

69import Rel8.Table.Recontextualize ( Recontextualize )

68import Rel8.Table.Recontextualize ( Recontextualize )

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

73import Rel8.Type.Tag ( MaybeTag )

72import Rel8.Type.Tag ( MaybeTag )

74

73

75-- semigroupoids

74-- semigroupoids

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

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

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

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

78

77

79-- these

78-- these

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

232 there

231 there

233

232

234

233

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−

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

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

245 => These a b -> TheseTable a b

235 => These a b -> TheseTable a b

246insertTheseTable =

236insertTheseTable =

src/Rel8/Tabulate.hs+24−13

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

1{-# language DeriveFunctor #-}

2{-# language DerivingStrategies #-}

3{-# language FlexibleContexts #-}

4+{-# language MonoLocalBinds #-}

5+{-# language ScopedTypeVariables #-}

6+{-# language TypeApplications #-}

4{-# language TupleSections #-}

7{-# language TupleSections #-}

5{-# language UndecidableInstances #-}

8{-# language UndecidableInstances #-}

6

9

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

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

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

44

47

45-- rel8

48-- rel8

46−import Rel8.Aggregate ( Aggregate )

49+import Rel8.Aggregate ( Aggregates )

47import Rel8.Expr ( Expr )

50import Rel8.Expr ( Expr )

48import Rel8.Order ( Order )

51import Rel8.Order ( Order )

49import Rel8.Query ( Query )

52import Rel8.Query ( Query )

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

54import Rel8.Query.Maybe ( optional )

57import Rel8.Query.Maybe ( optional )

55import Rel8.Query.Order ( orderBy )

58import Rel8.Query.Order ( orderBy )

56import Rel8.Query.These ( alignBy )

59import Rel8.Query.These ( alignBy )

57−import Rel8.Table ( Table )

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

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

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

59import Rel8.Table.Alternative

62import Rel8.Table.Alternative

60 ( AltTable, (<|>:)

63 ( AltTable, (<|>:)

61 , AlternativeTable, emptyTable

64 , AlternativeTable, emptyTable

62 )

65 )

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

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

64−import Rel8.Table.List ( ListTable )

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

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

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

66−import Rel8.Table.NonEmpty ( NonEmptyTable )

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

67import Rel8.Table.Ord ( OrdTable )

70import Rel8.Table.Ord ( OrdTable )

68import Rel8.Table.Order ( ascTable )

71import Rel8.Table.Order ( ascTable )

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

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

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

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

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

73import Data.Functor.Bind ( Bind )

76import Data.Functor.Bind ( Bind )

74import qualified Data.Functor.Bind

77import qualified Data.Functor.Bind

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

76

78

77

79

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

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

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

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

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

339

341

340

342

341−aggregateTabulation :: EqTable k

343+aggregateTabulation :: forall k aggregates exprs.

344+ ( EqTable k

345+ , Aggregates aggregates exprs

346+ )

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

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

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

348+aggregateTabulation = mapQuery $

349+ fmap (first fromColumns) .

350+ aggregate .

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

344

352

345

353

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

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

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

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

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

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

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

374manyTabulation =

382manyTabulation =

375− fmap (maybeTable mempty id) .

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

376 optionalTabulation .

384 optionalTabulation .

377 aggregateTabulation .

385 aggregateTabulation .

378− fmap listAgg

386+ fmap (listAgg . toColumns)

379

387

380

388

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

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

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

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

391+someTabulation =

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

383−someTabulation = aggregateTabulation . fmap nonEmptyAgg

393+ aggregateTabulation .

394+ fmap (nonEmptyAgg . toColumns)

384

395

385

396

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

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