git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Aggregate/Legacy.hs
129 lines 4.4 kB history raw
1{-# language AllowAmbiguousTypes #-}
2{-# language DataKinds #-}
3{-# language FlexibleContexts #-}
4{-# language RankNTypes #-}
5{-# language ScopedTypeVariables #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeApplications #-}
8{-# language TypeFamilies #-}
9{-# language ViewPatterns #-}
11module Rel8.Aggregate.Legacy
12 ( Aggregates
13 , aggregate
14 , aggregateTabulation
15 , groupBy
16 , listAgg
17 , nonEmptyAgg
19 , AggregateADT, aggregateADT
20 , AggregateHKD, aggregateHKD
21 )
22where
24-- base
25import Data.Functor.Identity ( Identity( Identity ) )
26import Data.Kind ( Type )
27import GHC.Generics ( Rep )
28import Prelude
30-- opaleye
31import qualified Opaleye.Aggregate as Opaleye
33-- rel8
34import Rel8.Aggregate ( Aggregate, Aggregates, Col(..) )
35import Rel8.Expr ( Col(..), Expr )
36import Rel8.Expr.Aggregate ( groupByExpr, listAggExpr, nonEmptyAggExpr )
37import Rel8.Generic.Construction ( GGAggregate', ggaggregate' )
38import Rel8.Generic.Table ( GAlgebra )
39import Rel8.Kind.Algebra ( Algebra( Sum ) )
40import Rel8.Query ( Query )
41import Rel8.Query.Opaleye ( mapOpaleye )
42import Rel8.Schema.Dict ( Dict( Dict ) )
43import Rel8.Schema.HTable ( htabulate, hfield )
44import Rel8.Schema.HTable.Vectorize ( hvectorize )
45import Rel8.Schema.Kind ( Rel8able )
46import Rel8.Table ( toColumns, fromColumns )
47import Rel8.Table.ADT ( ConstructableADT, ADT( ADT ), ADTRep )
48import Rel8.Table.Eq ( EqTable, eqTable )
49import Rel8.Table.HKD ( ConstructableHKD, HKD( HKD ), HKDRep )
50import Rel8.Table.List ( ListTable )
51import Rel8.Table.NonEmpty ( NonEmptyTable )
52import Rel8.Table.Opaleye ( aggregator )
53import Rel8.Tabulate ( Tabulation )
54import qualified Rel8.Tabulate
57-- | Apply an aggregation to all rows returned by a 'Query'.
58aggregate :: Aggregates aggregates exprs => Query aggregates -> Query exprs
59aggregate = mapOpaleye (Opaleye.aggregate aggregator) . fmap (fromColumns . toColumns)
62aggregateTabulation
63 :: (EqTable k, Aggregates aggregates exprs)
64 => (t -> aggregates) -> Tabulation k t -> Tabulation k exprs
65aggregateTabulation f =
66 Rel8.Tabulate.aggregateTabulation . fmap (fromColumns . toColumns . f)
69-- | Group equal tables together. This works by aggregating each column in the
70-- given table with 'groupByExpr'.
71groupBy :: forall exprs aggregates. (EqTable exprs, Aggregates aggregates exprs)
72 => exprs -> aggregates
73groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
74 case hfield (eqTable @exprs) field of
75 Dict -> case hfield exprs field of
76 DB expr -> Aggregation $ groupByExpr expr
79-- | Aggregate rows into a single row containing an array of all aggregated
80-- rows. This can be used to associate multiple rows with a single row, without
81-- changing the over cardinality of the query. This allows you to essentially
82-- return a tree-like structure from queries.
83--
84-- For example, if we have a table of orders and each orders contains multiple
85-- items, we could aggregate the table of orders, pairing each order with its
86-- items:
87--
88-- @
89-- ordersWithItems :: Query (Order Expr, ListTable (Item Expr))
90-- ordersWithItems = do
91-- order <- each orderSchema
92-- items <- aggregate $ listAgg <$> itemsFromOrder order
93-- return (order, items)
94-- @
95listAgg :: Aggregates aggregates exprs => exprs -> ListTable aggregates
96listAgg (toColumns -> exprs) = fromColumns $
97 hvectorize
98 (\_ (Identity (DB a)) -> Aggregation $ listAggExpr a)
99 (pure exprs)
102-- | Like 'listAgg', but the result is guaranteed to be a non-empty list.
103nonEmptyAgg :: Aggregates aggregates exprs => exprs -> NonEmptyTable aggregates
104nonEmptyAgg (toColumns -> exprs) = fromColumns $
105 hvectorize
106 (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)
107 (pure exprs)
110type AggregateADT :: Rel8able -> Type
111type AggregateADT t = forall r. GGAggregate' 'Sum (ADTRep t) r
114aggregateADT :: forall t. ConstructableADT t
115 => AggregateADT t -> ADT t Expr -> ADT t Aggregate
116aggregateADT f =
117 ggaggregate' @'Sum @(ADTRep t) @(ADT t Expr) @(ADT t Aggregate) ADT (\(ADT a) -> a)
118 (f @(ADT t Aggregate))
121type AggregateHKD :: Type -> Type
122type AggregateHKD a = forall r. GGAggregate' (GAlgebra (Rep a)) (HKDRep a) r
125aggregateHKD :: forall a. ConstructableHKD a
126 => AggregateHKD a -> HKD a Expr -> HKD a Aggregate
127aggregateHKD f =
128 ggaggregate' @(GAlgebra (Rep a)) @(HKDRep a) @(HKD a Expr) @(HKD a Aggregate) HKD (\(HKD a) -> a)
129 (f @(HKD a Aggregate))