{-# language FlexibleContexts #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language ViewPatterns #-}

module Rel8.Aggregate.Legacy
  ( Aggregates
  , aggregate
  , aggregateTabulation
  , groupBy
  , listAgg
  , nonEmptyAgg
  )
where

-- base
import Data.Functor.Identity ( Identity( Identity ) )
import Prelude

-- opaleye
import qualified Opaleye.Aggregate as Opaleye

-- rel8
import Rel8.Aggregate ( Aggregates, Col(..) )
import Rel8.Expr ( Col(..) )
import Rel8.Expr.Aggregate ( groupByExpr, listAggExpr, nonEmptyAggExpr )
import Rel8.Query ( Query )
import Rel8.Query.Opaleye ( mapOpaleye )
import Rel8.Schema.Dict ( Dict( Dict ) )
import Rel8.Schema.HTable ( htabulate, hfield )
import Rel8.Schema.HTable.Vectorize ( hvectorize )
import Rel8.Table ( toColumns, fromColumns )
import Rel8.Table.Eq ( EqTable, eqTable )
import Rel8.Table.List ( ListTable )
import Rel8.Table.NonEmpty ( NonEmptyTable )
import Rel8.Table.Opaleye ( aggregator )
import Rel8.Tabulate ( Tabulation )
import qualified Rel8.Tabulate


-- | Apply an aggregation to all rows returned by a 'Query'.
aggregate :: Aggregates aggregates exprs => Query aggregates -> Query exprs
aggregate :: forall aggregates exprs.
Aggregates aggregates exprs =>
Query aggregates -> Query exprs
aggregate = (Select (Aggregate exprs) -> Select exprs)
-> Query (Aggregate exprs) -> Query exprs
forall a b. (Select a -> Select b) -> Query a -> Query b
mapOpaleye (Aggregator (Aggregate exprs) exprs
-> Select (Aggregate exprs) -> Select exprs
forall a b. Aggregator a b -> Select a -> Select b
Opaleye.aggregate Aggregator (Aggregate exprs) exprs
forall exprs. Aggregator (Aggregate exprs) exprs
aggregator) (Query (Aggregate exprs) -> Query exprs)
-> (Query aggregates -> Query (Aggregate exprs))
-> Query aggregates
-> Query exprs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (aggregates -> Aggregate exprs)
-> Query aggregates -> Query (Aggregate exprs)
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap (Columns exprs (Col Aggregate) -> Aggregate exprs
forall (context :: Context) a.
Table context a =>
Columns a (Col (Context a)) -> a
fromColumns (Columns exprs (Col Aggregate) -> Aggregate exprs)
-> (aggregates -> Columns exprs (Col Aggregate))
-> aggregates
-> Aggregate exprs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. aggregates -> Columns exprs (Col Aggregate)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col (Context a))
toColumns)


aggregateTabulation
  :: (EqTable k, Aggregates aggregates exprs)
  => (t -> aggregates) -> Tabulation k t -> Tabulation k exprs
aggregateTabulation :: forall k aggregates exprs t.
(EqTable k, Aggregates aggregates exprs) =>
(t -> aggregates) -> Tabulation k t -> Tabulation k exprs
aggregateTabulation t -> aggregates
f =
  Tabulation k (Aggregate exprs) -> Tabulation k exprs
forall k a.
EqTable k =>
Tabulation k (Aggregate a) -> Tabulation k a
Rel8.Tabulate.aggregateTabulation (Tabulation k (Aggregate exprs) -> Tabulation k exprs)
-> (Tabulation k t -> Tabulation k (Aggregate exprs))
-> Tabulation k t
-> Tabulation k exprs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> Aggregate exprs)
-> Tabulation k t -> Tabulation k (Aggregate exprs)
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap (Columns exprs (Col Aggregate) -> Aggregate exprs
forall (context :: Context) a.
Table context a =>
Columns a (Col (Context a)) -> a
fromColumns (Columns exprs (Col Aggregate) -> Aggregate exprs)
-> (t -> Columns exprs (Col Aggregate)) -> t -> Aggregate exprs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. aggregates -> Columns exprs (Col Aggregate)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col (Context a))
toColumns (aggregates -> Columns exprs (Col Aggregate))
-> (t -> aggregates) -> t -> Columns exprs (Col Aggregate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> aggregates
f)


