{-# 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 :: forall a i (fold :: Fold) (fold' :: Fold).
Table Expr a =>
(i -> Expr Bool)
-> Aggregator' fold i a -> Aggregator' fold' i (MaybeTable Expr a)
filterWhereOptional i -> Expr Bool
f (Aggregator Fallback fold a
_ Aggregator i a
aggregator) =
  Fallback fold' (MaybeTable Expr a)
-> Aggregator i (MaybeTable Expr a)
-> Aggregator' fold' i (MaybeTable Expr a)
forall (fold :: Fold) i a.
Fallback fold a -> Aggregator i a -> Aggregator' fold i a
Aggregator (MaybeTable Expr a -> Fallback fold' (MaybeTable Expr a)
forall a (fold :: Fold). a -> Fallback fold a
Fallback MaybeTable Expr a
forall a. Table Expr a => MaybeTable Expr a
nothingTable) (Aggregator i (MaybeTable Expr a)
 -> Aggregator' fold' i (MaybeTable Expr a))
-> Aggregator i (MaybeTable Expr a)
-> Aggregator' fold' i (MaybeTable Expr a)
forall a b. (a -> b) -> a -> b
$
    (FieldNullable SqlBool -> a -> MaybeTable Expr a)
-> (i -> Field SqlBool)
-> Aggregator i a
-> Aggregator i (MaybeTable Expr a)
forall b mb a.
(FieldNullable SqlBool -> b -> mb)
-> (a -> Field SqlBool) -> Aggregator a b -> Aggregator a mb
Opaleye.filterWhereInternal FieldNullable SqlBool -> a -> MaybeTable Expr a
forall a. FieldNullable SqlBool -> a -> MaybeTable Expr a
makeMaybeTable (PrimExpr -> Field SqlBool
forall (n :: Nullability) b. PrimExpr -> Field_ n b
toColumn (PrimExpr -> Field SqlBool)
-> (i -> PrimExpr) -> i -> Field SqlBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Bool -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr (Expr Bool -> PrimExpr) -> (i -> Expr Bool) -> i -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Expr Bool
f) Aggregator i a
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 :: forall a (fold :: Fold) i (fold' :: Fold).
Table Expr a =>
Aggregator' fold i a -> Aggregator' fold' i (MaybeTable Expr a)
optionalAggregate = MaybeTable Expr a
-> Aggregator' fold i (MaybeTable Expr a)
-> Aggregator' fold' i (MaybeTable Expr a)
forall a (fold :: Fold) i (fold' :: Fold).
a -> Aggregator' fold i a -> Aggregator' fold' i a
toAggregator MaybeTable Expr a
forall a. Table Expr a => MaybeTable Expr a
nothingTable (Aggregator' fold i (MaybeTable Expr a)
 -> Aggregator' fold' i (MaybeTable Expr a))
-> (Aggregator' fold i a -> Aggregator' fold i (MaybeTable Expr a))
-> Aggregator' fold i a
-> Aggregator' fold' i (MaybeTable Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> MaybeTable Expr a)
-> Aggregator' fold i a -> Aggregator' fold i (MaybeTable Expr a)
forall a b.
(a -> b) -> Aggregator' fold i a -> Aggregator' fold i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> MaybeTable Expr a
forall a. a -> MaybeTable Expr a
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 :: forall a i (fold :: Fold).
Table Expr a =>
Aggregator i a -> Aggregator' fold (MaybeTable Expr i) a
aggregateJustTable =
  (MaybeTable Expr i -> Expr Bool)
-> Aggregator (MaybeTable Expr i) a
-> Aggregator' fold (MaybeTable Expr i) a
forall a i (fold :: Fold).
Table Expr a =>
(i -> Expr Bool) -> Aggregator i a -> Aggregator' fold i a
filterWhere MaybeTable Expr i -> Expr Bool
forall a. MaybeTable Expr a -> Expr Bool
isJustTable (Aggregator (MaybeTable Expr i) a
 -> Aggregator' fold (MaybeTable Expr i) a)
-> (Aggregator i a -> Aggregator (MaybeTable Expr i) a)
-> Aggregator i a
-> Aggregator' fold (MaybeTable Expr i) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MaybeTable Expr i -> i)
-> Aggregator i a -> Aggregator (MaybeTable Expr i) a
forall a b c.
(a -> b) -> Aggregator' 'Full b c -> Aggregator' 'Full a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Nullify Expr i -> i
forall a. Nullify Expr a -> a
unsafeUnnullifyTable (Nullify Expr i -> i)
-> (MaybeTable Expr i -> Nullify Expr i) -> MaybeTable Expr i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeTable Expr i -> Nullify Expr i
forall (context :: * -> *) a.
MaybeTable context a -> Nullify context a
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 :: forall a (fold :: Fold) i (fold' :: Fold).
Table Expr a =>
Aggregator' fold i a
-> Aggregator' fold' (MaybeTable Expr i) (MaybeTable Expr a)
aggregateJustTable1 =
  (MaybeTable Expr i -> Expr Bool)
-> Aggregator' fold (MaybeTable Expr i) a
-> Aggregator' fold' (MaybeTable Expr i) (MaybeTable Expr a)
forall a i (fold :: Fold) (fold' :: Fold).
Table Expr a =>
(i -> Expr Bool)
-> Aggregator' fold i a -> Aggregator' fold' i (MaybeTable Expr a)
filterWhereOptional MaybeTable Expr i -> Expr Bool
forall a. MaybeTable Expr a -> Expr Bool
isJustTable (Aggregator' fold (MaybeTable Expr i) a
 -> Aggregator' fold' (MaybeTable Expr i) (MaybeTable Expr a))
-> (Aggregator' fold i a -> Aggregator' fold (MaybeTable Expr i) a)
-> Aggregator' fold i a
-> Aggregator' fold' (MaybeTable Expr i) (MaybeTable Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MaybeTable Expr i -> i)
-> Aggregator' fold i a -> Aggregator' fold (MaybeTable Expr i) a
forall a b c.
(a -> b) -> Aggregator' fold b c -> Aggregator' fold a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Nullify Expr i -> i
forall a. Nullify Expr a -> a
unsafeUnnullifyTable (Nullify Expr i -> i)
-> (MaybeTable Expr i -> Nullify Expr i) -> MaybeTable Expr i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeTable Expr i -> Nullify Expr i
forall (context :: * -> *) a.
MaybeTable context a -> Nullify context a
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 :: forall (fold :: Fold) i a.
Aggregator' fold i a
-> Aggregator1 (MaybeTable Expr i) (MaybeTable Expr a)
aggregateMaybeTable Aggregator' fold i a
aggregator =
  Expr (Maybe MaybeTag) -> Nullify Expr a -> MaybeTable Expr a
forall (context :: * -> *) a.
context (Maybe MaybeTag)
-> Nullify context a -> MaybeTable context a
MaybeTable
    (Expr (Maybe MaybeTag) -> Nullify Expr a -> MaybeTable Expr a)
-> Aggregator' 'Semi (MaybeTable Expr i) (Expr (Maybe MaybeTag))
-> Aggregator'
     'Semi (MaybeTable Expr i) (Nullify Expr a -> MaybeTable Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MaybeTable Expr i -> Expr (Maybe MaybeTag))
-> Aggregator' 'Semi (MaybeTable Expr i) (Expr (Maybe MaybeTag))
forall a i. Sql DBEq a => (i -> Expr a) -> Aggregator1 i (Expr a)
groupByExprOn MaybeTable Expr i -> Expr (Maybe MaybeTag)
forall (context :: * -> *) a.
MaybeTable context a -> context (Maybe MaybeTag)
tag
    Aggregator'
  'Semi (MaybeTable Expr i) (Nullify Expr a -> MaybeTable Expr a)
-> Aggregator' 'Semi (MaybeTable Expr i) (Nullify Expr a)
-> Aggregator' 'Semi (MaybeTable Expr i) (MaybeTable Expr a)
forall a b.
Aggregator' 'Semi (MaybeTable Expr i) (a -> b)
-> Aggregator' 'Semi (MaybeTable Expr i) a
-> Aggregator' 'Semi (MaybeTable Expr i) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MaybeTable Expr i -> Nullify Expr i)
-> Aggregator' 'Semi (Nullify Expr i) (Nullify Expr a)
-> Aggregator' 'Semi (MaybeTable Expr i) (Nullify Expr a)
forall a b c.
(a -> b) -> Aggregator' 'Semi b c -> Aggregator' 'Semi a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap MaybeTable Expr i -> Nullify Expr i
forall (context :: * -> *) a.
MaybeTable context a -> Nullify context a
just (Aggregator' fold (Nullify Expr i) (Nullify Expr a)
-> Aggregator' 'Semi (Nullify Expr i) (Nullify Expr a)
forall (fold :: Fold) i a. Aggregator' fold i a -> Aggregator1 i a
toAggregator1 (Aggregator' fold i a
-> Aggregator' fold (Nullify Expr i) (Nullify Expr a)
forall (fold :: Fold) i a.
Aggregator' fold i a
-> Aggregator' fold (Nullify Expr i) (Nullify Expr a)
aggregateNullify Aggregator' fold i a
aggregator))