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