git.iko.soy/rel8
on 5a47018 help sign in
rel8/src/Rel8/Aggregate.hs
151 lines 4.5 kB history raw
1{-# language DataKinds #-}
2{-# language DerivingVia #-}
3{-# language FlexibleContexts #-}
4{-# language FlexibleInstances #-}
5{-# language GADTs #-}
6{-# language MultiParamTypeClasses #-}
7{-# language NamedFieldPuns #-}
8{-# language PolyKinds #-}
9{-# language StandaloneKindSignatures #-}
10{-# language TypeFamilies #-}
11{-# language UndecidableInstances #-}
12{-# language UndecidableSuperClasses #-}
14module Rel8.Aggregate
15 ( Aggregate(..), foldInputs, mapInputs
16 , Aggregator(..), unsafeMakeAggregate
17 , Aggregates
18 , Col( A, unA )
19 )
20where
22-- base
23import Data.Functor.Const ( Const( Const ), getConst )
24import Data.Functor.Identity ( Identity )
25import Data.Kind ( Constraint, Type )
26import Prelude
28-- opaleye
29import qualified Opaleye.Internal.Aggregate as Opaleye
30import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
31import qualified Opaleye.Internal.PackMap as Opaleye
33-- rel8
34import Rel8.Expr ( Expr )
35import Rel8.Schema.Context ( Interpretation(..) )
36import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )
37import Rel8.Schema.Name ( Name )
38import Rel8.Schema.Null ( Sql )
39import Rel8.Schema.Reify ( notReify )
40import Rel8.Schema.Result ( Result )
41import Rel8.Schema.Spec ( Spec( Spec ) )
42import Rel8.Table
43 ( Table, Columns, Context, fromColumns, toColumns
44 , reify, unreify, coherence, congruence
45 )
46import Rel8.Table.Recontextualize ( Recontextualize )
47import Rel8.Type ( DBType )
50-- | An @Aggregate a@ describes how to aggregate @Table@s of type @a@. You can
51-- unpack an @Aggregate@ back to @a@ by running it with 'Rel8.aggregate'. As
52-- @Aggregate@ is almost an 'Applicative' functor - but there is no 'pure'
53-- operation. This means 'Aggregate' is an instance of 'Apply', and you can
54-- combine @Aggregate@s using the @<.>@ combinator.
55type Aggregate :: k -> Type
56data Aggregate a where
57 Aggregate :: !(Opaleye.Aggregator () (Expr a)) -> Aggregate a
60instance Interpretation Aggregate where
61 data Col Aggregate _spec where
62 A :: ()
63 => { unA :: !(Aggregate a) }
64 -> Col Aggregate ('Spec a)
67instance Sql DBType a => Table Aggregate (Aggregate a) where
68 type Columns (Aggregate a) = HType a
69 type Context (Aggregate a) = Aggregate
71 toColumns = HIdentity . A
72 fromColumns (HIdentity (A a)) = a
74 reify = notReify
75 unreify = notReify
76 coherence = notReify
77 congruence = notReify
80instance Sql DBType a =>
81 Recontextualize Aggregate Aggregate (Aggregate a) (Aggregate a)
84instance Sql DBType a =>
85 Recontextualize Aggregate Expr (Aggregate a) (Expr a)
88instance Sql DBType a =>
89 Recontextualize Aggregate Result (Aggregate a) (Identity a)
92instance Sql DBType a =>
93 Recontextualize Aggregate Name (Aggregate a) (Name a)
96instance Sql DBType a =>
97 Recontextualize Expr Aggregate (Expr a) (Aggregate a)
100instance Sql DBType a =>
101 Recontextualize Result Aggregate (Identity a) (Aggregate a)
104instance Sql DBType a =>
105 Recontextualize Name Aggregate (Name a) (Aggregate a)
108-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's
109-- for the columns in @b@.
110type Aggregates :: Type -> Type -> Constraint
111class Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs
112instance Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs
115foldInputs :: Monoid b
116 => (Maybe Aggregator -> Opaleye.PrimExpr -> b) -> Aggregate a -> b
117foldInputs f (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =
118 getConst $ flip agg () $ \(aggregator, a) ->
119 Const $ f (detuplize <$> aggregator) a
120 where
121 detuplize (operation, ordering, distinction) =
122 Aggregator {operation, ordering, distinction}
125mapInputs :: ()
126 => (Opaleye.PrimExpr -> Opaleye.PrimExpr) -> Aggregate a -> Aggregate a
127mapInputs transform (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =
128 Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ agg . \f input ->
129 f (fmap transform input)
132type Aggregator :: Type
133data Aggregator = Aggregator
134 { operation :: Opaleye.AggrOp
135 , ordering :: [Opaleye.OrderExpr]
136 , distinction :: Opaleye.AggrDistinct
137 }
140unsafeMakeAggregate :: ()
141 => (Expr input -> Opaleye.PrimExpr)
142 -> (Opaleye.PrimExpr -> Expr output)
143 -> Maybe Aggregator
144 -> Expr input
145 -> Aggregate output
146unsafeMakeAggregate input output aggregator expr =
147 Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ \f _ ->
148 output <$> f (tuplize <$> aggregator, input expr)
149 where
150 tuplize Aggregator {operation, ordering, distinction} =
151 (operation, ordering, distinction)