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

module Rel8.Table.Aggregate
  ( groupBy, hgroupBy
  , listAgg, nonEmptyAgg
  )
where

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

-- rel8
import Rel8.Aggregate ( Aggregate, Aggregates, Col( A ) )
import Rel8.Expr ( Expr, Col( E ) )
import Rel8.Expr.Aggregate
  ( groupByExpr
  , slistAggExpr
  , snonEmptyAggExpr
  )
import Rel8.Schema.Dict ( Dict( Dict ) )
import Rel8.Schema.HTable ( HTable, hfield, htabulate )
import Rel8.Schema.HTable.Vectorize ( hvectorize )
import Rel8.Schema.Spec ( SSpec( SSpec, info ) )
import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
import Rel8.Table ( toColumns, fromColumns )
import Rel8.Table.Eq ( EqTable, eqTable )
import Rel8.Table.List ( ListTable )
import Rel8.Table.NonEmpty ( NonEmptyTable )
import Rel8.Type.Eq ( DBEq )


-- | 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 :: exprs -> aggregates
groupBy = Columns exprs (Col Aggregate) -> aggregates
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (Columns exprs (Col Aggregate) -> aggregates)
-> (exprs -> Columns exprs (Col Aggregate)) -> exprs -> aggregates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Columns exprs (Dict (ConstrainDBType DBEq))
-> Columns exprs (Col Expr) -> Columns exprs (Col Aggregate)
forall (t :: HTable).
HTable t =>
t (Dict (ConstrainDBType DBEq))
-> t (Col Expr) -> t (Col Aggregate)
hgroupBy (EqTable exprs => Columns exprs (Dict (ConstrainDBType DBEq))
forall a. EqTable a => Columns a (Dict (ConstrainDBType DBEq))
eqTable @exprs) (Columns exprs (Col Expr) -> Columns exprs (Col Aggregate))
-> (exprs -> Columns exprs (Col Expr))
-> exprs
-> Columns exprs (Col Aggregate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. exprs -> Columns exprs (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns


hgroupBy :: HTable t
  => t (Dict (ConstrainDBType DBEq)) -> t (Col Expr) -> t (Col Aggregate)
hgroupBy :: t (Dict (ConstrainDBType DBEq))
-> t (Col Expr) -> t (Col Aggregate)
hgroupBy t (Dict (ConstrainDBType DBEq))
eqs t (Col Expr)
exprs = Columns (t (Col Aggregate)) (Col Aggregate) -> t (Col Aggregate)
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (Columns (t (Col Aggregate)) (Col Aggregate) -> t (Col Aggregate))
-> Columns (t (Col Aggregate)) (Col Aggregate) -> t (Col Aggregate)
forall a b. (a -> b) -> a -> b
$ (forall (spec :: Spec). HField t spec -> Col Aggregate spec)
-> t (Col Aggregate)
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (spec :: Spec). HField t spec -> context spec) -> t context
htabulate ((forall (spec :: Spec). HField t spec -> Col Aggregate spec)
 -> t (Col Aggregate))
-> (forall (spec :: Spec). HField t spec -> Col Aggregate spec)
-> t (Col Aggregate)
forall a b. (a -> b) -> a -> b
$ \HField t spec
field ->
  case t (Dict (ConstrainDBType DBEq))
-> HField t spec -> Dict (ConstrainDBType DBEq) spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield t (Dict (ConstrainDBType DBEq))
eqs HField t spec
field of
    Dict (ConstrainDBType DBEq) spec
Dict -> case t (Col Expr) -> HField t spec -> Col Expr spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield t (Col Expr)
exprs HField t spec
field of
      E expr -> Aggregate a -> Col Aggregate ('Spec labels a)
forall a (labels :: Labels).
Aggregate a -> Col Aggregate ('Spec labels a)
A (Aggregate a -> Col Aggregate ('Spec labels a))
-> Aggregate a -> Col Aggregate ('Spec labels a)
forall a b. (a -> b) -> a -> b
$ Expr a -> Aggregate a
forall a. Sql DBEq a => Expr a -> Aggregate 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 :: exprs -> ListTable aggregates
listAgg (exprs -> Columns exprs (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns -> Columns exprs (Col Expr)
exprs) = Columns (ListTable aggregates) (Col Aggregate)
-> ListTable aggregates
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (Columns (ListTable aggregates) (Col Aggregate)
 -> ListTable aggregates)
-> Columns (ListTable aggregates) (Col Aggregate)
-> ListTable aggregates
forall a b. (a -> b) -> a -> b
$
  (forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> Identity (Col Expr ('Spec labels a))
 -> Col Aggregate ('Spec labels [a]))
-> Identity (Columns exprs (Col Expr))
-> HVectorize [] (Columns exprs) (Col Aggregate)
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
       (context :: HContext) (context' :: HContext).
(HTable t, Unzip f, Vector list) =>
(forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> f (context ('Spec labels a))
 -> context' ('Spec labels (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize
    (\SSpec {TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info :: forall (labels :: Labels) a.
SSpec ('Spec labels a) -> TypeInformation (Unnullify a)
info} (Identity (E a)) -> Aggregate [a] -> Col Aggregate ('Spec labels [a])
forall a (labels :: Labels).
Aggregate a -> Col Aggregate ('Spec labels a)
A (Aggregate [a] -> Col Aggregate ('Spec labels [a]))
-> Aggregate [a] -> Col Aggregate ('Spec labels [a])
forall a b. (a -> b) -> a -> b
$ TypeInformation (Unnullify a) -> Expr a -> Aggregate [a]
forall a. TypeInformation (Unnullify a) -> Expr a -> Aggregate [a]
slistAggExpr TypeInformation (Unnullify a)
TypeInformation (Unnullify a)
info Expr a
a)
    (Columns exprs (Col Expr) -> Identity (Columns exprs (Col Expr))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Columns exprs (Col Expr)
exprs)


-- | Like 'listAgg', but the result is guaranteed to be a non-empty list.
nonEmptyAgg :: Aggregates aggregates exprs => exprs -> NonEmptyTable aggregates
nonEmptyAgg :: exprs -> NonEmptyTable aggregates
nonEmptyAgg (exprs -> Columns exprs (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns -> Columns exprs (Col Expr)
exprs) = Columns (NonEmptyTable aggregates) (Col Aggregate)
-> NonEmptyTable aggregates
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (Columns (NonEmptyTable aggregates) (Col Aggregate)
 -> NonEmptyTable aggregates)
-> Columns (NonEmptyTable aggregates) (Col Aggregate)
-> NonEmptyTable aggregates
forall a b. (a -> b) -> a -> b
$
  (forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> Identity (Col Expr ('Spec labels a))
 -> Col Aggregate ('Spec labels (NonEmpty a)))
-> Identity (Columns exprs (Col Expr))
-> HVectorize NonEmpty (Columns exprs) (Col Aggregate)
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
       (context :: HContext) (context' :: HContext).
(HTable t, Unzip f, Vector list) =>
(forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> f (context ('Spec labels a))
 -> context' ('Spec labels (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize
    (\SSpec {TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info :: forall (labels :: Labels) a.
SSpec ('Spec labels a) -> TypeInformation (Unnullify a)
info} (Identity (E a)) -> Aggregate (NonEmpty a) -> Col Aggregate ('Spec labels (NonEmpty a))
forall a (labels :: Labels).
Aggregate a -> Col Aggregate ('Spec labels a)
A (Aggregate (NonEmpty a)
 -> Col Aggregate ('Spec labels (NonEmpty a)))
-> Aggregate (NonEmpty a)
-> Col Aggregate ('Spec labels (NonEmpty a))
forall a b. (a -> b) -> a -> b
$ TypeInformation (Unnullify a) -> Expr a -> Aggregate (NonEmpty a)
forall a.
TypeInformation (Unnullify a) -> Expr a -> Aggregate (NonEmpty a)
snonEmptyAggExpr TypeInformation (Unnullify a)
TypeInformation (Unnullify a)
info Expr a
a)
    (Columns exprs (Col Expr) -> Identity (Columns exprs (Col Expr))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Columns exprs (Col Expr)
exprs)