From 149ec23c6f32ff677940ca39d6598cfc3a9593bb Mon Sep 17 00:00:00 2001 From: Shane Date: Mon, 15 Jul 2024 11:54:22 +0100 Subject: [PATCH] Add `aggregate{Just,Left,Right,This,That,Those,Here,There}Table{,1}` aggregators (#333) These provide another way to do aggregation of `MaybeTable`, `EitherTable` and `TheseTable`s than the existing `aggregate{Maybe,Either,These}Table`. --- ..._022306_shane.obrien_aggregateJustTable.md | 5 + rel8.cabal | 1 + src/Rel8.hs | 9 ++ src/Rel8/Table/Aggregate.hs | 32 +---- src/Rel8/Table/Aggregate/Maybe.hs | 89 ++++++++++++ src/Rel8/Table/Either.hs | 56 +++++++- src/Rel8/Table/Maybe.hs | 24 +--- src/Rel8/Table/Nullify.hs | 11 +- src/Rel8/Table/These.hs | 130 +++++++++++++++++- 9 files changed, 302 insertions(+), 55 deletions(-) create mode 100644 changelog.d/20240527_022306_shane.obrien_aggregateJustTable.md create mode 100644 src/Rel8/Table/Aggregate/Maybe.hs diff --git a/changelog.d/20240527_022306_shane.obrien_aggregateJustTable.md b/changelog.d/20240527_022306_shane.obrien_aggregateJustTable.md new file mode 100644 index 00000000..2a10e12b --- /dev/null +++ b/changelog.d/20240527_022306_shane.obrien_aggregateJustTable.md @@ -0,0 +1,5 @@ +### Added + +- Add `aggregateJustTable`, `aggregateJustTable` aggregator functions. These provide another way to do aggregation of `MaybeTable`s than the existing `aggregateMaybeTable` function. +- Add `aggregateLeftTable`, `aggregateLeftTable1`, `aggregateRightTable` and `aggregateRightTable1` aggregator functions. These provide another way to do aggregation of `EitherTable`s than the existing `aggregateEitherTable` function. +- Add `aggregateThisTable`, `aggregateThisTable1`, `aggregateThatTable`, `aggregateThatTable1`, `aggregateThoseTable`, `aggregateThoseTable1`, `aggregateHereTable`, `aggregateHereTable1`, `aggregateThereTable` and `aggregateThereTable1` aggregation functions. These provide another way to do aggregation of `TheseTable`s than the existing `aggregateTheseTable` function. diff --git a/rel8.cabal b/rel8.cabal index 548dfe2f..39b37893 100644 --- a/rel8.cabal +++ b/rel8.cabal @@ -185,6 +185,7 @@ library Rel8.Table Rel8.Table.ADT Rel8.Table.Aggregate + Rel8.Table.Aggregate.Maybe Rel8.Table.Alternative Rel8.Table.Bool Rel8.Table.Cols diff --git a/src/Rel8.hs b/src/Rel8.hs index 7103047f..0d7f87d0 100644 --- a/src/Rel8.hs +++ b/src/Rel8.hs @@ -66,6 +66,7 @@ module Rel8 , optional , catMaybeTable , traverseMaybeTable + , aggregateJustTable, aggregateJustTable1 , aggregateMaybeTable , nameMaybeTable @@ -76,6 +77,8 @@ module Rel8 , keepLeftTable , keepRightTable , bitraverseEitherTable + , aggregateLeftTable, aggregateLeftTable1 + , aggregateRightTable, aggregateRightTable1 , aggregateEitherTable , nameEitherTable @@ -93,6 +96,11 @@ module Rel8 , keepThatTable, loseThatTable , keepThoseTable, loseThoseTable , bitraverseTheseTable + , aggregateThisTable, aggregateThisTable1 + , aggregateThatTable, aggregateThatTable1 + , aggregateThoseTable, aggregateThoseTable1 + , aggregateHereTable, aggregateHereTable1 + , aggregateThereTable, aggregateThereTable1 , aggregateTheseTable , nameTheseTable @@ -454,6 +462,7 @@ import Rel8.Statement.View import Rel8.Table import Rel8.Table.ADT import Rel8.Table.Aggregate +import Rel8.Table.Aggregate.Maybe import Rel8.Table.Alternative import Rel8.Table.Bool import Rel8.Table.Either diff --git a/src/Rel8/Table/Aggregate.hs b/src/Rel8/Table/Aggregate.hs index 8437d69a..a9bc14af 100644 --- a/src/Rel8/Table/Aggregate.hs +++ b/src/Rel8/Table/Aggregate.hs @@ -9,9 +9,8 @@ module Rel8.Table.Aggregate ( groupBy, groupByOn , listAgg, listAggOn, nonEmptyAgg, nonEmptyAggOn , listCat, listCatOn, nonEmptyCat, nonEmptyCatOn - , filterWhere, filterWhereOptional + , filterWhere , orderAggregateBy - , optionalAggregate ) where @@ -25,11 +24,7 @@ import qualified Opaleye.Internal.Aggregate as Opaleye import Data.Profunctor (dimap, lmap) -- rel8 -import Rel8.Aggregate - ( Aggregator, Aggregator' (Aggregator), Aggregator1 - , toAggregator - ) -import Rel8.Aggregate.Fold (Fallback (Fallback)) +import Rel8.Aggregate (Aggregator, Aggregator' (Aggregator), Aggregator1) import Rel8.Expr ( Expr ) import Rel8.Expr.Aggregate ( filterWhereExplicit @@ -39,7 +34,6 @@ import Rel8.Expr.Aggregate , snonEmptyAggExpr , snonEmptyCatExpr ) -import Rel8.Expr.Opaleye (toColumn, toPrimExpr) import Rel8.Order (Order (Order)) import Rel8.Schema.Dict ( Dict( Dict ) ) import Rel8.Schema.HTable (HTable, hfield, hspecs, htabulateA) @@ -49,7 +43,6 @@ import Rel8.Schema.Spec ( Spec( Spec, info ) ) import Rel8.Table (Table, toColumns, fromColumns) import Rel8.Table.Eq ( EqTable, eqTable ) import Rel8.Table.List ( ListTable ) -import Rel8.Table.Maybe (MaybeTable, makeMaybeTable, justTable, nothingTable) import Rel8.Table.NonEmpty ( NonEmptyTable ) import Rel8.Table.Opaleye (ifPP) import Rel8.Type.Eq ( DBEq ) @@ -91,22 +84,13 @@ hgroupBy eqs = htabulateA $ \field -> case hfield eqs field of -- predicate supplied to 'filterWhere' could return 'Rel8.false' for every -- row, 'filterWhere' needs an 'Aggregator' as opposed to an 'Aggregator1', so -- that it can return a default value in such a case. For a variant of --- 'filterWhere' that can work with 'Aggregator1's, see 'filterWhereOptional'. +-- 'filterWhere' that can work with 'Aggregator1's, see +-- 'Rel8.filterWhereOptional'. filterWhere :: Table Expr a => (i -> Expr Bool) -> Aggregator i a -> Aggregator' fold i a filterWhere = filterWhereExplicit ifPP --- | A variant of 'filterWhere' that can be used with an 'Aggregator1' --- (upgrading it to an 'Aggregator' in the process). It returns --- 'nothingTable' in the case where the predicate matches zero rows. -filterWhereOptional :: Table Expr a - => (i -> Expr Bool) -> Aggregator' fold i a -> Aggregator' fold' i (MaybeTable Expr a) -filterWhereOptional f (Aggregator _ aggregator) = - Aggregator (Fallback nothingTable) $ - Opaleye.filterWhereInternal makeMaybeTable (toColumn . toPrimExpr . f) aggregator - - -- | 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 @@ -184,11 +168,3 @@ nonEmptyCatOn f = lmap f nonEmptyCat orderAggregateBy :: Order i -> Aggregator' fold i a -> Aggregator' fold i a orderAggregateBy (Order order) (Aggregator fallback aggregator) = Aggregator fallback $ Opaleye.orderAggregate order aggregator - - --- | 'optionalAggregate' upgrades an 'Aggregator1' into an 'Aggregator' by --- having it return 'nothingTable' when aggregating over an empty collection --- of rows. -optionalAggregate :: Table Expr a - => Aggregator' fold i a -> Aggregator' fold' i (MaybeTable Expr a) -optionalAggregate = toAggregator nothingTable . fmap justTable diff --git a/src/Rel8/Table/Aggregate/Maybe.hs b/src/Rel8/Table/Aggregate/Maybe.hs new file mode 100644 index 00000000..aa2a2cc6 --- /dev/null +++ b/src/Rel8/Table/Aggregate/Maybe.hs @@ -0,0 +1,89 @@ +{-# language FlexibleContexts #-} + +module Rel8.Table.Aggregate.Maybe + ( filterWhereOptional + , optionalAggregate + , aggregateJustTable + , aggregateJustTable1 + , aggregateMaybeTable + ) +where + +-- base +import Prelude + +-- opaleye +import qualified Opaleye.Internal.Aggregate as Opaleye + +-- profunctors +import Data.Profunctor (lmap) + +-- rel8 +import Rel8.Aggregate + ( Aggregator' (Aggregator) + , Aggregator, toAggregator + , Aggregator1, toAggregator1 + ) +import Rel8.Aggregate.Fold (Fallback (Fallback)) +import Rel8.Expr (Expr) +import Rel8.Expr.Aggregate (groupByExprOn) +import Rel8.Expr.Opaleye (toColumn, toPrimExpr) +import Rel8.Table (Table) +import Rel8.Table.Aggregate (filterWhere) +import Rel8.Table.Maybe + ( MaybeTable (MaybeTable, just, tag), justTable, nothingTable + , isJustTable + , makeMaybeTable + ) +import Rel8.Table.Nullify (aggregateNullify, unsafeUnnullifyTable) + + +-- | A variant of 'filterWhere' that can be used with an 'Aggregator1' +-- (upgrading it to an 'Aggregator' in the process). It returns +-- 'nothingTable' in the case where the predicate matches zero rows. +filterWhereOptional :: Table Expr a + => (i -> Expr Bool) -> Aggregator' fold i a -> Aggregator' fold' i (MaybeTable Expr a) +filterWhereOptional f (Aggregator _ aggregator) = + Aggregator (Fallback nothingTable) $ + Opaleye.filterWhereInternal makeMaybeTable (toColumn . toPrimExpr . f) aggregator + + +-- | 'optionalAggregate' upgrades an 'Aggregator1' into an 'Aggregator' by +-- having it return 'nothingTable' when aggregating over an empty collection +-- of rows. +optionalAggregate :: Table Expr a + => Aggregator' fold i a -> Aggregator' fold' i (MaybeTable Expr a) +optionalAggregate = toAggregator nothingTable . fmap justTable + + +-- | Lift an 'Aggregator' to operate on a 'MaybeTable'. If the input query has +-- @'justTable' i@s, they are folded into a single @a@ by the given aggregator +-- — in the case where the input query is all 'nothingTable's, the +-- 'Aggregator'\'s fallback @a@ is returned. +aggregateJustTable :: Table Expr a + => Aggregator i a + -> Aggregator' fold (MaybeTable Expr i) a +aggregateJustTable = + filterWhere isJustTable . lmap (unsafeUnnullifyTable . just) + + +-- | Lift an 'Aggregator1' to operate on a 'MaybeTable'. If the input query +-- has @'justTable' i@s, they are folded into a single @'justTable' a@ by the +-- given aggregator — in the case where the input query is all +-- 'nothingTable's, a single 'nothingTable' row is returned. +aggregateJustTable1 :: Table Expr a + => Aggregator' fold i a + -> Aggregator' fold' (MaybeTable Expr i) (MaybeTable Expr a) +aggregateJustTable1 = + filterWhereOptional isJustTable . lmap (unsafeUnnullifyTable . just) + + +-- | Lift an aggregator to operate on a 'MaybeTable'. @nothingTable@s and +-- @justTable@s are grouped separately. +aggregateMaybeTable :: () + => Aggregator' fold i a + -> Aggregator1 (MaybeTable Expr i) (MaybeTable Expr a) +aggregateMaybeTable aggregator = + MaybeTable + <$> groupByExprOn tag + <*> lmap just (toAggregator1 (aggregateNullify aggregator)) diff --git a/src/Rel8/Table/Either.hs b/src/Rel8/Table/Either.hs index 3e5c24c2..88f8476f 100644 --- a/src/Rel8/Table/Either.hs +++ b/src/Rel8/Table/Either.hs @@ -1,3 +1,4 @@ +{-# language ApplicativeDo #-} {-# language DataKinds #-} {-# language DeriveFunctor #-} {-# language DerivingStrategies #-} @@ -19,6 +20,8 @@ module Rel8.Table.Either ( EitherTable(..) , eitherTable, leftTable, rightTable , isLeftTable, isRightTable + , aggregateLeftTable, aggregateLeftTable1 + , aggregateRightTable, aggregateRightTable1 , aggregateEitherTable , nameEitherTable ) @@ -37,7 +40,7 @@ import Control.Comonad ( extract ) import Data.Profunctor (lmap) -- rel8 -import Rel8.Aggregate (Aggregator', Aggregator1, toAggregator1) +import Rel8.Aggregate (Aggregator, Aggregator', Aggregator1, toAggregator1) import Rel8.Expr ( Expr ) import Rel8.Expr.Aggregate (groupByExprOn) import Rel8.Expr.Serialize ( litExpr ) @@ -54,9 +57,14 @@ import Rel8.Table , FromExprs, fromResult, toResult , Transpose ) +import Rel8.Table.Aggregate (filterWhere) +import Rel8.Table.Aggregate.Maybe (filterWhereOptional) import Rel8.Table.Bool ( bool ) import Rel8.Table.Eq ( EqTable, eqTable ) -import Rel8.Table.Nullify ( Nullify, aggregateNullify, guard ) +import Rel8.Table.Maybe (MaybeTable) +import Rel8.Table.Nullify + ( Nullify, aggregateNullify, guard, unsafeUnnullifyTable + ) import Rel8.Table.Ord ( OrdTable, ordTable ) import Rel8.Table.Projection ( Biprojectable, Projectable, biproject, project ) import Rel8.Table.Serialize ( ToExprs ) @@ -218,6 +226,50 @@ rightTable :: Table Expr a => b -> EitherTable Expr a b rightTable = EitherTable (litExpr IsRight) undefined . pure +-- | Lift an 'Aggregator' to operate on an 'EitherTable'. If the input query has +-- @'leftTable' a@s, they are folded into a single @c@ by the given aggregator +-- — in the case where the input query is all 'rightTable's, the +-- 'Aggregator'\'s fallback @c@ is returned. +aggregateLeftTable :: Table Expr c + => Aggregator a c + -> Aggregator' fold (EitherTable Expr a b) c +aggregateLeftTable = + filterWhere isLeftTable . lmap (unsafeUnnullifyTable . left) + + +-- | Lift an 'Aggregator1' to operate on an 'EitherTable'. If the input query +-- has @'leftTable' a@s, they are folded into a single @'Rel8.justTable' c@ +-- by the given aggregator — in the case where the input query is all +-- 'rightTable's, a single 'nothingTable' row is returned. +aggregateLeftTable1 :: Table Expr c + => Aggregator' fold a c + -> Aggregator' fold' (EitherTable Expr a b) (MaybeTable Expr c) +aggregateLeftTable1 = + filterWhereOptional isLeftTable . lmap (unsafeUnnullifyTable . left) + + +-- | Lift an 'Aggregator' to operate on an 'EitherTable'. If the input query has +-- @'rightTable' b@s, they are folded into a single @c@ by the given aggregator +-- — in the case where the input query is all 'rightTable's, the +-- 'Aggregator'\'s fallback @c@ is returned. +aggregateRightTable :: Table Expr c + => Aggregator b c + -> Aggregator' fold (EitherTable Expr a b) c +aggregateRightTable = + filterWhere isRightTable . lmap (unsafeUnnullifyTable . right) + + +-- | Lift an 'Aggregator1' to operate on an 'EitherTable'. If the input query +-- has @'rightTable' b@s, they are folded into a single @'Rel8.justTable' c@ +-- by the given aggregator — in the case where the input query is all +-- 'leftTable's, a single 'nothingTable' row is returned. +aggregateRightTable1 :: Table Expr c + => Aggregator' fold a c + -> Aggregator' fold' (EitherTable Expr a b) (MaybeTable Expr c) +aggregateRightTable1 = + filterWhereOptional isLeftTable . lmap (unsafeUnnullifyTable . left) + + -- | Lift a pair aggregators to operate on an 'EitherTable'. @leftTable@s and -- @rightTable@s are grouped separately. aggregateEitherTable :: () diff --git a/src/Rel8/Table/Maybe.hs b/src/Rel8/Table/Maybe.hs index 90f6e862..2b344289 100644 --- a/src/Rel8/Table/Maybe.hs +++ b/src/Rel8/Table/Maybe.hs @@ -18,9 +18,9 @@ module Rel8.Table.Maybe , isNothingTable, isJustTable , fromMaybeTable , ($?) - , aggregateMaybeTable , nameMaybeTable , makeMaybeTable + , unsafeFromJustTable ) where @@ -38,13 +38,8 @@ import Control.Comonad ( extract ) import qualified Opaleye.Field as Opaleye import qualified Opaleye.SqlTypes as Opaleye --- profunctors -import Data.Profunctor (lmap) - -- rel8 -import Rel8.Aggregate (Aggregator', Aggregator1, toAggregator1) import Rel8.Expr ( Expr ) -import Rel8.Expr.Aggregate (groupByExprOn) import Rel8.Expr.Bool ( boolExpr ) import Rel8.Expr.Null ( isNull, isNonNull, null, nullify ) import Rel8.Expr.Opaleye (fromColumn, fromPrimExpr) @@ -70,7 +65,7 @@ import Rel8.Table.Bool ( bool ) import Rel8.Table.Eq ( EqTable, eqTable ) import Rel8.Table.Ord ( OrdTable, ordTable ) import Rel8.Table.Projection ( Projectable, project ) -import Rel8.Table.Nullify ( Nullify, aggregateNullify, guard ) +import Rel8.Table.Nullify (Nullify, guard, unsafeUnnullifyTable) import Rel8.Table.Serialize ( ToExprs ) import Rel8.Table.Undefined ( undefined ) import Rel8.Type ( DBType ) @@ -222,6 +217,10 @@ fromMaybeTable :: Table Expr a => a -> MaybeTable Expr a -> a fromMaybeTable fallback = maybeTable fallback id +unsafeFromJustTable :: MaybeTable Expr a -> a +unsafeFromJustTable (MaybeTable _ just) = unsafeUnnullifyTable just + + -- | Project a single expression out of a 'MaybeTable'. You can think of this -- operator like the '$' operator, but it also has the ability to return -- @null@. @@ -233,17 +232,6 @@ f $? ma@(MaybeTable _ a) = case nullable @b of infixl 4 $? --- | Lift an aggregator to operate on a 'MaybeTable'. @nothingTable@s and --- @justTable@s are grouped separately. -aggregateMaybeTable :: () - => Aggregator' fold i a - -> Aggregator1 (MaybeTable Expr i) (MaybeTable Expr a) -aggregateMaybeTable aggregator = - MaybeTable - <$> groupByExprOn tag - <*> lmap just (toAggregator1 (aggregateNullify aggregator)) - - -- | Construct a 'MaybeTable' in the 'Name' context. This can be useful if you -- have a 'MaybeTable' that you are storing in a table and need to construct a -- 'TableSchema'. diff --git a/src/Rel8/Table/Nullify.hs b/src/Rel8/Table/Nullify.hs index c86738d1..799bec0d 100644 --- a/src/Rel8/Table/Nullify.hs +++ b/src/Rel8/Table/Nullify.hs @@ -16,6 +16,7 @@ module Rel8.Table.Nullify , aggregateNullify , guard , isNull + , unsafeUnnullifyTable ) where @@ -182,9 +183,7 @@ aggregateNullify :: () -> Aggregator' fold (Nullify Expr i) (Nullify Expr a) aggregateNullify = dimap from to where - from = \case - Table _ a -> a - Fields notNullifiable _ -> absurd NExpr notNullifiable + from = unsafeUnnullifyTable to = Table NExpr @@ -208,6 +207,12 @@ isNull = toColumns +unsafeUnnullifyTable :: Nullify Expr a -> a +unsafeUnnullifyTable = \case + Table _ a -> a + Fields notNullifiable _ -> absurd NExpr notNullifiable + + newtype Any = Any { getAny :: Expr Bool } diff --git a/src/Rel8/Table/These.hs b/src/Rel8/Table/These.hs index 4c2bd2bd..9809f2b8 100644 --- a/src/Rel8/Table/These.hs +++ b/src/Rel8/Table/These.hs @@ -22,12 +22,18 @@ module Rel8.Table.These , hasHereTable, hasThereTable , justHereTable, justThereTable , alignMaybeTable + , aggregateThisTable, aggregateThisTable1 + , aggregateThatTable, aggregateThatTable1 + , aggregateThoseTable, aggregateThoseTable1 + , aggregateHereTable, aggregateHereTable1 + , aggregateThereTable, aggregateThereTable1 , aggregateTheseTable , nameTheseTable ) where -- base +import Control.Arrow ((&&&)) import Data.Bifunctor ( Bifunctor, bimap ) import Data.Kind ( Type ) import Data.Maybe ( isJust ) @@ -37,7 +43,7 @@ import Prelude hiding ( null, undefined ) import Data.Profunctor (lmap) -- rel8 -import Rel8.Aggregate (Aggregator', Aggregator1) +import Rel8.Aggregate (Aggregator, Aggregator', Aggregator1) import Rel8.Expr ( Expr ) import Rel8.Expr.Bool ( (&&.), (||.), boolExpr, not_ ) import Rel8.Expr.Null ( null, isNonNull ) @@ -55,13 +61,19 @@ import Rel8.Table , FromExprs, fromResult, toResult , Transpose ) +import Rel8.Table.Aggregate (filterWhere) +import Rel8.Table.Aggregate.Maybe + ( aggregateJustTable, aggregateJustTable1 + , aggregateMaybeTable + , filterWhereOptional + ) import Rel8.Table.Eq ( EqTable, eqTable ) import Rel8.Table.Maybe ( MaybeTable(..) , maybeTable, justTable, nothingTable , isJustTable - , aggregateMaybeTable , nameMaybeTable + , unsafeFromJustTable ) import Rel8.Table.Nullify ( Nullify, guard ) import Rel8.Table.Ord ( OrdTable, ordTable ) @@ -328,8 +340,118 @@ theseTable f g h TheseTable {here, there} = there --- | Lift a pair aggregators to operate on a 'TheseTable'. @thisTable@s, --- @thatTable@s are @thoseTable@s are grouped separately. +-- | Lift an 'Aggregator' to operate on a 'TheseTable'. If the input query has +-- @'thisTable' a@s, they are folded into a single @c@ by the given aggregator +-- — in the case where the input query is all 'thatTable's or 'thoseTable's, +-- the 'Aggregator'\'s fallback @c@ is returned. +aggregateThisTable :: Table Expr c + => Aggregator a c + -> Aggregator' fold (TheseTable Expr a b) c +aggregateThisTable = + filterWhere isThisTable . lmap (unsafeFromJustTable . here) + + +-- | Lift an 'Aggregator1' to operate on a 'TheseTable'. If the input query +-- has @'thisTable' a@s, they are folded into a single @'Rel8.justTable' c@ +-- by the given aggregator — in the case where the input query is all +-- 'thatTable's or 'thoseTable's, a single 'nothingTable' row is returned. +aggregateThisTable1 :: Table Expr c + => Aggregator' fold a c + -> Aggregator' fold' (TheseTable Expr a b) (MaybeTable Expr c) +aggregateThisTable1 = + filterWhereOptional isThisTable . lmap (unsafeFromJustTable . here) + + +-- | Lift an 'Aggregator' to operate on a 'TheseTable'. If the input query has +-- @'thatTable' b@s, they are folded into a single @c@ by the given aggregator +-- — in the case where the input query is all 'thisTable's or 'thoseTable's, +-- the 'Aggregator'\'s fallback @c@ is returned. +aggregateThatTable :: Table Expr c + => Aggregator b c + -> Aggregator' fold (TheseTable Expr a b) c +aggregateThatTable = + filterWhere isThatTable . lmap (unsafeFromJustTable . there) + + +-- | Lift an 'Aggregator1' to operate on a 'TheseTable'. If the input query +-- has @'thatTable' b@s, they are folded into a single @'Rel8.justTable' c@ +-- by the given aggregator — in the case where the input query is all +-- 'thisTable's or 'thoseTable's, a single 'nothingTable' row is returned. +aggregateThatTable1 :: Table Expr c + => Aggregator' fold b c + -> Aggregator' fold' (TheseTable Expr a b) (MaybeTable Expr c) +aggregateThatTable1 = + filterWhereOptional isThatTable . lmap (unsafeFromJustTable . there) + + +-- | Lift an 'Aggregator' to operate on a 'ThoseTable'. If the input query has +-- @'thoseTable' a b@s, they are folded into a single @c@ by the given +-- aggregator — in the case where the input query is all 'thisTable's or +-- 'thatTable's, the 'Aggregator'\'s fallback @c@ is returned. +aggregateThoseTable :: Table Expr c + => Aggregator (a, b) c + -> Aggregator' fold (TheseTable Expr a b) c +aggregateThoseTable = + filterWhere isThoseTable + . lmap (unsafeFromJustTable . here &&& unsafeFromJustTable . there) + + +-- | Lift an 'Aggregator1' to operate on a 'TheseTable'. If the input query +-- has @'thoseTable' a b@s, they are folded into a single @'Rel8.justTable' c@ +-- by the given aggregator — in the case where the input query is all +-- 'thisTable's or 'thatTable's, a single 'nothingTable' row is returned. +aggregateThoseTable1 :: Table Expr c + => Aggregator' fold (a, b) c + -> Aggregator' fold' (TheseTable Expr a b) (MaybeTable Expr c) +aggregateThoseTable1 = + filterWhereOptional isThoseTable + . lmap (unsafeFromJustTable . here &&& unsafeFromJustTable . there) + + +-- | Lift an 'Aggregator' to operate on a 'TheseTable'. If the input query has +-- @'thisTable' a@s or @'thoseTable' a _@s, the @a@s are folded into a single +-- @c@ by the given aggregator — in the case where the input query is all +-- 'thatTable's, the 'Aggregator'\'s fallback @c@ is returned. +aggregateHereTable :: Table Expr c + => Aggregator a c + -> Aggregator' fold (TheseTable Expr a b) c +aggregateHereTable = lmap here . aggregateJustTable + + +-- | Lift an 'Aggregator1' to operate on an 'TheseTable'. If the input query +-- has @'thisTable' a@s or @'thoseTable' a _@s, the @a@s are folded into a +-- single @'Rel8.justTable' c@ by the given aggregator — in the case where +-- the input query is all 'thatTable's, a single 'nothingTable' row is +-- returned. +aggregateHereTable1 :: Table Expr c + => Aggregator' fold a c + -> Aggregator' fold' (TheseTable Expr a b) (MaybeTable Expr c) +aggregateHereTable1 = lmap here . aggregateJustTable1 + + +-- | Lift an 'Aggregator' to operate on a 'TheseTable'. If the input query has +-- @'thatTable' b@s or @'thoseTable' _ b@s, the @b@s are folded into a single +-- @c@ by the given aggregator — in the case where the input query is all +-- 'thisTable's, the 'Aggregator'\'s fallback @c@ is returned. +aggregateThereTable :: Table Expr c + => Aggregator b c + -> Aggregator' fold (TheseTable Expr a b) c +aggregateThereTable = lmap there . aggregateJustTable + + +-- | Lift an 'Aggregator1' to operate on an 'TheseTable'. If the input query +-- has @'thatTable' b@s or @'thoseTable' _ b@s, the @b@s are folded into a +-- single @'Rel8.justTable' c@ by the given aggregator — in the case where +-- the input query is all 'thisTable's, a single 'nothingTable' row is +-- returned. +aggregateThereTable1 :: Table Expr c + => Aggregator' fold b c + -> Aggregator' fold' (TheseTable Expr a b) (MaybeTable Expr c) +aggregateThereTable1 = lmap there . aggregateJustTable1 + + +-- | Lift a pair aggregators to operate on a 'TheseTable'. 'thisTable's, +-- 'thatTable's are 'thoseTable's are grouped separately. aggregateTheseTable :: () => Aggregator' fold i a -> Aggregator' fold' i' b