{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language NamedFieldPuns #-}
{-# language RankNTypes #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
module Rel8.Aggregate
( Aggregate(..), zipOutputs
, Aggregator(..), unsafeMakeAggregate
, Aggregates
)
where
import Control.Applicative ( liftA2 )
import Data.Functor.Identity ( Identity( Identity ) )
import Data.Kind ( Constraint, Type )
import Prelude
import qualified Opaleye.Internal.Aggregate as Opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import qualified Opaleye.Internal.PackMap as Opaleye
import Rel8.Expr ( Expr )
import Rel8.Schema.HTable.Identity ( HIdentity(..) )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.Null ( Sql )
import Rel8.Table
( Table, Columns, Context, fromColumns, toColumns
, FromExprs, fromResult, toResult
, Transpose
)
import Rel8.Table.Transpose ( Transposes )
import Rel8.Type ( DBType )
type Aggregate :: K.Context
newtype Aggregate a = Aggregate (Opaleye.Aggregator () (Expr a))
instance Sql DBType a => Table Aggregate (Aggregate a) where
type Columns (Aggregate a) = HIdentity a
type Context (Aggregate a) = Aggregate
type FromExprs (Aggregate a) = a
type Transpose to (Aggregate a) = to a
toColumns :: Aggregate a -> Columns (Aggregate a) Aggregate
toColumns = Aggregate a -> Columns (Aggregate a) Aggregate
forall a (context :: Context). context a -> HIdentity a context
HIdentity
fromColumns :: Columns (Aggregate a) Aggregate -> Aggregate a
fromColumns (HIdentity a) = Aggregate a
a
toResult :: FromExprs (Aggregate a) -> Columns (Aggregate a) Result
toResult = Identity a -> HIdentity a Result
forall a (context :: Context). context a -> HIdentity a context
HIdentity (Identity a -> HIdentity a Result)
-> (a -> Identity a) -> a -> HIdentity a Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
forall a. a -> Identity a
Identity
fromResult :: Columns (Aggregate a) Result -> FromExprs (Aggregate a)
fromResult (HIdentity (Identity a)) = a
FromExprs (Aggregate a)
a
type Aggregates :: Type -> Type -> Constraint
class Transposes Aggregate Expr aggregates exprs => Aggregates aggregates exprs
instance Transposes Aggregate Expr aggregates exprs => Aggregates aggregates exprs
zipOutputs :: ()
=> (Expr a -> Expr b -> Expr c) -> Aggregate a -> Aggregate b -> Aggregate c
zipOutputs :: (Expr a -> Expr b -> Expr c)
-> Aggregate a -> Aggregate b -> Aggregate c
zipOutputs Expr a -> Expr b -> Expr c
f (Aggregate Aggregator () (Expr a)
a) (Aggregate Aggregator () (Expr b)
b) = Aggregator () (Expr c) -> Aggregate c
forall a. Aggregator () (Expr a) -> Aggregate a
Aggregate ((Expr a -> Expr b -> Expr c)
-> Aggregator () (Expr a)
-> Aggregator () (Expr b)
-> Aggregator () (Expr c)
forall (f :: Context) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Expr a -> Expr b -> Expr c
f Aggregator () (Expr a)
a Aggregator () (Expr b)
b)
type Aggregator :: Type
data Aggregator = Aggregator
{ Aggregator -> AggrOp
operation :: Opaleye.AggrOp
, Aggregator -> [OrderExpr]
ordering :: [Opaleye.OrderExpr]
, Aggregator -> AggrDistinct
distinction :: Opaleye.AggrDistinct
}
unsafeMakeAggregate :: forall (input :: Type) (output :: Type). ()
=> (Expr input -> Opaleye.PrimExpr)
-> (Opaleye.PrimExpr -> Expr output)
-> Maybe Aggregator
-> Expr input
-> Aggregate output
unsafeMakeAggregate :: (Expr input -> PrimExpr)
-> (PrimExpr -> Expr output)
-> Maybe Aggregator
-> Expr input
-> Aggregate output
unsafeMakeAggregate Expr input -> PrimExpr
input PrimExpr -> Expr output
output Maybe Aggregator
aggregator Expr input
expr =
Aggregator () (Expr output) -> Aggregate output
forall a. Aggregator () (Expr a) -> Aggregate a
Aggregate (Aggregator () (Expr output) -> Aggregate output)
-> Aggregator () (Expr output) -> Aggregate output
forall a b. (a -> b) -> a -> b
$ PackMap
(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
PrimExpr
()
(Expr output)
-> Aggregator () (Expr output)
forall a b.
PackMap
(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) PrimExpr a b
-> Aggregator a b
Opaleye.Aggregator (PackMap
(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
PrimExpr
()
(Expr output)
-> Aggregator () (Expr output))
-> PackMap
(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
PrimExpr
()
(Expr output)
-> Aggregator () (Expr output)
forall a b. (a -> b) -> a -> b
$ (forall (f :: Context).
Applicative f =>
((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
-> f PrimExpr)
-> () -> f (Expr output))
-> PackMap
(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
PrimExpr
()
(Expr output)
forall a b s t.
(forall (f :: Context). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
Opaleye.PackMap ((forall (f :: Context).
Applicative f =>
((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
-> f PrimExpr)
-> () -> f (Expr output))
-> PackMap
(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
PrimExpr
()
(Expr output))
-> (forall (f :: Context).
Applicative f =>
((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
-> f PrimExpr)
-> () -> f (Expr output))
-> PackMap
(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
PrimExpr
()
(Expr output)
forall a b. (a -> b) -> a -> b
$ \(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) -> f PrimExpr
f ()
_ ->
PrimExpr -> Expr output
output (PrimExpr -> Expr output) -> f PrimExpr -> f (Expr output)
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) -> f PrimExpr
f (Aggregator -> (AggrOp, [OrderExpr], AggrDistinct)
tuplize (Aggregator -> (AggrOp, [OrderExpr], AggrDistinct))
-> Maybe Aggregator -> Maybe (AggrOp, [OrderExpr], AggrDistinct)
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Aggregator
aggregator, Expr input -> PrimExpr
input Expr input
expr)
where
tuplize :: Aggregator -> (AggrOp, [OrderExpr], AggrDistinct)
tuplize Aggregator {AggrOp
operation :: AggrOp
operation :: Aggregator -> AggrOp
operation, [OrderExpr]
ordering :: [OrderExpr]
ordering :: Aggregator -> [OrderExpr]
ordering, AggrDistinct
distinction :: AggrDistinct
distinction :: Aggregator -> AggrDistinct
distinction} =
(AggrOp
operation, [OrderExpr]
ordering, AggrDistinct
distinction)