-- | Group equal tables together. This works by aggregating each column in the
-- given table with 'groupByExpr'.
groupBy :: forall exprs aggregates. (EqTable exprs, Aggregates aggregates exprs)
  => exprs -> aggregates
groupBy :: forall exprs aggregates.
(EqTable exprs, Aggregates aggregates exprs) =>
exprs -> aggregates
groupBy (exprs -> Columns exprs (Col (Context exprs))
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col (Context a))
toColumns -> Columns exprs (Col (Context exprs))
exprs) = Columns aggregates (Col (Context aggregates)) -> aggregates
forall (context :: Context) a.
Table context a =>
Columns a (Col (Context a)) -> a
fromColumns (Columns aggregates (Col (Context aggregates)) -> aggregates)
-> Columns aggregates (Col (Context aggregates)) -> aggregates
forall a b. (a -> b) -> a -> b
$ (forall (spec :: Spec).
 HField (Columns exprs) spec -> Col Aggregate spec)
-> Columns exprs (Col Aggregate)
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (spec :: Spec). HField t spec -> context spec) -> t context
htabulate ((forall (spec :: Spec).
  HField (Columns exprs) spec -> Col Aggregate spec)
 -> Columns exprs (Col Aggregate))
-> (forall (spec :: Spec).
    HField (Columns exprs) spec -> Col Aggregate spec)
-> Columns exprs (Col Aggregate)
forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) spec
field ->
  case Columns exprs (Dict (ConstrainDBType DBEq))
-> HField (Columns exprs) spec -> Dict (ConstrainDBType DBEq) spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield (forall a. EqTable a => Columns a (Dict (ConstrainDBType DBEq))
eqTable @exprs) HField (Columns exprs) spec
field of
    Dict (ConstrainDBType DBEq) spec
Dict -> case Columns exprs (Col Expr)
-> HField (Columns exprs) spec -> Col Expr spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield Columns exprs (Col Expr)
Columns exprs (Col (Context exprs))
exprs HField (Columns exprs) spec
field of
      DB Expr a
