git.iko.soy/rel8
on da76712 help sign in
rel8/src/Rel8/Aggregate.hs
83 lines 2.5 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language FlexibleInstances #-}
4{-# language MultiParamTypeClasses #-}
5{-# language RankNTypes #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeFamilies #-}
8{-# language UndecidableInstances #-}
10module Rel8.Aggregate
11 ( Aggregate(..), zipOutputs
12 , unsafeMakeAggregate
13 , Aggregates
14 )
15where
17-- base
18import Control.Applicative ( liftA2 )
19import Data.Functor.Identity ( Identity( Identity ) )
20import Data.Kind ( Constraint, Type )
21import Prelude
23-- profunctors
24import Data.Profunctor ( dimap )
26-- opaleye
27import qualified Opaleye.Aggregate as Opaleye
28import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
29import qualified Opaleye.Internal.Column as Opaleye
31-- rel8
32import Rel8.Expr ( Expr )
33import Rel8.Schema.HTable.Identity ( HIdentity(..) )
34import qualified Rel8.Schema.Kind as K
35import Rel8.Schema.Null ( Sql )
36import Rel8.Table
37 ( Table, Columns, Context, fromColumns, toColumns
38 , FromExprs, fromResult, toResult
39 , Transpose
40 )
41import Rel8.Table.Transpose ( Transposes )
42import Rel8.Type ( DBType )
45-- | 'Aggregate' is a special context used by 'Rel8.aggregate'.
46type Aggregate :: K.Context
47newtype Aggregate a = Aggregate (Opaleye.Aggregator () (Expr a))
50instance Sql DBType a => Table Aggregate (Aggregate a) where
51 type Columns (Aggregate a) = HIdentity a
52 type Context (Aggregate a) = Aggregate
53 type FromExprs (Aggregate a) = a
54 type Transpose to (Aggregate a) = to a
56 toColumns = HIdentity
57 fromColumns (HIdentity a) = a
58 toResult = HIdentity . Identity
59 fromResult (HIdentity (Identity a)) = a
62-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate's
63-- for the 'Expr' columns in @b@.
64type Aggregates :: Type -> Type -> Constraint
65class Transposes Aggregate Expr aggregates exprs => Aggregates aggregates exprs
66instance Transposes Aggregate Expr aggregates exprs => Aggregates aggregates exprs
69zipOutputs :: ()
70 => (Expr a -> Expr b -> Expr c) -> Aggregate a -> Aggregate b -> Aggregate c
71zipOutputs f (Aggregate a) (Aggregate b) = Aggregate (liftA2 f a b)
74unsafeMakeAggregate :: forall (input :: Type) (output :: Type) n n' a a'. ()
75 => (Expr input -> Opaleye.PrimExpr)
76 -> (Opaleye.PrimExpr -> Expr output)
77 -> Opaleye.Aggregator (Opaleye.Field_ n a) (Opaleye.Field_ n' a')
78 -> Expr input
79 -> Aggregate output
80unsafeMakeAggregate input output aggregator expr =
81 Aggregate $ dimap in_ out aggregator
82 where out = output . Opaleye.unColumn
83 in_ = Opaleye.Column . input . const expr