on b60b6b8 help sign in
rel8/src/Rel8/Table/Aggregate.hs
80 lines 2.7 kB history raw
1{-# language FlexibleContexts #-}
2{-# language NamedFieldPuns #-}
3{-# language ScopedTypeVariables #-}
4{-# language TypeApplications #-}
5{-# language TypeFamilies #-}
6{-# language ViewPatterns #-}
8module Rel8.Table.Aggregate
9 ( groupBy
10 , listAgg
11 , nonEmptyAgg
12 , runAggregation
13 )
14where
16-- base
17import Data.Functor.Identity ( Identity( Identity ) )
18import Prelude
20-- rel8
21import Rel8.Aggregate ( Aggregate )
22import Rel8.Expr ( Expr )
23import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr, sgroupByExpr )
24import Rel8.Schema.Context ( Col'(..) )
25import Rel8.Schema.Dict ( Dict( Dict ) )
26import Rel8.Schema.HTable ( htabulate, hfield, hdicts, hspecs )
27import Rel8.Schema.HTable.Vectorize ( hvectorize )
28import Rel8.Schema.Spec ( SSpec(..) )
29import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
30import Rel8.Table ( Table, Columns, toColumns, fromColumns )
31import Rel8.Table.Eq ( EqTable )
32import Rel8.Table.List ( ListTable )
33import Rel8.Table.NonEmpty ( NonEmptyTable )
34import Rel8.Table.Recontextualize ( Aggregates )
35import Rel8.Type.Eq ( DBEq )
38groupBy :: forall exprs. EqTable exprs => exprs -> Aggregate exprs
39groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
40 case hfield dicts field of
41 Dict -> case hfield hspecs field of
42 SSpec {nullability} -> case hfield exprs field of
43 DB expr -> Aggregation $ sgroupByExpr nullability expr
44 where
45 dicts = hdicts @(Columns exprs) @(ConstrainDBType DBEq)
48-- | Aggregate rows into a single row containing an array of all aggregated
49-- rows. This can be used to associate multiple rows with a single row, without
50-- changing the over cardinality of the query. This allows you to essentially
51-- return a tree-like structure from queries.
52--
53-- For example, if we have a table of orders and each orders contains multiple
54-- items, we could aggregate the table of orders, pairing each order with its
55-- items:
56--
57-- @
58-- ordersWithItems :: Query (Order Expr, ListTable (Item Expr))
59-- ordersWithItems = do
60-- order <- each orderSchema
61-- items <- aggregate $ listAgg <$> itemsFromOrder order
62-- return (order, items)
63-- @
64listAgg :: Table Expr exprs => exprs -> Aggregate (ListTable exprs)
65listAgg (toColumns -> exprs) = fromColumns $
66 hvectorize
67 (\_ (Identity (DB a)) -> Aggregation $ listAggExpr a)
68 (pure exprs)
71-- | Like 'listAgg', but the result is guaranteed to be a non-empty list.
72nonEmptyAgg :: Table Expr exprs => exprs -> Aggregate (NonEmptyTable exprs)
73nonEmptyAgg (toColumns -> exprs) = fromColumns $
74 hvectorize
75 (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)
76 (pure exprs)
79runAggregation :: Aggregates aggregates exprs => aggregates -> Aggregate exprs
80runAggregation = fromColumns . toColumns