expr -> Aggregate (Expr a) -> Col Aggregate ('Spec labels necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Aggregate (Expr a) -> Col Aggregate ('Spec labels necessity a)
Aggregation (Aggregate (Expr a) -> Col Aggregate ('Spec labels necessity a))
-> Aggregate (Expr a) -> Col Aggregate ('Spec labels necessity a)
forall a b. (a -> b) -> a -> b
$ Expr a -> Aggregate (Expr a)
forall a. Sql DBEq a => Expr a -> Aggregate (Expr a)
groupByExpr Expr a
expr


-- | Aggregate rows into a single row containing an array of all aggregated
-- rows. This can be used to associate multiple rows with a single row, without
-- changing the over cardinality of the query. This allows you to essentially
-- return a tree-like structure from queries.
--
-- For example, if we have a table of orders and each orders contains multiple
-- items, we could aggregate the table of orders, pairing each order with its
-- items:
--
-- @
-- ordersWithItems :: Query (Order Expr, ListTable (Item Expr))
-- ordersWithItems = do
--   order <- each orderSchema
--   items <- aggregate $ listAgg <$> itemsFromOrder order
--   return (order, items)
-- @
listAgg :: Aggregates aggregates exprs => exprs -> ListTable aggregates
listAgg :: forall aggregates exprs.
Aggregates aggregates exprs =>
exprs -> ListTable aggregates
listAgg (exprs -> Columns exprs (Col (Context exprs))
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col (Context a))
toColumns -> Columns exprs (Col (Context exprs))
exprs) = Columns
  (ListTable aggregates) (Col (Context (ListTable aggregates)))
-> ListTable aggregates
forall (context :: Context) a.
Table context a =>
Columns a (Col (Context a)) -> a
fromColumns (Columns
   (ListTable aggregates) (Col (Context (ListTable aggregates)))
 -> ListTable aggregates)
-> Columns
     (ListTable aggregates) (Col (Context (ListTable aggregates)))
-> ListTable aggregates
forall a b. (a -> b) -> a -> b
$
  (forall (labels :: Labels) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> Identity (Col Expr ('Spec labels necessity a))
 -> Col Aggregate ('Spec labels necessity [a]))
-> Identity (Columns exprs (Col Expr))
-> HVectorize [] (Columns exprs) (Col Aggregate)
forall (t :: HTable) (f :: Context) (list :: Context)
       (context :: HContext) (context' :: HContext).
(HTable t, Unzip f, Vector list) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> f (context ('Spec labels necessity a))
 -> context' ('Spec labels necessity (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize
    (\SSpec ('Spec labels necessity a)
_ (Identity (DB Expr a
a)) -> Aggregate (Expr [a]) -> Col Aggregate ('Spec labels necessity [a])
forall a (labels :: Labels) (necessity :: Necessity).
Aggregate (Expr a) -> Col Aggregate ('Spec labels necessity a)
Aggregation (Aggregate (Expr [a])
 -> Col Aggregate ('Spec labels necessity [a]))
-> Aggregate (Expr [a])
-> Col Aggregate ('Spec labels necessity [a])
forall a b. (a -> b) -> a -> b
$ Expr a -> Aggregate (Expr [a])
forall a. Expr a -> Aggregate (Expr [a])
listAggExpr Expr a
a)
    (Columns exprs (Col Expr) -> Identity (Columns exprs (Col Expr))
forall (f :: Context) a. Applicative f => a -> f a
pure Columns exprs (Col Expr)
Columns exprs (Col (Context exprs))
exprs)


-- | Like 'listAgg', but the result is guaranteed to be a non-empty list.
nonEmptyAgg :: Aggregates aggregates exprs => exprs -> NonEmptyTable aggregates
nonEmptyAgg :: forall aggregates exprs.
Aggregates aggregates exprs =>
exprs -> NonEmptyTable aggregates
nonEmptyAgg (exprs -> Columns exprs (Col (Context exprs))
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col (Context a))
toColumns -> Columns exprs (Col (Context exprs))
exprs) = Columns
  (NonEmptyTable aggregates)
  (Col (Context (NonEmptyTable aggregates)))
-> NonEmptyTable aggregates
forall (context :: Context) a.
Table context a =>
Columns a (Col (Context a)) -> a
fromColumns (Columns
   (NonEmptyTable aggregates)
   (Col (Context (NonEmptyTable aggregates)))
 -> NonEmptyTable aggregates)
-> Columns
     (NonEmptyTable aggregates)
     (Col (Context (NonEmptyTable aggregates)))
-> NonEmptyTable aggregates
forall a b. (a -> b) -> a -> b
$
  (forall (labels :: Labels) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> Identity (Col Expr ('Spec labels necessity a))
 -> Col Aggregate ('Spec labels necessity (NonEmpty a)))
-> Identity (Columns exprs (Col Expr))
-> HVectorize NonEmpty (Columns exprs) (Col Aggregate)
forall (t :: HTable) (f :: Context) (list :: Context)
       (context :: HContext) (context' :: HContext).
(HTable t, Unzip f, Vector list) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> f (context ('Spec labels necessity a))
 -> context' ('Spec labels necessity (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize
    (\SSpec ('Spec labels necessity a)
_ (Identity (DB Expr a
a)) -> Aggregate (Expr (NonEmpty a))
-> Col Aggregate ('Spec labels necessity (NonEmpty a))
forall a (labels :: Labels) (necessity :: Necessity).
Aggregate (Expr a) -> Col Aggregate ('Spec labels necessity a)
Aggregation (Aggregate (Expr (NonEmpty a))
 -> Col Aggregate ('Spec labels necessity (NonEmpty a)))
-> Aggregate (Expr (NonEmpty a))
-> Col Aggregate ('Spec labels necessity (NonEmpty a))
forall a b. (a -> b) -> a -> b
$ Expr a -> Aggregate (Expr (NonEmpty a))
forall a. Expr a -> Aggregate (Expr (NonEmpty a))
nonEmptyAggExpr Expr a
a)
    (Columns exprs (Col Expr) -> Identity (Columns exprs (Col Expr))
forall (f :: Context) a. Applicative f => a -> f a
pure Columns exprs (Col Expr)
Columns exprs (Col (Context exprs))
exprs)