git.iko.soy/rel8
on ae4607a help sign in
rel8/src/Rel8/Aggregate.hs
91 lines 2.8 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language FlexibleInstances #-}
4{-# language MultiParamTypeClasses #-}
5{-# language NamedFieldPuns #-}
6{-# language RankNTypes #-}
7{-# language StandaloneKindSignatures #-}
8{-# language TypeFamilies #-}
9{-# language UndecidableInstances #-}
11module Rel8.Aggregate
12 ( Aggregate(..), zipOutputs
13 , Aggregator(..), unsafeMakeAggregate
14 , Aggregates
15 )
16where
18-- base
19import Control.Applicative ( liftA2 )
20import Data.Functor.Identity ( Identity( Identity ) )
21import Data.Kind ( Constraint, Type )
22import Prelude
24-- opaleye
25import qualified Opaleye.Internal.Aggregate as Opaleye
26import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
27import qualified Opaleye.Internal.PackMap as Opaleye
29-- rel8
30import Rel8.Expr ( Expr )
31import Rel8.Schema.HTable.Identity ( HIdentity(..) )
32import qualified Rel8.Schema.Kind as K
33import Rel8.Schema.Null ( Sql )
34import Rel8.Table
35 ( Table, Columns, Context, fromColumns, toColumns
36 , FromExprs, fromResult, toResult
37 , Transpose
38 )
39import Rel8.Table.Transpose ( Transposes )
40import Rel8.Type ( DBType )
43-- | 'Aggregate' is a special context used by 'Rel8.aggregate'.
44type Aggregate :: K.Context
45newtype Aggregate a = Aggregate (Opaleye.Aggregator () (Expr a))
48instance Sql DBType a => Table Aggregate (Aggregate a) where
49 type Columns (Aggregate a) = HIdentity a
50 type Context (Aggregate a) = Aggregate
51 type FromExprs (Aggregate a) = a
52 type Transpose to (Aggregate a) = to a
54 toColumns = HIdentity
55 fromColumns (HIdentity a) = a
56 toResult = HIdentity . Identity
57 fromResult (HIdentity (Identity a)) = a
60-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate's
61-- for the 'Expr' columns in @b@.
62type Aggregates :: Type -> Type -> Constraint
63class Transposes Aggregate Expr aggregates exprs => Aggregates aggregates exprs
64instance Transposes Aggregate Expr aggregates exprs => Aggregates aggregates exprs
67zipOutputs :: ()
68 => (Expr a -> Expr b -> Expr c) -> Aggregate a -> Aggregate b -> Aggregate c
69zipOutputs f (Aggregate a) (Aggregate b) = Aggregate (liftA2 f a b)
72type Aggregator :: Type
73data Aggregator = Aggregator
74 { operation :: Opaleye.AggrOp
75 , ordering :: [Opaleye.OrderExpr]
76 , distinction :: Opaleye.AggrDistinct
77 }
80unsafeMakeAggregate :: forall (input :: Type) (output :: Type). ()
81 => (Expr input -> Opaleye.PrimExpr)
82 -> (Opaleye.PrimExpr -> Expr output)
83 -> Maybe Aggregator
84 -> Expr input
85 -> Aggregate output
86unsafeMakeAggregate input output aggregator expr =
87 Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ \f _ ->
88 output <$> f (tuplize <$> aggregator, input expr)
89 where
90 tuplize Aggregator {operation, ordering, distinction} =
91 (operation, ordering, distinction)