{-# LANGUAGE TupleSections #-}
module Opaleye.Internal.Aggregate where
import Control.Applicative (Applicative, liftA2, pure, (<*>))
import qualified Data.Profunctor as P
import qualified Data.Profunctor.Product as PP
import qualified Opaleye.Field as F
import qualified Opaleye.Internal.Column as C
import qualified Opaleye.Internal.Order as O
import qualified Opaleye.Internal.PackMap as PM
import qualified Opaleye.Internal.PrimQuery as PQ
import qualified Opaleye.Internal.Tag as T
import qualified Opaleye.SqlTypes as T
import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
newtype Aggregator a b =
Aggregator (PM.PackMap (HPQ.Aggr, HPQ.PrimExpr) HPQ.PrimExpr a b)
makeAggr' :: Maybe HPQ.AggrOp -> Aggregator (C.Field_ n a) (C.Field_ n' b)
makeAggr' :: forall (n :: Nullability) a (n' :: Nullability) b.
Maybe AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
makeAggr' Maybe AggrOp
mAggrOp = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap forall (n :: Nullability) a. Field_ n a -> PrimExpr
C.unColumn forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
C.Column forall a b. (a -> b) -> a -> b
$ forall a b. PackMap (Aggr, PrimExpr) PrimExpr a b -> Aggregator a b
Aggregator (forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap
(\(Aggr, PrimExpr) -> f PrimExpr
f PrimExpr
e -> (Aggr, PrimExpr) -> f PrimExpr
f (Aggr
aggr, PrimExpr
e)))
where
aggr :: Aggr
aggr = case Maybe AggrOp
mAggrOp of
Maybe AggrOp
Nothing -> Aggr
HPQ.GroupBy
Just AggrOp
op -> AggrOp -> [OrderExpr] -> AggrDistinct -> Maybe PrimExpr -> Aggr
HPQ.Aggr AggrOp
op [] AggrDistinct
HPQ.AggrAll forall a. Maybe a
Nothing
makeAggr :: HPQ.AggrOp -> Aggregator (C.Field_ n a) (C.Field_ n' b)
makeAggr :: forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
makeAggr = forall (n :: Nullability) a (n' :: Nullability) b.
Maybe AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
makeAggr' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
orderAggregate :: O.Order a -> Aggregator a b -> Aggregator a b
orderAggregate :: forall a b. Order a -> Aggregator a b -> Aggregator a b
orderAggregate Order a
o (Aggregator (PM.PackMap forall (f :: * -> *).
Applicative f =>
((Aggr, PrimExpr) -> f PrimExpr) -> a -> f b
pm)) = forall a b. PackMap (Aggr, PrimExpr) PrimExpr a b -> Aggregator a b
Aggregator (forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap
(\(Aggr, PrimExpr) -> f PrimExpr
f a
c -> forall (f :: * -> *).
Applicative f =>
((Aggr, PrimExpr) -> f PrimExpr) -> a -> f b
pm ((Aggr, 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' ([OrderExpr] -> Aggr -> Aggr
setOrder (forall a. a -> Order a -> [OrderExpr]
O.orderExprs a
c Order a
o))) a
c))
where
setOrder :: [OrderExpr] -> Aggr -> Aggr
setOrder [OrderExpr]
_ Aggr
HPQ.GroupBy = Aggr
HPQ.GroupBy
setOrder [OrderExpr]
order Aggr
aggr =
Aggr
aggr
{ aggrOrder :: [OrderExpr]
HPQ.aggrOrder = [OrderExpr]
order
}
runAggregator
:: Applicative f
=> Aggregator a b
-> ((HPQ.Aggr, HPQ.PrimExpr) -> f HPQ.PrimExpr)
-> a -> f b
runAggregator :: forall (f :: * -> *) a b.
Applicative f =>
Aggregator a b -> ((Aggr, PrimExpr) -> f PrimExpr) -> a -> f b
runAggregator (Aggregator PackMap (Aggr, PrimExpr) PrimExpr a b
a) = forall (f :: * -> *) a b s t.
Applicative f =>
PackMap a b s t -> (a -> f b) -> s -> f t
PM.traversePM PackMap (Aggr, PrimExpr) PrimExpr a b
a
aggregatorApply :: Aggregator (Aggregator a b, a) b
aggregatorApply :: forall a b. Aggregator (Aggregator a b, a) b
aggregatorApply = forall a b. PackMap (Aggr, PrimExpr) PrimExpr a b -> Aggregator a b
Aggregator forall a b. (a -> b) -> a -> b
$ forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap forall a b. (a -> b) -> a -> b
$ \(Aggr, PrimExpr) -> f PrimExpr
f (Aggregator a b
agg, a
a) ->
case Aggregator a b
agg of
Aggregator (PM.PackMap forall (f :: * -> *).
Applicative f =>
((Aggr, PrimExpr) -> f PrimExpr) -> a -> f b
inner) -> forall (f :: * -> *).
Applicative f =>
((Aggr, PrimExpr) -> f PrimExpr) -> a -> f b
inner (Aggr, PrimExpr) -> f PrimExpr
f a
a
aggregateU :: Aggregator a b
-> (a, PQ.PrimQuery, T.Tag) -> (b, PQ.PrimQuery)
aggregateU :: forall a b. Aggregator a b -> (a, PrimQuery, Tag) -> (b, PrimQuery)
aggregateU Aggregator a b
agg (a
c0, PrimQuery
primQ, Tag
t0) = (b
c1, PrimQuery
primQ')
where (b
c1, [((Symbol, (Aggr, Symbol)), (Symbol, PrimExpr))]
projPEs_inners) =
forall a r. PM [a] r -> (r, [a])
PM.run (forall (f :: * -> *) a b.
Applicative f =>
Aggregator a b -> ((Aggr, PrimExpr) -> f PrimExpr) -> a -> f b
runAggregator Aggregator a b
agg (forall m.
Tag
-> (m, PrimExpr)
-> PM [((Symbol, (m, Symbol)), (Symbol, PrimExpr))] PrimExpr
extractAggregateFields Tag
t0) a
c0)
projPEs :: [(Symbol, (Aggr, Symbol))]
projPEs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [((Symbol, (Aggr, Symbol)), (Symbol, PrimExpr))]
projPEs_inners
inners :: [(Symbol, PrimExpr)]
inners = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [((Symbol, (Aggr, Symbol)), (Symbol, PrimExpr))]
projPEs_inners
primQ' :: PrimQuery
primQ' = forall a.
[(Symbol, (Aggr, Symbol))] -> PrimQuery' a -> PrimQuery' a
PQ.Aggregate [(Symbol, (Aggr, Symbol))]
projPEs (forall a.
Bool -> [(Symbol, PrimExpr)] -> PrimQuery' a -> PrimQuery' a
PQ.Rebind Bool
True [(Symbol, PrimExpr)]
inners PrimQuery
primQ)
extractAggregateFields
:: T.Tag
-> (m, HPQ.PrimExpr)
-> PM.PM [((HPQ.Symbol,
(m, HPQ.Symbol)),
(HPQ.Symbol, HPQ.PrimExpr))]
HPQ.PrimExpr
Tag
tag (m
m, PrimExpr
pe) = do
String
i <- forall a. PM a String
PM.new
let souter :: Symbol
souter = String -> Tag -> Symbol
HPQ.Symbol (String
"result" forall a. [a] -> [a] -> [a]
++ String
i) Tag
tag
sinner :: Symbol
sinner = String -> Tag -> Symbol
HPQ.Symbol (String
"inner" forall a. [a] -> [a] -> [a]
++ String
i) Tag
tag
forall a. a -> PM [a] ()
PM.write ((Symbol
souter, (m
m, Symbol
sinner)), (Symbol
sinner, PrimExpr
pe))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Symbol -> PrimExpr
HPQ.AttrExpr Symbol
souter)
unsafeMax :: Aggregator (C.Field a) (C.Field a)
unsafeMax :: forall a. Aggregator (Field a) (Field a)
unsafeMax = forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
makeAggr AggrOp
HPQ.AggrMax
unsafeMin :: Aggregator (C.Field a) (C.Field a)
unsafeMin :: forall a. Aggregator (Field a) (Field a)
unsafeMin = forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
makeAggr AggrOp
HPQ.AggrMin
unsafeAvg :: Aggregator (C.Field a) (C.Field a)
unsafeAvg :: forall a. Aggregator (Field a) (Field a)
unsafeAvg = forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
makeAggr AggrOp
HPQ.AggrAvg
unsafeSum :: Aggregator (C.Field a) (C.Field a)
unsafeSum :: forall a. Aggregator (Field a) (Field a)
unsafeSum = forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
makeAggr AggrOp
HPQ.AggrSum
filterWhereInternal
:: (F.FieldNullable T.SqlBool -> b -> mb)
-> (a -> F.Field T.SqlBool)
-> Aggregator a b
-> Aggregator a mb
filterWhereInternal :: forall b mb a.
(FieldNullable SqlBool -> b -> mb)
-> (a -> Field SqlBool) -> Aggregator a b -> Aggregator a mb
filterWhereInternal FieldNullable SqlBool -> b -> mb
maybeField a -> Field SqlBool
predicate Aggregator a b
aggregator =
case forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 FieldNullable SqlBool -> b -> mb
maybeField forall {a} {n' :: Nullability} {b}. Aggregator a (Field_ n' b)
true Aggregator a b
aggregator of
Aggregator (PM.PackMap forall (f :: * -> *).
Applicative f =>
((Aggr, PrimExpr) -> f PrimExpr) -> a -> f mb
pm) ->
forall a b. PackMap (Aggr, PrimExpr) PrimExpr a b -> Aggregator a b
Aggregator (forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap (\(Aggr, PrimExpr) -> f PrimExpr
f a
c -> forall (f :: * -> *).
Applicative f =>
((Aggr, PrimExpr) -> f PrimExpr) -> a -> f mb
pm ((Aggr, 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' (a -> Aggr -> Aggr
setFilter a
c)) a
c))
where
true :: Aggregator a (Field_ n' b)
true = forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap (forall a b. a -> b -> a
const (Bool -> Field SqlBool
T.sqlBool Bool
True)) (forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
makeAggr AggrOp
HPQ.AggrBoolAnd)
setFilter :: a -> Aggr -> Aggr
setFilter a
_ Aggr
HPQ.GroupBy = Aggr
HPQ.GroupBy
setFilter a
row Aggr
aggr =
Aggr
aggr
{ aggrFilter :: Maybe PrimExpr
HPQ.aggrFilter = Maybe PrimExpr
aggrFilter'
}
where
C.Column PrimExpr
cond' = a -> Field SqlBool
predicate a
row
aggrFilter' :: Maybe PrimExpr
aggrFilter' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Aggr -> Maybe PrimExpr
HPQ.aggrFilter Aggr
aggr of
Maybe PrimExpr
Nothing -> PrimExpr
cond'
Just PrimExpr
cond -> BinOp -> PrimExpr -> PrimExpr -> PrimExpr
HPQ.BinExpr BinOp
HPQ.OpAnd PrimExpr
cond PrimExpr
cond'
instance Functor (Aggregator a) where
fmap :: forall a b. (a -> b) -> Aggregator a a -> Aggregator a b
fmap a -> b
f (Aggregator PackMap (Aggr, PrimExpr) PrimExpr a a
g) = forall a b. PackMap (Aggr, PrimExpr) PrimExpr a b -> Aggregator a b
Aggregator (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f PackMap (Aggr, PrimExpr) PrimExpr a a
g)
instance Applicative (Aggregator a) where
pure :: forall a. a -> Aggregator a a
pure = forall a b. PackMap (Aggr, PrimExpr) PrimExpr a b -> Aggregator a b
Aggregator forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
Aggregator PackMap (Aggr, PrimExpr) PrimExpr a (a -> b)
f <*> :: forall a b.
Aggregator a (a -> b) -> Aggregator a a -> Aggregator a b
<*> Aggregator PackMap (Aggr, PrimExpr) PrimExpr a a
x = forall a b. PackMap (Aggr, PrimExpr) PrimExpr a b -> Aggregator a b
Aggregator (PackMap (Aggr, PrimExpr) PrimExpr a (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PackMap (Aggr, PrimExpr) PrimExpr a a
x)
instance P.Profunctor Aggregator where
dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Aggregator b c -> Aggregator a d
dimap a -> b
f c -> d
g (Aggregator PackMap (Aggr, PrimExpr) PrimExpr b c
q) = forall a b. PackMap (Aggr, PrimExpr) PrimExpr a b -> Aggregator a b
Aggregator (forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap a -> b
f c -> d
g PackMap (Aggr, PrimExpr) PrimExpr b c
q)
instance PP.ProductProfunctor Aggregator where
purePP :: forall b a. b -> Aggregator a b
purePP = forall (f :: * -> *) a. Applicative f => a -> f a
pure
**** :: forall a a b.
Aggregator a (a -> b) -> Aggregator a a -> Aggregator a b
(****) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
instance PP.SumProfunctor Aggregator where
Aggregator PackMap (Aggr, PrimExpr) PrimExpr a b
x1 +++! :: forall a b a' b'.
Aggregator a b
-> Aggregator a' b' -> Aggregator (Either a a') (Either b b')
+++! Aggregator PackMap (Aggr, PrimExpr) PrimExpr a' b'
x2 = forall a b. PackMap (Aggr, PrimExpr) PrimExpr a b -> Aggregator a b
Aggregator (PackMap (Aggr, PrimExpr) PrimExpr a b
x1 forall (p :: * -> * -> *) a b a' b'.
SumProfunctor p =>
p a b -> p a' b' -> p (Either a a') (Either b b')
PP.+++! PackMap (Aggr, PrimExpr) PrimExpr a' b'
x2)