{-# LANGUAGE TupleSections #-}
module Opaleye.Internal.Aggregate where

import           Control.Applicative (liftA2)
import           Data.Foldable (toList)
import           Data.Traversable (for)

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.Internal.Unpackspec as U
import qualified Opaleye.SqlTypes as T

import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ

{-|
An 'Aggregator' takes a collection of rows of type @a@, groups
them, and transforms each group into a single row of type @b@. This
corresponds to aggregators using @GROUP BY@ in SQL.

You should combine basic 'Aggregator's into 'Aggregator's on compound
types by using the operations in "Data.Profunctor.Product".

An 'Aggregator' corresponds closely to a 'Control.Foldl.Fold' from the
@foldl@ package.  Whereas an 'Aggregator' @a@ @b@ takes each group of
type @a@ to a single row of type @b@, a 'Control.Foldl.Fold' @a@ @b@
takes a list of @a@ and returns a single value of type @b@.
-}
newtype Aggregator a b =
  Aggregator (PM.PackMap HPQ.Aggregate 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 = (Field_ n a -> PrimExpr)
-> (PrimExpr -> Field_ n' b)
-> Aggregator PrimExpr PrimExpr
-> Aggregator (Field_ n a) (Field_ n' b)
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_ n a -> PrimExpr
forall (n :: Nullability) a. Field_ n a -> PrimExpr
C.unColumn PrimExpr -> Field_ n' b
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
C.Column (Aggregator PrimExpr PrimExpr
 -> Aggregator (Field_ n a) (Field_ n' b))
-> Aggregator PrimExpr PrimExpr
-> Aggregator (Field_ n a) (Field_ n' b)
forall a b. (a -> b) -> a -> b
$ PackMap Aggregate PrimExpr PrimExpr PrimExpr
-> Aggregator PrimExpr PrimExpr
forall a b. PackMap Aggregate PrimExpr a b -> Aggregator a b
Aggregator ((forall (f :: * -> *).
 Applicative f =>
 (Aggregate -> f PrimExpr) -> PrimExpr -> f PrimExpr)
-> PackMap Aggregate PrimExpr PrimExpr PrimExpr
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 PrimExpr
e -> Aggregate -> f PrimExpr
f (PrimExpr -> Aggregate
forall {a}. a -> Aggregate' a
aggr PrimExpr
e)))
  where
    aggr :: a -> Aggregate' a
aggr = case Maybe AggrOp
mAggrOp of
      Maybe AggrOp
Nothing -> a -> Aggregate' a
forall {a}. a -> Aggregate' a
HPQ.GroupBy
      Just AggrOp
op -> \a
e -> Aggr' a -> Aggregate' a
forall a. Aggr' a -> Aggregate' a
HPQ.Aggregate (AggrOp
-> [a]
-> [OrderExpr' a]
-> AggrDistinct
-> [OrderExpr' a]
-> Maybe PrimExpr
-> Aggr' a
forall a.
AggrOp
-> [a]
-> [OrderExpr' a]
-> AggrDistinct
-> [OrderExpr' a]
-> Maybe PrimExpr
-> Aggr' a
HPQ.Aggr AggrOp
op [a
e] [] AggrDistinct
HPQ.AggrAll [] Maybe PrimExpr
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 = Maybe AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
forall (n :: Nullability) a (n' :: Nullability) b.
Maybe AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
makeAggr' (Maybe AggrOp -> Aggregator (Field_ n a) (Field_ n' b))
-> (AggrOp -> Maybe AggrOp)
-> AggrOp
-> Aggregator (Field_ n a) (Field_ n' b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AggrOp -> Maybe AggrOp
forall a. a -> Maybe a
Just

makeAggrExplicit :: U.Unpackspec a a' -> HPQ.AggrOp -> Aggregator a (C.Field_ n b)
makeAggrExplicit :: forall a a' (n :: Nullability) b.
Unpackspec a a' -> AggrOp -> Aggregator a (Field_ n b)
makeAggrExplicit Unpackspec a a'
unpackspec AggrOp
op =
  PrimExpr -> Field_ n b
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
C.Column (PrimExpr -> Field_ n b)
-> Aggregator a PrimExpr -> Aggregator a (Field_ n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackMap Aggregate PrimExpr a PrimExpr -> Aggregator a PrimExpr
forall a b. PackMap Aggregate PrimExpr a b -> Aggregator a b
Aggregator ((forall (f :: * -> *).
 Applicative f =>
 (Aggregate -> f PrimExpr) -> a -> f PrimExpr)
-> PackMap Aggregate PrimExpr a PrimExpr
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
e -> Aggregate -> f PrimExpr
f (a -> Aggregate
aggr a
e)))
  where
    aggr :: a -> Aggregate
aggr a
a = Aggr' PrimExpr -> Aggregate
forall a. Aggr' a -> Aggregate' a
HPQ.Aggregate (AggrOp
-> [PrimExpr]
-> [OrderExpr' PrimExpr]
-> AggrDistinct
-> [OrderExpr' PrimExpr]
-> Maybe PrimExpr
-> Aggr' PrimExpr
forall a.
AggrOp
-> [a]
-> [OrderExpr' a]
-> AggrDistinct
-> [OrderExpr' a]
-> Maybe PrimExpr
-> Aggr' a
HPQ.Aggr AggrOp
op [PrimExpr]
exprs [] AggrDistinct
HPQ.AggrAll [] Maybe PrimExpr
forall a. Maybe a
Nothing)
      where
        exprs :: [PrimExpr]
exprs = Unpackspec a a' -> a -> [PrimExpr]
forall s t. Unpackspec s t -> s -> [PrimExpr]
U.collectPEs Unpackspec a a'
unpackspec a
a


-- | Order the values within each aggregation in `Aggregator` using
-- the given ordering. This is only relevant for aggregations that
-- depend on the order they get their elements, like
-- `Opaleye.Aggregate.arrayAgg` and `Opaleye.Aggregate.stringAgg`.
--
-- You can either apply it to an aggregation of multiple columns, in
-- which case it will apply to all aggregation functions in there
--
-- Example:
--
-- > x :: Aggregator (Column a, Column b) (Column (PGArray a), Column (PGArray b))
-- > x = orderAggregate (asc snd) $ p2 (arrayAgg, arrayAgg)
--
-- This will generate:
--
-- @
-- SELECT array_agg(a ORDER BY b ASC), array_agg(b ORDER BY b ASC)
-- FROM (SELECT a, b FROM ...)
-- @
--
-- Or you can apply it to a single column, and then compose the aggregations
-- afterwards.
--
-- Example:
--
-- > x :: Aggregator (Column a, Column b) (Column (PGArray a), Column (PGArray a))
-- > x = (,) <$> orderAggregate (asc snd) (lmap fst arrayAgg)
-- >         <*> orderAggregate (desc snd) (lmap fst arrayAgg)
--
-- This will generate:
--
-- @
-- SELECT array_agg(a ORDER BY b ASC), array_agg(a ORDER BY b DESC)
-- FROM (SELECT a, b FROM ...)
-- @

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 =>
(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
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
. [OrderExpr' PrimExpr] -> Aggregate -> Aggregate
forall {a}. [OrderExpr' a] -> Aggregate' a -> Aggregate' a
setOrder (a -> Order a -> [OrderExpr' PrimExpr]
forall a. a -> Order a -> [OrderExpr' PrimExpr]
O.orderExprs a
c Order a
o)) a
c))
  where
    setOrder :: [OrderExpr' a] -> Aggregate' a -> Aggregate' a
setOrder [OrderExpr' a]
_ (HPQ.GroupBy a
e) = a -> Aggregate' a
forall {a}. a -> Aggregate' a
HPQ.GroupBy a
e
    setOrder [OrderExpr' a]
order (HPQ.Aggregate Aggr' a
aggr) =
      Aggr' a -> Aggregate' a
forall a. Aggr' a -> Aggregate' a
HPQ.Aggregate Aggr' a
aggr
        { HPQ.aggrOrder = order
        }

runAggregator
  :: Applicative f
  => Aggregator a b
  -> (HPQ.Aggregate -> f HPQ.PrimExpr)
  -> a -> f b
runAggregator :: forall (f :: * -> *) a b.
Applicative f =>
Aggregator a b -> (Aggregate -> f PrimExpr) -> a -> f b
runAggregator (Aggregator PackMap Aggregate PrimExpr a b
a) = PackMap Aggregate PrimExpr a b
-> (Aggregate -> f PrimExpr) -> a -> f b
forall (f :: * -> *) a b s t.
Applicative f =>
PackMap a b s t -> (a -> f b) -> s -> f t
PM.traversePM PackMap Aggregate PrimExpr a b
a

-- For rel8.
--
-- Like https://www.stackage.org/haddock/lts-19.10/base-4.15.1.0/Control-Arrow.html#t:ArrowApply
aggregatorApply :: Aggregator (Aggregator a b, a) b
aggregatorApply :: forall a b. Aggregator (Aggregator a b, a) b
aggregatorApply = PackMap Aggregate PrimExpr (Aggregator a b, a) b
-> Aggregator (Aggregator a b, a) b
forall a b. PackMap Aggregate PrimExpr a b -> Aggregator a b
Aggregator (PackMap Aggregate PrimExpr (Aggregator a b, a) b
 -> Aggregator (Aggregator a b, a) b)
-> PackMap Aggregate PrimExpr (Aggregator a b, a) b
-> Aggregator (Aggregator a b, a) b
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *).
 Applicative f =>
 (Aggregate -> f PrimExpr) -> (Aggregator a b, a) -> f b)
-> PackMap Aggregate PrimExpr (Aggregator 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 (f :: * -> *).
  Applicative f =>
  (Aggregate -> f PrimExpr) -> (Aggregator a b, a) -> f b)
 -> PackMap Aggregate PrimExpr (Aggregator a b, a) b)
-> (forall (f :: * -> *).
    Applicative f =>
    (Aggregate -> f PrimExpr) -> (Aggregator a b, a) -> f b)
-> PackMap Aggregate PrimExpr (Aggregator a b, a) b
forall a b. (a -> b) -> a -> b
$ \Aggregate -> f PrimExpr
f (Aggregator a b
agg, a
a) ->
  case Aggregator a b
agg of
    Aggregator (PM.PackMap forall (f :: * -> *).
Applicative f =>
(Aggregate -> f PrimExpr) -> a -> f b
inner) -> (Aggregate -> f PrimExpr) -> a -> f b
forall (f :: * -> *).
Applicative f =>
(Aggregate -> f PrimExpr) -> a -> f b
inner Aggregate -> f PrimExpr
f a
a

-- In Postgres (and, I believe, standard SQL) "aggregate functions are
-- not allowed in FROM clause of their own query level".  There
-- doesn't seem to be any fundamental reason for this, but we are
-- stuck with it.  That means that in a lateral subquery containing an
-- aggregation over a field C from a previous subquery we have to
-- create a new field name for C before we are allowed to aggregate it!
-- For more information see
--
--     https://www.postgresql.org/message-id/20200513110251.GC24083%40cloudinit-builder
--
--     https://github.com/tomjaguarpaw/haskell-opaleye/pull/460#issuecomment-626716160
--
-- Instead of detecting when we are aggregating over a field from a
-- previous query we just create new names for all fields before we
-- aggregate.  On the other hand, referring to a field from a previous
-- query in an ORDER BY expression is totally fine!
aggregateU :: Aggregator a b
           -> (a, T.Tag) -> (b, PQ.PrimQuery -> PQ.PrimQuery)
aggregateU :: forall a b.
Aggregator a b -> (a, Tag) -> (b, PrimQuery -> PrimQuery)
aggregateU Aggregator a b
agg (a
c0, Tag
t0) = (b
c1, PrimQuery -> PrimQuery
forall {a}. PrimQuery' a -> PrimQuery' a
primQ')
  where projPEs_inners :: PQ.Bindings HPQ.Aggregate
        (b
c1, Bindings Aggregate
projPEs_inners) =
          PM (Bindings Aggregate) b -> (b, Bindings Aggregate)
forall a r. PM [a] r -> (r, [a])
PM.run (Aggregator a b
-> (Aggregate
    -> StateT (Bindings Aggregate, Int) Identity PrimExpr)
-> a
-> PM (Bindings Aggregate) b
forall (f :: * -> *) a b.
Applicative f =>
Aggregator a b -> (Aggregate -> f PrimExpr) -> a -> f b
runAggregator Aggregator a b
agg (Tag
-> Aggregate -> StateT (Bindings Aggregate, Int) Identity PrimExpr
extractAggregateFields Tag
t0) a
c0)

        projPEs :: Bindings Aggregate
projPEs = Bindings Aggregate
projPEs_inners

        primQ' :: PrimQuery' a -> PrimQuery' a
primQ' = Bindings Aggregate -> PrimQuery' a -> PrimQuery' a
forall a. Bindings Aggregate -> PrimQuery' a -> PrimQuery' a
PQ.Aggregate Bindings Aggregate
projPEs

extractAggregateFields
  :: T.Tag
  -> HPQ.Aggregate
  -> PM.PM (PQ.Bindings HPQ.Aggregate) HPQ.PrimExpr
extractAggregateFields :: Tag
-> Aggregate -> StateT (Bindings Aggregate, Int) Identity PrimExpr
extractAggregateFields Tag
tag Aggregate
agg = do
  String
i <- PM (Bindings Aggregate) String
forall a. PM a String
PM.new
  let sinner :: Symbol
sinner = String -> Tag -> Symbol
HPQ.Symbol (String
"result" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
i) Tag
tag

  (Symbol, Aggregate) -> PM (Bindings Aggregate) ()
forall a. a -> PM [a] ()
PM.write (Symbol
sinner, Aggregate
agg)

  PrimExpr -> StateT (Bindings Aggregate, Int) Identity PrimExpr
forall a. a -> StateT (Bindings Aggregate, Int) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Symbol -> PrimExpr
HPQ.AttrExpr Symbol
sinner)

unsafeMax :: Aggregator (C.Field a) (C.Field a)
unsafeMax :: forall a. Aggregator (Field a) (Field a)
unsafeMax = AggrOp
-> Aggregator (Field_ 'NonNullable a) (Field_ 'NonNullable a)
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 = AggrOp
-> Aggregator (Field_ 'NonNullable a) (Field_ 'NonNullable a)
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 = AggrOp
-> Aggregator (Field_ 'NonNullable a) (Field_ 'NonNullable a)
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 = AggrOp
-> Aggregator (Field_ 'NonNullable a) (Field_ 'NonNullable a)
forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
makeAggr AggrOp
HPQ.AggrSum

-- | Aggregate only rows matching the given predicate
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 (FieldNullable SqlBool -> b -> mb)
-> Aggregator a (FieldNullable SqlBool)
-> Aggregator a b
-> Aggregator a mb
forall a b c.
(a -> b -> c) -> Aggregator a a -> Aggregator a b -> Aggregator a c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 FieldNullable SqlBool -> b -> mb
maybeField Aggregator a (FieldNullable SqlBool)
forall {a} {n' :: Nullability} {b}. Aggregator a (Field_ n' b)
true Aggregator a b
aggregator of
    Aggregator (PM.PackMap forall (f :: * -> *).
Applicative f =>
(Aggregate -> f PrimExpr) -> a -> f mb
pm) ->
      PackMap Aggregate PrimExpr a mb -> Aggregator a mb
forall a b. PackMap Aggregate PrimExpr a b -> Aggregator a b
Aggregator ((forall (f :: * -> *).
 Applicative f =>
 (Aggregate -> f PrimExpr) -> a -> f mb)
-> PackMap Aggregate PrimExpr a mb
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 mb
forall (f :: * -> *).
Applicative f =>
(Aggregate -> f PrimExpr) -> a -> f mb
pm (Aggregate -> f PrimExpr
f (Aggregate -> f PrimExpr)
-> (Aggregate -> Aggregate) -> Aggregate -> f PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Aggregate -> Aggregate
forall {a}. a -> Aggregate' a -> Aggregate' a
setFilter a
c) a
c))
  where
    true :: Aggregator a (Field_ n' b)
true = (a -> Field SqlBool)
-> Aggregator (Field SqlBool) (Field_ n' b)
-> Aggregator a (Field_ n' b)
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
P.lmap (Field SqlBool -> a -> Field SqlBool
forall a b. a -> b -> a
const (Bool -> Field SqlBool
T.sqlBool Bool
True)) (AggrOp -> Aggregator (Field SqlBool) (Field_ n' b)
forall (n :: Nullability) a (n' :: Nullability) b.
AggrOp -> Aggregator (Field_ n a) (Field_ n' b)
makeAggr AggrOp
HPQ.AggrBoolAnd)
    setFilter :: a -> Aggregate' a -> Aggregate' a
setFilter a
_ (HPQ.GroupBy a
e) = a -> Aggregate' a
forall {a}. a -> Aggregate' a
HPQ.GroupBy a
e
    setFilter a
row (HPQ.Aggregate Aggr' a
aggr) =
      Aggr' a -> Aggregate' a
forall a. Aggr' a -> Aggregate' a
HPQ.Aggregate Aggr' a
aggr
        { HPQ.aggrFilter = aggrFilter'
        }
      where
        C.Column PrimExpr
cond' = a -> Field SqlBool
predicate a
row
        aggrFilter' :: Maybe PrimExpr
aggrFilter' = PrimExpr -> Maybe PrimExpr
forall a. a -> Maybe a
Just (PrimExpr -> Maybe PrimExpr) -> PrimExpr -> Maybe PrimExpr
forall a b. (a -> b) -> a -> b
$ case Aggr' a -> Maybe PrimExpr
forall a. Aggr' a -> Maybe PrimExpr
HPQ.aggrFilter Aggr' a
aggr of
          Maybe PrimExpr
Nothing -> PrimExpr
cond'
          Just PrimExpr
cond -> BinOp -> PrimExpr -> PrimExpr -> PrimExpr
HPQ.BinExpr BinOp
HPQ.OpAnd PrimExpr
cond PrimExpr
cond'

withinGroup :: O.Order a -> Aggregator a b -> Aggregator a b
withinGroup :: forall a b. Order a -> Aggregator a b -> Aggregator a b
withinGroup Order a
o (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
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
. [OrderExpr' PrimExpr] -> Aggregate -> Aggregate
forall {a}. [OrderExpr' a] -> Aggregate' a -> Aggregate' a
setOrder (a -> Order a -> [OrderExpr' PrimExpr]
forall a. a -> Order a -> [OrderExpr' PrimExpr]
O.orderExprs a
c Order a
o)) a
c))
  where
    setOrder :: [OrderExpr' a] -> Aggregate' a -> Aggregate' a
setOrder [OrderExpr' a]
_ (HPQ.GroupBy a
e) = a -> Aggregate' a
forall {a}. a -> Aggregate' a
HPQ.GroupBy a
e
    setOrder [OrderExpr' a]
order (HPQ.Aggregate Aggr' a
aggr) =
      Aggr' a -> Aggregate' a
forall a. Aggr' a -> Aggregate' a
HPQ.Aggregate Aggr' a
aggr
        { HPQ.aggrGroup = order
        }

-- { Boilerplate instances

instance Functor (Aggregator a) where
  fmap :: forall a b. (a -> b) -> Aggregator a a -> Aggregator a b
fmap a -> b
f (Aggregator PackMap Aggregate PrimExpr a a
g) = PackMap Aggregate PrimExpr a b -> Aggregator a b
forall a b. PackMap Aggregate PrimExpr a b -> Aggregator a b
Aggregator ((a -> b)
-> PackMap Aggregate PrimExpr a a -> PackMap Aggregate PrimExpr a b
forall a b.
(a -> b)
-> PackMap Aggregate PrimExpr a a -> PackMap Aggregate PrimExpr a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f PackMap Aggregate PrimExpr a a
g)

instance Applicative (Aggregator a) where
  pure :: forall a. a -> Aggregator a a
pure = PackMap Aggregate PrimExpr a a -> Aggregator a a
forall a b. PackMap Aggregate PrimExpr a b -> Aggregator a b
Aggregator (PackMap Aggregate PrimExpr a a -> Aggregator a a)
-> (a -> PackMap Aggregate PrimExpr a a) -> a -> Aggregator a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PackMap Aggregate PrimExpr a a
forall a. a -> PackMap Aggregate PrimExpr a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Aggregator PackMap Aggregate PrimExpr a (a -> b)
f <*> :: forall a b.
Aggregator a (a -> b) -> Aggregator a a -> Aggregator a b
<*> Aggregator PackMap Aggregate PrimExpr a a
x = PackMap Aggregate PrimExpr a b -> Aggregator a b
forall a b. PackMap Aggregate PrimExpr a b -> Aggregator a b
Aggregator (PackMap Aggregate PrimExpr a (a -> b)
f PackMap Aggregate PrimExpr a (a -> b)
-> PackMap Aggregate PrimExpr a a -> PackMap Aggregate PrimExpr a b
forall a b.
PackMap Aggregate PrimExpr a (a -> b)
-> PackMap Aggregate PrimExpr a a -> PackMap Aggregate PrimExpr a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PackMap Aggregate 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 Aggregate PrimExpr b c
q) = PackMap Aggregate PrimExpr a d -> Aggregator a d
forall a b. PackMap Aggregate PrimExpr a b -> Aggregator a b
Aggregator ((a -> b)
-> (c -> d)
-> PackMap Aggregate PrimExpr b c
-> PackMap Aggregate PrimExpr a d
forall a b c d.
(a -> b)
-> (c -> d)
-> PackMap Aggregate PrimExpr b c
-> PackMap Aggregate PrimExpr a d
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 Aggregate PrimExpr b c
q)

instance PP.ProductProfunctor Aggregator where
  purePP :: forall b a. b -> Aggregator a b
purePP = b -> Aggregator a b
forall a. a -> Aggregator a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  **** :: forall a a b.
Aggregator a (a -> b) -> Aggregator a a -> Aggregator a b
(****) = Aggregator a (b -> c) -> Aggregator a b -> Aggregator a c
forall 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 Aggregate PrimExpr a b
x1 +++! :: forall a b a' b'.
Aggregator a b
-> Aggregator a' b' -> Aggregator (Either a a') (Either b b')
+++! Aggregator PackMap Aggregate PrimExpr a' b'
x2 = PackMap Aggregate PrimExpr (Either a a') (Either b b')
-> Aggregator (Either a a') (Either b b')
forall a b. PackMap Aggregate PrimExpr a b -> Aggregator a b
Aggregator (PackMap Aggregate PrimExpr a b
x1 PackMap Aggregate PrimExpr a b
-> PackMap Aggregate PrimExpr a' b'
-> PackMap Aggregate PrimExpr (Either a a') (Either b b')
forall a b a' b'.
PackMap Aggregate PrimExpr a b
-> PackMap Aggregate PrimExpr a' b'
-> PackMap Aggregate PrimExpr (Either a a') (Either b b')
forall (p :: * -> * -> *) a b a' b'.
SumProfunctor p =>
p a b -> p a' b' -> p (Either a a') (Either b b')
PP.+++! PackMap Aggregate PrimExpr a' b'
x2)

-- }