{-# LANGUAGE DataKinds #-}
module Opaleye.Aggregate
(
aggregate
, aggregateOrdered
, distinctAggregator
, Aggregator
, groupBy
, Opaleye.Aggregate.sum
, sumInt4
, sumInt8
, count
, countStar
, avg
, Opaleye.Aggregate.max
, Opaleye.Aggregate.min
, boolOr
, boolAnd
, arrayAgg
, arrayAgg_
, jsonAgg
, stringAgg
, countRows
) where
import Control.Applicative (pure)
import Data.Profunctor (lmap)
import qualified Data.Profunctor as P
import qualified Opaleye.Internal.Aggregate as A
import Opaleye.Internal.Aggregate (Aggregator, orderAggregate)
import qualified Opaleye.Internal.Column as IC
import qualified Opaleye.Internal.QueryArr as Q
import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
import qualified Opaleye.Internal.PackMap as PM
import qualified Opaleye.Internal.Tag as Tag
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 :: Aggregator a b -> S.Select a -> S.Select b
aggregate :: forall a b. Aggregator a b -> Select a -> Select b
aggregate Aggregator a b
agg Select a
q = forall a. State Tag (a, PrimQuery) -> Query a
Q.productQueryArr forall a b. (a -> b) -> a -> b
$ do
(a
a, PrimQuery
pq) <- forall a. Select a -> State Tag (a, PrimQuery)
Q.runSimpleSelect Select a
q
Tag
t <- State Tag Tag
Tag.fresh
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. Aggregator a b -> (a, PrimQuery, Tag) -> (b, PrimQuery)
A.aggregateU Aggregator a b
agg (a
a, PrimQuery
pq, Tag
t))
aggregateOrdered :: Ord.Order a -> Aggregator a b -> S.Select a -> S.Select b
aggregateOrdered :: forall a b. Order a -> Aggregator a b -> Select a -> Select b
aggregateOrdered Order a
o Aggregator a b
agg = forall a b. Aggregator a b -> Select a -> Select b
aggregate (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 =>
((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
-> f PrimExpr)
-> a -> f b
pm)) =
forall a b.
PackMap
(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) PrimExpr a b
-> Aggregator a b
A.Aggregator (forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap (\(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) -> f PrimExpr
f a
c -> forall (f :: * -> *).
Applicative f =>
((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
-> f PrimExpr)
-> a -> f b
pm ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) -> f PrimExpr
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
P.first' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(AggrOp
a,[OrderExpr]
b,AggrDistinct
_) -> (AggrOp
a,[OrderExpr]
b,AggrDistinct
HPQ.AggrDistinct)))) a
c))
groupBy :: Aggregator (F.Field_ n a) (F.Field_ n a)
groupBy :: forall (n :: Nullability) a. Aggregator (Field_ n a) (Field_ n a)
groupBy = forall (n :: Nullability) a (n' :: Nullability) b.
Maybe AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
A.makeAggr' forall a. Maybe a
Nothing
sum :: Aggregator (F.Field a) (F.Field a)
sum :: forall a. Aggregator (Field a) (Field a)
sum = forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
A.makeAggr AggrOp
HPQ.AggrSum
sumInt4 :: Aggregator (F.Field T.SqlInt4) (F.Field T.SqlInt8)
sumInt4 :: Aggregator (Field SqlInt4) (Field SqlInt8)
sumInt4 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (n :: Nullability) a (n' :: Nullability) b.
Field_ n a -> Field_ n' b
F.unsafeCoerceField 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (n :: Nullability) a (n' :: Nullability) b.
Field_ n a -> Field_ n' b
F.unsafeCoerceField 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 = 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 = forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (forall a b. a -> b -> a
const (Field SqlInt4
0 :: F.Field T.SqlInt4)) 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 = forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
A.makeAggr AggrOp
HPQ.AggrAvg
max :: Ord.SqlOrd a => Aggregator (F.Field a) (F.Field a)
max :: forall a. SqlOrd a => Aggregator (Field a) (Field a)
max = forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
A.makeAggr AggrOp
HPQ.AggrMax
min :: Ord.SqlOrd a => Aggregator (F.Field a) (F.Field a)
min :: forall a. SqlOrd a => Aggregator (Field a) (Field a)
min = forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
A.makeAggr AggrOp
HPQ.AggrMin
boolOr :: Aggregator (F.Field T.SqlBool) (F.Field T.SqlBool)
boolOr :: Aggregator (Field SqlBool) (Field SqlBool)
boolOr = 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 = 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 = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap forall (n :: Nullability) a (n' :: Nullability) b.
Field_ n a -> Field_ n' b
F.unsafeCoerceField forall (n :: Nullability) a (n' :: Nullability) b.
Field_ n a -> Field_ n' b
F.unsafeCoerceField 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_ = 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 = 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 = forall (n :: Nullability) a (n' :: Nullability) b.
Maybe AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
A.makeAggr' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimExpr -> AggrOp
HPQ.AggrStringAggr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nullability) a. Field_ n a -> PrimExpr
IC.unColumn
countRows :: S.Select a -> S.Select (F.Field T.SqlInt8)
countRows :: forall a. Select a -> Select (Field SqlInt8)
countRows = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Field a -> FieldNullable a -> Field a
F.fromNullable Field SqlInt8
0)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Select (Field SqlInt4)
q -> 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 (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
(forall a b. Aggregator a b -> Select a -> Select b
aggregate forall a. Aggregator (Field a) (Field SqlInt8)
count Select (Field SqlInt4)
q)
(forall a b. a -> b -> a
const (Bool -> Field SqlBool
T.sqlBool Bool
True)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const (Field SqlInt4
0 :: F.Field T.SqlInt4))