git.iko.soy/rel8
on 7c5422f help sign in
rel8/src/Rel8/Aggregate.hs
138 lines 4.2 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language FlexibleInstances #-}
4{-# language GADTs #-}
5{-# language MultiParamTypeClasses #-}
6{-# language NamedFieldPuns #-}
7{-# language PolyKinds #-}
8{-# language StandaloneKindSignatures #-}
9{-# language TypeFamilies #-}
10{-# language UndecidableInstances #-}
11{-# language UndecidableSuperClasses #-}
13module Rel8.Aggregate
14 ( Aggregate(..), foldInputs, mapInputs
15 , Aggregator(..), unsafeMakeAggregate
16 , Aggregates
17 , Col( A, unA )
18 )
19where
21-- base
22import Data.Functor.Const ( Const( Const ), getConst )
23import Data.Kind ( Constraint, Type )
24import Prelude
26-- opaleye
27import qualified Opaleye.Internal.Aggregate as Opaleye
28import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
29import qualified Opaleye.Internal.PackMap as Opaleye
31-- rel8
32import Rel8.Expr ( Expr )
33import Rel8.Schema.Context ( Interpretation(..) )
34import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )
35import Rel8.Schema.Name ( Name )
36import Rel8.Schema.Null ( Sql )
37import Rel8.Schema.Result ( Col( R ) )
38import Rel8.Schema.Spec ( Spec( Spec ) )
39import Rel8.Table
40 ( Table, Columns, Context, fromColumns, toColumns
41 , FromExprs, fromResult, toResult
42 )
43import Rel8.Table.Recontextualize ( Recontextualize )
44import Rel8.Type ( DBType )
47-- | An @Aggregate a@ describes how to aggregate @Table@s of type @a@. You can
48-- unpack an @Aggregate@ back to @a@ by running it with 'Rel8.aggregate'. As
49-- @Aggregate@ is almost an 'Applicative' functor - but there is no 'pure'
50-- operation. This means 'Aggregate' is an instance of 'Apply', and you can
51-- combine @Aggregate@s using the @<.>@ combinator.
52type Aggregate :: k -> Type
53data Aggregate a where
54 Aggregate :: !(Opaleye.Aggregator () (Expr a)) -> Aggregate a
57instance Interpretation Aggregate where
58 data Col Aggregate _spec where
59 A :: ()
60 => { unA :: !(Aggregate a) }
61 -> Col Aggregate ('Spec a)
64instance Sql DBType a => Table Aggregate (Aggregate a) where
65 type Columns (Aggregate a) = HType a
66 type Context (Aggregate a) = Aggregate
67 type FromExprs (Aggregate a) = a
69 toColumns = HIdentity . A
70 fromColumns (HIdentity (A a)) = a
71 toResult = HIdentity . R
72 fromResult (HIdentity (R a)) = a
75instance Sql DBType a =>
76 Recontextualize Aggregate Aggregate (Aggregate a) (Aggregate a)
79instance Sql DBType a =>
80 Recontextualize Aggregate Expr (Aggregate a) (Expr a)
83instance Sql DBType a =>
84 Recontextualize Aggregate Name (Aggregate a) (Name a)
87instance Sql DBType a =>
88 Recontextualize Expr Aggregate (Expr a) (Aggregate a)
91instance Sql DBType a =>
92 Recontextualize Name Aggregate (Name a) (Aggregate a)
95-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's
96-- for the columns in @b@.
97type Aggregates :: Type -> Type -> Constraint
98class Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs
99instance Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs
102foldInputs :: Monoid b
103 => (Maybe Aggregator -> Opaleye.PrimExpr -> b) -> Aggregate a -> b
104foldInputs f (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =
105 getConst $ flip agg () $ \(aggregator, a) ->
106 Const $ f (detuplize <$> aggregator) a
107 where
108 detuplize (operation, ordering, distinction) =
109 Aggregator {operation, ordering, distinction}
112mapInputs :: ()
113 => (Opaleye.PrimExpr -> Opaleye.PrimExpr) -> Aggregate a -> Aggregate a
114mapInputs transform (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =
115 Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ agg . \f input ->
116 f (fmap transform input)
119type Aggregator :: Type
120data Aggregator = Aggregator
121 { operation :: Opaleye.AggrOp
122 , ordering :: [Opaleye.OrderExpr]
123 , distinction :: Opaleye.AggrDistinct
124 }
127unsafeMakeAggregate :: ()
128 => (Expr input -> Opaleye.PrimExpr)
129 -> (Opaleye.PrimExpr -> Expr output)
130 -> Maybe Aggregator
131 -> Expr input
132 -> Aggregate output
133unsafeMakeAggregate input output aggregator expr =
134 Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ \f _ ->
135 output <$> f (tuplize <$> aggregator, input expr)
136 where
137 tuplize Aggregator {operation, ordering, distinction} =
138 (operation, ordering, distinction)