git.iko.soy/rel8
on 83edc03 help sign in
rel8/src/Rel8/Table/Aggregate.hs
62 lines 2.0 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.Aggregate ( listAggExpr, nonEmptyAggExpr, sgroupByExpr )
23import Rel8.Schema.Context ( Aggregation( Aggregation ), DB( DB ) )
24import Rel8.Schema.Dict ( Dict( Dict ) )
25import Rel8.Schema.HTable ( htabulate, hfield, hdicts, hspecs )
26import Rel8.Schema.HTable.Vectorize ( hvectorize )
27import Rel8.Schema.Spec ( SSpec(..) )
28import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
29import Rel8.Table ( Table, Columns, toColumns, fromColumns )
30import Rel8.Table.Eq ( EqTable )
31import Rel8.Table.List ( ListTable )
32import Rel8.Table.NonEmpty ( NonEmptyTable )
33import Rel8.Table.Recontextualize ( Aggregates )
34import Rel8.Type.Eq ( DBEq )
37groupBy :: forall exprs. EqTable exprs => exprs -> Aggregate exprs
38groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
39 case hfield dicts field of
40 Dict -> case hfield hspecs field of
41 SSpec {nullability} -> case hfield exprs field of
42 DB expr -> Aggregation $ sgroupByExpr nullability expr
43 where
44 dicts = hdicts @(Columns exprs) @(ConstrainDBType DBEq)
47listAgg :: Table DB exprs => exprs -> Aggregate (ListTable exprs)
48listAgg (toColumns -> exprs) = fromColumns $
49 hvectorize
50 (\_ (Identity (DB a)) -> Aggregation $ listAggExpr a)
51 (pure exprs)
54nonEmptyAgg :: Table DB exprs => exprs -> Aggregate (NonEmptyTable exprs)
55nonEmptyAgg (toColumns -> exprs) = fromColumns $
56 hvectorize
57 (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)
58 (pure exprs)
61runAggregation :: Aggregates aggregates exprs => aggregates -> Aggregate exprs
62runAggregation = fromColumns . toColumns