{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module Opaleye.Aggregate
(
aggregate
, aggregateOrdered
, distinctAggregator
, filterWhere
, Aggregator
, groupBy
, Opaleye.Aggregate.sum
, sumInt4
, sumInt8
, count
, countStar
, avg
, Opaleye.Aggregate.max
, Opaleye.Aggregate.min
, boolOr
, boolAnd
, arrayAgg
, arrayAgg_
, jsonAgg
, stringAgg
, countRows
, aggregateExplicit
) where
import Control.Arrow (second, (<<<))
import Data.Profunctor (lmap)
import qualified Data.Profunctor as P
import qualified Data.Profunctor.Product.Default as D
import qualified Opaleye.Internal.Aggregate as A
import Opaleye.Internal.Aggregate (Aggregator, orderAggregate)
import Opaleye.Internal.MaybeFields (MaybeFields (MaybeFields))
import qualified Opaleye.Internal.QueryArr as Q
import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
import qualified Opaleye.Internal.Operators as O
import qualified Opaleye.Internal.PackMap as PM
import Opaleye.Internal.Rebind (rebindExplicit)
import qualified Opaleye.Internal.Tag as Tag
import qualified Opaleye.Internal.Unpackspec as U
import qualified Opaleye.Field as F
import qualified Opaleye.Order as Ord
import qualified Opaleye.Select as S
import qualified Opaleye.SqlTypes as T
import qualified Opaleye.Join as J
aggregate :: D.Default U.Unpackspec a a => Aggregator a b -> S.Select a -> S.Select b
aggregate :: forall a b.
Default Unpackspec a a =>
Aggregator a b -> Select a -> Select b
aggregate = Unpackspec a a -> Aggregator a b -> Select a -> Select b
forall a a' b.
Unpackspec a a' -> Aggregator a' b -> Select a -> Select b
aggregateExplicit Unpackspec a a
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
aggregateExplicit :: U.Unpackspec a a' -> Aggregator a' b -> S.Select a -> S.Select b
aggregateExplicit :: forall a a' b.
Unpackspec a a' -> Aggregator a' b -> Select a -> Select b
aggregateExplicit Unpackspec a a'
u Aggregator a' b
agg Select a
q = State Tag (b, PrimQuery) -> Query b
forall a. State Tag (a, PrimQuery) -> Query a
Q.productQueryArr (State Tag (b, PrimQuery) -> Query b)
-> State Tag (b, PrimQuery) -> Query b
forall a b. (a -> b) -> a -> b
$ do
(a'
a, PrimQuery
pq) <- Select a' -> State Tag (a', PrimQuery)
forall a. Select a -> State Tag (a, PrimQuery)
Q.runSimpleSelect (Unpackspec a a' -> SelectArr a a'
forall a b. Unpackspec a b -> SelectArr a b
rebindExplicit Unpackspec a a'
u SelectArr a a' -> Select a -> Select a'
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< Select a
q)
Tag
t <- State Tag Tag
Tag.fresh
(b, PrimQuery) -> State Tag (b, PrimQuery)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((PrimQuery -> PrimQuery) -> PrimQuery)
-> (b, PrimQuery -> PrimQuery) -> (b, PrimQuery)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((PrimQuery -> PrimQuery) -> PrimQuery -> PrimQuery
forall a b. (a -> b) -> a -> b
$ PrimQuery
pq) (Aggregator a' b -> (a', Tag) -> (b, PrimQuery -> PrimQuery)
forall a b.
Aggregator a b -> (a, Tag) -> (b, PrimQuery -> PrimQuery)
A.aggregateU Aggregator a' b
agg (a'
a, Tag
t)))
aggregateOrdered :: D.Default U.Unpackspec a a => Ord.Order a -> Aggregator a b -> S.Select a -> S.Select b
aggregateOrdered :: forall a b.
Default Unpackspec a a =>
Order a -> Aggregator a b -> Select a -> Select b
aggregateOrdered Order a
o Aggregator a b
agg = Aggregator a b -> Select a -> Select b
forall a b.
Default Unpackspec a a =>
Aggregator a b -> Select a -> Select b
aggregate (Order a -> Aggregator a b -> Aggregator a b
forall a b. Order a -> Aggregator a b -> Aggregator a b
orderAggregate Order a
o Aggregator a b
agg)
distinctAggregator :: Aggregator a b -> Aggregator a b
distinctAggregator :: forall a b. Aggregator a b -> Aggregator a b
distinctAggregator (A.Aggregator (PM.PackMap forall (f :: * -> *).
Applicative f =>
(Aggregate -> f PrimExpr) -> a -> f b
pm)) =
PackMap Aggregate PrimExpr a b -> Aggregator a b
forall a b. PackMap Aggregate PrimExpr a b -> Aggregator a b
A.Aggregator ((forall (f :: * -> *).
Applicative f =>
(Aggregate -> f PrimExpr) -> a -> f b)
-> PackMap Aggregate PrimExpr a b
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap (\Aggregate -> f PrimExpr
f a
c -> (Aggregate -> f PrimExpr) -> a -> f b
forall (f :: * -> *).
Applicative f =>
(Aggregate -> f PrimExpr) -> a -> f b
pm (Aggregate -> f PrimExpr
f (Aggregate -> f PrimExpr)
-> (Aggregate -> Aggregate) -> Aggregate -> f PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Aggregate -> Aggregate
forall {a}. Aggregate' a -> Aggregate' a
setDistinct) a
c))
where
setDistinct :: Aggregate' a -> Aggregate' a
setDistinct (HPQ.GroupBy a
expr) = a -> Aggregate' a
forall a. a -> Aggregate' a
HPQ.GroupBy a
expr
setDistinct (HPQ.Aggregate Aggr' a
aggr) =
Aggr' a -> Aggregate' a
forall a. Aggr' a -> Aggregate' a
HPQ.Aggregate Aggr' a
aggr
{ HPQ.aggrDistinct = HPQ.AggrDistinct
}
filterWhere
:: (a -> F.Field T.SqlBool)
-> Aggregator a b
-> Aggregator a (MaybeFields b)
filterWhere :: forall a b.
(a -> Field SqlBool)
-> Aggregator a b -> Aggregator a (MaybeFields b)
filterWhere = (FieldNullable SqlBool -> b -> MaybeFields b)
-> (a -> Field SqlBool)
-> Aggregator a b
-> Aggregator a (MaybeFields b)
forall b mb a.
(FieldNullable SqlBool -> b -> mb)
-> (a -> Field SqlBool) -> Aggregator a b -> Aggregator a mb
A.filterWhereInternal (Column SqlBool -> b -> MaybeFields b
Field SqlBool -> b -> MaybeFields b
forall fields. Column SqlBool -> fields -> MaybeFields fields
MaybeFields (Field SqlBool -> b -> MaybeFields b)
-> (FieldNullable SqlBool -> Field SqlBool)
-> FieldNullable SqlBool
-> b
-> MaybeFields b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field SqlBool -> Field SqlBool
O.not (Field SqlBool -> Field SqlBool)
-> (FieldNullable SqlBool -> Field SqlBool)
-> FieldNullable SqlBool
-> Field SqlBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNullable SqlBool -> Field SqlBool
forall a. FieldNullable a -> Field SqlBool
F.isNull)
groupBy :: Aggregator (F.Field_ n a) (F.Field_ n a)
groupBy :: forall (n :: Nullability) a. Aggregator (Field_ n a) (Field_ n a)
groupBy = Maybe AggrOp -> Aggregator (Field_ n a) (Field_ n a)
forall (n :: Nullability) a (n' :: Nullability) b.
Maybe AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
A.makeAggr' Maybe AggrOp
forall a. Maybe a
Nothing
sum :: Aggregator (F.Field a) (F.Field a)
sum :: forall a. Aggregator (Field a) (Field a)
sum = Aggregator (Field a) (Field a)
forall a. Aggregator (Field a) (Field a)
A.unsafeSum
sumInt4 :: Aggregator (F.Field T.SqlInt4) (F.Field T.SqlInt8)
sumInt4 :: Aggregator (Field SqlInt4) (Field SqlInt8)
sumInt4 = (Field SqlInt4 -> Field SqlInt8)
-> Aggregator (Field SqlInt4) (Field SqlInt4)
-> Aggregator (Field SqlInt4) (Field SqlInt8)
forall a b.
(a -> b)
-> Aggregator (Field SqlInt4) a -> Aggregator (Field SqlInt4) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field SqlInt4 -> Field SqlInt8
forall (n :: Nullability) a (n' :: Nullability) b.
Field_ n a -> Field_ n' b
F.unsafeCoerceField Aggregator (Field SqlInt4) (Field SqlInt4)
forall a. Aggregator (Field a) (Field a)
Opaleye.Aggregate.sum
sumInt8 :: Aggregator (F.Field T.SqlInt8) (F.Field T.SqlNumeric)
sumInt8 :: Aggregator (Field SqlInt8) (Field SqlNumeric)
sumInt8 = (Field SqlInt8 -> Field SqlNumeric)
-> Aggregator (Field SqlInt8) (Field SqlInt8)
-> Aggregator (Field SqlInt8) (Field SqlNumeric)
forall a b.
(a -> b)
-> Aggregator (Field SqlInt8) a -> Aggregator (Field SqlInt8) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field SqlInt8 -> Field SqlNumeric
forall (n :: Nullability) a (n' :: Nullability) b.
Field_ n a -> Field_ n' b
F.unsafeCoerceField Aggregator (Field SqlInt8) (Field SqlInt8)
forall a. Aggregator (Field a) (Field a)
Opaleye.Aggregate.sum
count :: Aggregator (F.Field a) (F.Field T.SqlInt8)
count :: forall a. Aggregator (Field a) (Field SqlInt8)
count = AggrOp -> Aggregator (Field_ 'NonNullable a) (Field SqlInt8)
forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
A.makeAggr AggrOp
HPQ.AggrCount
countStar :: Aggregator a (F.Field T.SqlInt8)
countStar :: forall a. Aggregator a (Field SqlInt8)
countStar = (a -> Field SqlInt4)
-> Aggregator (Field SqlInt4) (Field SqlInt8)
-> Aggregator a (Field SqlInt8)
forall a b c. (a -> b) -> Aggregator b c -> Aggregator a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Field SqlInt4 -> a -> Field SqlInt4
forall a b. a -> b -> a
const (Field SqlInt4
0 :: F.Field T.SqlInt4)) Aggregator (Field SqlInt4) (Field SqlInt8)
forall a. Aggregator (Field a) (Field SqlInt8)
count
avg :: Aggregator (F.Field T.SqlFloat8) (F.Field T.SqlFloat8)
avg :: Aggregator (Field SqlFloat8) (Field SqlFloat8)
avg = Aggregator (Field SqlFloat8) (Field SqlFloat8)
forall a. Aggregator (Field a) (Field a)
A.unsafeAvg
max :: Ord.SqlOrd a => Aggregator (F.Field a) (F.Field a)
max :: forall a. SqlOrd a => Aggregator (Field a) (Field a)
max = Aggregator (Field a) (Field a)
forall a. Aggregator (Field a) (Field a)
A.unsafeMax
min :: Ord.SqlOrd a => Aggregator (F.Field a) (F.Field a)
min :: forall a. SqlOrd a => Aggregator (Field a) (Field a)
min = Aggregator (Field a) (Field a)
forall a. Aggregator (Field a) (Field a)
A.unsafeMin
boolOr :: Aggregator (F.Field T.SqlBool) (F.Field T.SqlBool)
boolOr :: Aggregator (Field SqlBool) (Field SqlBool)
boolOr = AggrOp -> Aggregator (Field SqlBool) (Field SqlBool)
forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
A.makeAggr AggrOp
HPQ.AggrBoolOr
boolAnd :: Aggregator (F.Field T.SqlBool) (F.Field T.SqlBool)
boolAnd :: Aggregator (Field SqlBool) (Field SqlBool)
boolAnd = AggrOp -> Aggregator (Field SqlBool) (Field SqlBool)
forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
A.makeAggr AggrOp
HPQ.AggrBoolAnd
arrayAgg :: Aggregator (F.Field a) (F.Field (T.SqlArray a))
arrayAgg :: forall a. Aggregator (Field a) (Field (SqlArray a))
arrayAgg = (Field a -> Field_ Any Any)
-> (Field_ 'NonNullable (SqlArray_ Any Any) -> Field (SqlArray a))
-> Aggregator
(Field_ Any Any) (Field_ 'NonNullable (SqlArray_ Any Any))
-> Aggregator (Field a) (Field (SqlArray a))
forall a b c d.
(a -> b) -> (c -> d) -> Aggregator b c -> Aggregator a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap Field a -> Field_ Any Any
forall (n :: Nullability) a (n' :: Nullability) b.
Field_ n a -> Field_ n' b
F.unsafeCoerceField Field_ 'NonNullable (SqlArray_ Any Any) -> Field (SqlArray a)
forall (n :: Nullability) a (n' :: Nullability) b.
Field_ n a -> Field_ n' b
F.unsafeCoerceField Aggregator
(Field_ Any Any) (Field_ 'NonNullable (SqlArray_ Any Any))
forall (n :: Nullability) a.
Aggregator (Field_ n a) (Field (SqlArray_ n a))
arrayAgg_
arrayAgg_ :: Aggregator (F.Field_ n a) (F.Field (T.SqlArray_ n a))
arrayAgg_ :: forall (n :: Nullability) a.
Aggregator (Field_ n a) (Field (SqlArray_ n a))
arrayAgg_ = AggrOp
-> Aggregator (Field_ n a) (Field_ 'NonNullable (SqlArray_ n a))
forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
A.makeAggr AggrOp
HPQ.AggrArr
jsonAgg :: Aggregator (F.Field a) (F.Field T.SqlJson)
jsonAgg :: forall a. Aggregator (Field a) (Field SqlJson)
jsonAgg = AggrOp -> Aggregator (Field_ 'NonNullable a) (Field SqlJson)
forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
A.makeAggr AggrOp
HPQ.JsonArr
stringAgg :: F.Field T.SqlText
-> Aggregator (F.Field T.SqlText) (F.Field T.SqlText)
stringAgg :: Field SqlText -> Aggregator (Field SqlText) (Field SqlText)
stringAgg Field SqlText
delimiter =
Unpackspec (Field SqlText) (Field SqlText)
-> AggrOp -> Aggregator (Field SqlText) (Field SqlText)
forall a a' (n :: Nullability) b.
Unpackspec a a' -> AggrOp -> Aggregator a (Field_ n b)
A.makeAggrExplicit
(Unpackspec (Field SqlText) (Field SqlText)
forall (n :: Nullability) a. Unpackspec (Field_ n a) (Field_ n a)
U.unpackspecField Unpackspec (Field SqlText) (Field SqlText)
-> Unpackspec (Field SqlText) (Field SqlText)
-> Unpackspec (Field SqlText) (Field SqlText)
forall a b.
Unpackspec (Field SqlText) a
-> Unpackspec (Field SqlText) b -> Unpackspec (Field SqlText) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Field SqlText -> Field SqlText)
-> Unpackspec (Field SqlText) (Field SqlText)
-> Unpackspec (Field SqlText) (Field SqlText)
forall a b c. (a -> b) -> Unpackspec b c -> Unpackspec a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Field SqlText -> Field SqlText -> Field SqlText
forall a b. a -> b -> a
const Field SqlText
delimiter) Unpackspec (Field SqlText) (Field SqlText)
forall (n :: Nullability) a. Unpackspec (Field_ n a) (Field_ n a)
U.unpackspecField)
AggrOp
HPQ.AggrStringAggr
countRows :: S.Select a -> S.Select (F.Field T.SqlInt8)
countRows :: forall a. Select a -> Select (Field SqlInt8)
countRows = (FieldNullable SqlInt8 -> Field SqlInt8)
-> SelectArr () (FieldNullable SqlInt8) -> Select (Field SqlInt8)
forall a b. (a -> b) -> SelectArr () a -> SelectArr () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Field SqlInt8 -> FieldNullable SqlInt8 -> Field SqlInt8
forall a. Field a -> FieldNullable a -> Field a
F.fromNullable Field SqlInt8
0)
(SelectArr () (FieldNullable SqlInt8) -> Select (Field SqlInt8))
-> (Select a -> SelectArr () (FieldNullable SqlInt8))
-> Select a
-> Select (Field SqlInt8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((), FieldNullable SqlInt8) -> FieldNullable SqlInt8)
-> SelectArr () ((), FieldNullable SqlInt8)
-> SelectArr () (FieldNullable SqlInt8)
forall a b. (a -> b) -> SelectArr () a -> SelectArr () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((), FieldNullable SqlInt8) -> FieldNullable SqlInt8
forall a b. (a, b) -> b
snd
(SelectArr () ((), FieldNullable SqlInt8)
-> SelectArr () (FieldNullable SqlInt8))
-> (Select a -> SelectArr () ((), FieldNullable SqlInt8))
-> Select a
-> SelectArr () (FieldNullable SqlInt8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Select (Field SqlInt4)
q -> Select ()
-> Select (Field SqlInt8)
-> (((), Field SqlInt8) -> Field SqlBool)
-> SelectArr () ((), FieldNullable SqlInt8)
forall fieldsL fieldsR nullableFieldsR.
(Default Unpackspec fieldsL fieldsL,
Default Unpackspec fieldsR fieldsR,
Default NullMaker fieldsR nullableFieldsR) =>
Select fieldsL
-> Select fieldsR
-> ((fieldsL, fieldsR) -> Field SqlBool)
-> Select (fieldsL, nullableFieldsR)
J.leftJoin (() -> Select ()
forall a. a -> SelectArr () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
(Aggregator (Field SqlInt4) (Field SqlInt8)
-> Select (Field SqlInt4) -> Select (Field SqlInt8)
forall a b.
Default Unpackspec a a =>
Aggregator a b -> Select a -> Select b
aggregate Aggregator (Field SqlInt4) (Field SqlInt8)
forall a. Aggregator (Field a) (Field SqlInt8)
count Select (Field SqlInt4)
q)
(Field SqlBool -> ((), Field SqlInt8) -> Field SqlBool
forall a b. a -> b -> a
const (Bool -> Field SqlBool
T.sqlBool Bool
True)))
(Select (Field SqlInt4)
-> SelectArr () ((), FieldNullable SqlInt8))
-> (Select a -> Select (Field SqlInt4))
-> Select a
-> SelectArr () ((), FieldNullable SqlInt8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Field SqlInt4) -> Select a -> Select (Field SqlInt4)
forall a b. (a -> b) -> SelectArr () a -> SelectArr () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Field SqlInt4 -> a -> Field SqlInt4
forall a b. a -> b -> a
const (Field SqlInt4
0 :: F.Field T.SqlInt4))