git.iko.soy/rel8
on b97cd4e help sign in
rel8/src/Rel8/Aggregate/Legacy.hs
93 lines 3.2 kB history raw
1{-# language FlexibleContexts #-}
2{-# language NamedFieldPuns #-}
3{-# language ScopedTypeVariables #-}
4{-# language TypeApplications #-}
5{-# language TypeFamilies #-}
6{-# language ViewPatterns #-}
8module Rel8.Aggregate.Legacy
9 ( Aggregates
10 , aggregate
11 , aggregateTabulation
12 , groupBy
13 , listAgg
14 , nonEmptyAgg
15 )
16where
18-- base
19import Data.Functor.Identity ( Identity( Identity ) )
20import Prelude
22-- opaleye
23import qualified Opaleye.Aggregate as Opaleye
25-- rel8
26import Rel8.Aggregate ( Aggregates, Col(..) )
27import Rel8.Expr ( Col(..) )
28import Rel8.Expr.Aggregate ( groupByExpr, listAggExpr, nonEmptyAggExpr )
29import Rel8.Query ( Query )
30import Rel8.Query.Opaleye ( mapOpaleye )
31import Rel8.Schema.Dict ( Dict( Dict ) )
32import Rel8.Schema.HTable ( htabulate, hfield )
33import Rel8.Schema.HTable.Vectorize ( hvectorize )
34import Rel8.Table ( toColumns, fromColumns )
35import Rel8.Table.Eq ( EqTable, eqTable )
36import Rel8.Table.List ( ListTable )
37import Rel8.Table.NonEmpty ( NonEmptyTable )
38import Rel8.Table.Opaleye ( aggregator )
39import Rel8.Tabulate ( Tabulation )
40import qualified Rel8.Tabulate
43-- | Apply an aggregation to all rows returned by a 'Query'.
44aggregate :: Aggregates aggregates exprs => Query aggregates -> Query exprs
45aggregate = mapOpaleye (Opaleye.aggregate aggregator) . fmap (fromColumns . toColumns)
48aggregateTabulation
49 :: (EqTable k, Aggregates aggregates exprs)
50 => (t -> aggregates) -> Tabulation k t -> Tabulation k exprs
51aggregateTabulation f =
52 Rel8.Tabulate.aggregateTabulation . fmap (fromColumns . toColumns . f)
55-- | Group equal tables together. This works by aggregating each column in the
56-- given table with 'groupByExpr'.
57groupBy :: forall exprs aggregates. (EqTable exprs, Aggregates aggregates exprs)
58 => exprs -> aggregates
59groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
60 case hfield (eqTable @exprs) field of
61 Dict -> case hfield exprs field of
62 DB expr -> Aggregation $ groupByExpr expr
65-- | Aggregate rows into a single row containing an array of all aggregated
66-- rows. This can be used to associate multiple rows with a single row, without
67-- changing the over cardinality of the query. This allows you to essentially
68-- return a tree-like structure from queries.
69--
70-- For example, if we have a table of orders and each orders contains multiple
71-- items, we could aggregate the table of orders, pairing each order with its
72-- items:
73--
74-- @
75-- ordersWithItems :: Query (Order Expr, ListTable (Item Expr))
76-- ordersWithItems = do
77-- order <- each orderSchema
78-- items <- aggregate $ listAgg <$> itemsFromOrder order
79-- return (order, items)
80-- @
81listAgg :: Aggregates aggregates exprs => exprs -> ListTable aggregates
82listAgg (toColumns -> exprs) = fromColumns $
83 hvectorize
84 (\_ (Identity (DB a)) -> Aggregation $ listAggExpr a)
85 (pure exprs)
88-- | Like 'listAgg', but the result is guaranteed to be a non-empty list.
89nonEmptyAgg :: Aggregates aggregates exprs => exprs -> NonEmptyTable aggregates
90nonEmptyAgg (toColumns -> exprs) = fromColumns $
91 hvectorize
92 (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)
93 (pure exprs)