{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module      : Database.Relational.Monad.Trans.Aggregating
-- Copyright   : 2013-2018 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines monad transformer which lift
-- from 'MonadQuery' into Aggregated query.
module Database.Relational.Monad.Trans.Aggregating
       ( -- * Transformer into aggregated query
         Aggregatings, aggregatings,

         AggregatingSetT, AggregatingSetListT, AggregatingPowerSetT, PartitioningSetT,

         -- * Result
         extractAggregateTerms,

         -- * Grouping sets support
         AggregatingSet, AggregatingPowerSet,  AggregatingSetList, PartitioningSet,
         key, key', set,
         bkey, rollup, cube, groupingSets,
       ) where

import Control.Monad.Trans.Class (MonadTrans (lift))
import Control.Monad.Trans.Writer (WriterT, runWriterT, tell)
import Control.Applicative (Applicative, pure, (<$>))
import Control.Arrow (second)
import Data.DList (DList, toList)

import Data.Functor.Identity (Identity (runIdentity))

import Database.Relational.Internal.ContextType
  (Flat, Aggregated, Set, Power, SetList)
import Database.Relational.SqlSyntax
  (Record, untypeRecord,
   AggregateColumnRef, AggregateElem, aggregateColumnRef, AggregateSet, aggregateGroupingSet,
   AggregateBitKey, aggregatePowerKey, aggregateRollup, aggregateCube, aggregateSets,
   AggregateKey, aggregateKeyRecord, aggregateKeyElement, unsafeAggregateKey)

import qualified Database.Relational.Record as Record
import Database.Relational.Monad.Class
  (MonadQualify (..), MonadRestrict(..), MonadQuery(..), MonadAggregate(..), MonadPartition(..))


-- | Type to accumulate aggregating context.
--   Type 'ac' is aggregating-context type like aggregating key set building,
--   aggregating key sets set building and partition key set building.
--   Type 'at' is aggregating term type.
newtype Aggregatings ac at m a =
  Aggregatings (WriterT (DList at) m a)
  deriving (m a -> Aggregatings ac at m a
(forall (m :: * -> *) a. Monad m => m a -> Aggregatings ac at m a)
-> MonadTrans (Aggregatings ac at)
forall ac at (m :: * -> *) a.
Monad m =>
m a -> Aggregatings ac at m a
forall (m :: * -> *) a. Monad m => m a -> Aggregatings ac at m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> Aggregatings ac at m a
$clift :: forall ac at (m :: * -> *) a.
Monad m =>
m a -> Aggregatings ac at m a
MonadTrans, Applicative (Aggregatings ac at m)
a -> Aggregatings ac at m a
Applicative (Aggregatings ac at m)
-> (forall a b.
    Aggregatings ac at m a
    -> (a -> Aggregatings ac at m b) -> Aggregatings ac at m b)
-> (forall a b.
    Aggregatings ac at m a
    -> Aggregatings ac at m b -> Aggregatings ac at m b)
-> (forall a. a -> Aggregatings ac at m a)
-> Monad (Aggregatings ac at m)
Aggregatings ac at m a
-> (a -> Aggregatings ac at m b) -> Aggregatings ac at m b
Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m b
forall a. a -> Aggregatings ac at m a
forall a b.
Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m b
forall a b.
Aggregatings ac at m a
-> (a -> Aggregatings ac at m b) -> Aggregatings ac at m b
forall ac at (m :: * -> *).
Monad m =>
Applicative (Aggregatings ac at m)
forall ac at (m :: * -> *) a.
Monad m =>
a -> Aggregatings ac at m a
forall ac at (m :: * -> *) a b.
Monad m =>
Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m b
forall ac at (m :: * -> *) a b.
Monad m =>
Aggregatings ac at m a
-> (a -> Aggregatings ac at m b) -> Aggregatings ac at m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Aggregatings ac at m a
$creturn :: forall ac at (m :: * -> *) a.
Monad m =>
a -> Aggregatings ac at m a
>> :: Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m b
$c>> :: forall ac at (m :: * -> *) a b.
Monad m =>
Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m b
>>= :: Aggregatings ac at m a
-> (a -> Aggregatings ac at m b) -> Aggregatings ac at m b
$c>>= :: forall ac at (m :: * -> *) a b.
Monad m =>
Aggregatings ac at m a
-> (a -> Aggregatings ac at m b) -> Aggregatings ac at m b
$cp1Monad :: forall ac at (m :: * -> *).
Monad m =>
Applicative (Aggregatings ac at m)
Monad, a -> Aggregatings ac at m b -> Aggregatings ac at m a
(a -> b) -> Aggregatings ac at m a -> Aggregatings ac at m b
(forall a b.
 (a -> b) -> Aggregatings ac at m a -> Aggregatings ac at m b)
-> (forall a b.
    a -> Aggregatings ac at m b -> Aggregatings ac at m a)
-> Functor (Aggregatings ac at m)
forall a b. a -> Aggregatings ac at m b -> Aggregatings ac at m a
forall a b.
(a -> b) -> Aggregatings ac at m a -> Aggregatings ac at m b
forall ac at (m :: * -> *) a b.
Functor m =>
a -> Aggregatings ac at m b -> Aggregatings ac at m a
forall ac at (m :: * -> *) a b.
Functor m =>
(a -> b) -> Aggregatings ac at m a -> Aggregatings ac at m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Aggregatings ac at m b -> Aggregatings ac at m a
$c<$ :: forall ac at (m :: * -> *) a b.
Functor m =>
a -> Aggregatings ac at m b -> Aggregatings ac at m a
fmap :: (a -> b) -> Aggregatings ac at m a -> Aggregatings ac at m b
$cfmap :: forall ac at (m :: * -> *) a b.
Functor m =>
(a -> b) -> Aggregatings ac at m a -> Aggregatings ac at m b
Functor, Functor (Aggregatings ac at m)
a -> Aggregatings ac at m a
Functor (Aggregatings ac at m)
-> (forall a. a -> Aggregatings ac at m a)
-> (forall a b.
    Aggregatings ac at m (a -> b)
    -> Aggregatings ac at m a -> Aggregatings ac at m b)
-> (forall a b c.
    (a -> b -> c)
    -> Aggregatings ac at m a
    -> Aggregatings ac at m b
    -> Aggregatings ac at m c)
-> (forall a b.
    Aggregatings ac at m a
    -> Aggregatings ac at m b -> Aggregatings ac at m b)
-> (forall a b.
    Aggregatings ac at m a
    -> Aggregatings ac at m b -> Aggregatings ac at m a)
-> Applicative (Aggregatings ac at m)
Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m b
Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m a
Aggregatings ac at m (a -> b)
-> Aggregatings ac at m a -> Aggregatings ac at m b
(a -> b -> c)
-> Aggregatings ac at m a
-> Aggregatings ac at m b
-> Aggregatings ac at m c
forall a. a -> Aggregatings ac at m a
forall a b.
Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m a
forall a b.
Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m b
forall a b.
Aggregatings ac at m (a -> b)
-> Aggregatings ac at m a -> Aggregatings ac at m b
forall a b c.
(a -> b -> c)
-> Aggregatings ac at m a
-> Aggregatings ac at m b
-> Aggregatings ac at m c
forall ac at (m :: * -> *).
Applicative m =>
Functor (Aggregatings ac at m)
forall ac at (m :: * -> *) a.
Applicative m =>
a -> Aggregatings ac at m a
forall ac at (m :: * -> *) a b.
Applicative m =>
Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m a
forall ac at (m :: * -> *) a b.
Applicative m =>
Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m b
forall ac at (m :: * -> *) a b.
Applicative m =>
Aggregatings ac at m (a -> b)
-> Aggregatings ac at m a -> Aggregatings ac at m b
forall ac at (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> Aggregatings ac at m a
-> Aggregatings ac at m b
-> Aggregatings ac at m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m a
$c<* :: forall ac at (m :: * -> *) a b.
Applicative m =>
Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m a
*> :: Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m b
$c*> :: forall ac at (m :: * -> *) a b.
Applicative m =>
Aggregatings ac at m a
-> Aggregatings ac at m b -> Aggregatings ac at m b
liftA2 :: (a -> b -> c)
-> Aggregatings ac at m a
-> Aggregatings ac at m b
-> Aggregatings ac at m c
$cliftA2 :: forall ac at (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> Aggregatings ac at m a
-> Aggregatings ac at m b
-> Aggregatings ac at m c
<*> :: Aggregatings ac at m (a -> b)
-> Aggregatings ac at m a -> Aggregatings ac at m b
$c<*> :: forall ac at (m :: * -> *) a b.
Applicative m =>
Aggregatings ac at m (a -> b)
-> Aggregatings ac at m a -> Aggregatings ac at m b
pure :: a -> Aggregatings ac at m a
$cpure :: forall ac at (m :: * -> *) a.
Applicative m =>
a -> Aggregatings ac at m a
$cp1Applicative :: forall ac at (m :: * -> *).
Applicative m =>
Functor (Aggregatings ac at m)
Applicative)

-- | Lift to 'Aggregatings'.
aggregatings :: Monad m => m a -> Aggregatings ac at m a
aggregatings :: m a -> Aggregatings ac at m a
aggregatings =  m a -> Aggregatings ac at m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Context type building one grouping set.
type AggregatingSetT      = Aggregatings Set       AggregateElem

-- | Context type building grouping sets list.
type AggregatingSetListT  = Aggregatings SetList   AggregateSet

-- | Context type building power group set.
type AggregatingPowerSetT = Aggregatings Power     AggregateBitKey

-- | Context type building partition keys set.
type PartitioningSetT c   = Aggregatings c         AggregateColumnRef

-- | Aggregated 'MonadRestrict'.
instance MonadRestrict c m => MonadRestrict c (AggregatingSetT m) where
  restrict :: Predicate c -> AggregatingSetT m ()
restrict =  m () -> AggregatingSetT m ()
forall (m :: * -> *) a ac at.
Monad m =>
m a -> Aggregatings ac at m a
aggregatings (m () -> AggregatingSetT m ())
-> (Predicate c -> m ()) -> Predicate c -> AggregatingSetT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate c -> m ()
forall c (m :: * -> *). MonadRestrict c m => Predicate c -> m ()
restrict

-- | Aggregated 'MonadQualify'.
instance MonadQualify q m => MonadQualify q (AggregatingSetT m) where
  liftQualify :: q a -> AggregatingSetT m a
liftQualify = m a -> AggregatingSetT m a
forall (m :: * -> *) a ac at.
Monad m =>
m a -> Aggregatings ac at m a
aggregatings (m a -> AggregatingSetT m a)
-> (q a -> m a) -> q a -> AggregatingSetT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. q a -> m a
forall (q :: * -> *) (m :: * -> *) a.
MonadQualify q m =>
q a -> m a
liftQualify

-- | Aggregated 'MonadQuery'.
instance MonadQuery m => MonadQuery (AggregatingSetT m) where
  setDuplication :: Duplication -> AggregatingSetT m ()
setDuplication     = m () -> AggregatingSetT m ()
forall (m :: * -> *) a ac at.
Monad m =>
m a -> Aggregatings ac at m a
aggregatings (m () -> AggregatingSetT m ())
-> (Duplication -> m ()) -> Duplication -> AggregatingSetT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duplication -> m ()
forall (m :: * -> *). MonadQuery m => Duplication -> m ()
setDuplication
  restrictJoin :: Predicate Flat -> AggregatingSetT m ()
restrictJoin       = m () -> AggregatingSetT m ()
forall (m :: * -> *) a ac at.
Monad m =>
m a -> Aggregatings ac at m a
aggregatings (m () -> AggregatingSetT m ())
-> (Predicate Flat -> m ())
-> Predicate Flat
-> AggregatingSetT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate Flat -> m ()
forall (m :: * -> *). MonadQuery m => Predicate Flat -> m ()
restrictJoin
  query' :: Relation p r -> AggregatingSetT m (PlaceHolders p, Record Flat r)
query'             = m (PlaceHolders p, Record Flat r)
-> AggregatingSetT m (PlaceHolders p, Record Flat r)
forall (m :: * -> *) a ac at.
Monad m =>
m a -> Aggregatings ac at m a
aggregatings (m (PlaceHolders p, Record Flat r)
 -> AggregatingSetT m (PlaceHolders p, Record Flat r))
-> (Relation p r -> m (PlaceHolders p, Record Flat r))
-> Relation p r
-> AggregatingSetT m (PlaceHolders p, Record Flat r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation p r -> m (PlaceHolders p, Record Flat r)
forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat r)
query'
  queryMaybe' :: Relation p r
-> AggregatingSetT m (PlaceHolders p, Record Flat (Maybe r))
queryMaybe'        = m (PlaceHolders p, Record Flat (Maybe r))
-> AggregatingSetT m (PlaceHolders p, Record Flat (Maybe r))
forall (m :: * -> *) a ac at.
Monad m =>
m a -> Aggregatings ac at m a
aggregatings (m (PlaceHolders p, Record Flat (Maybe r))
 -> AggregatingSetT m (PlaceHolders p, Record Flat (Maybe r)))
-> (Relation p r -> m (PlaceHolders p, Record Flat (Maybe r)))
-> Relation p r
-> AggregatingSetT m (PlaceHolders p, Record Flat (Maybe r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation p r -> m (PlaceHolders p, Record Flat (Maybe r))
forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat (Maybe r))
queryMaybe'

unsafeAggregateWithTerm :: Monad m => at -> Aggregatings ac at m ()
unsafeAggregateWithTerm :: at -> Aggregatings ac at m ()
unsafeAggregateWithTerm =  WriterT (DList at) m () -> Aggregatings ac at m ()
forall ac at (m :: * -> *) a.
WriterT (DList at) m a -> Aggregatings ac at m a
Aggregatings (WriterT (DList at) m () -> Aggregatings ac at m ())
-> (at -> WriterT (DList at) m ()) -> at -> Aggregatings ac at m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList at -> WriterT (DList at) m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (DList at -> WriterT (DList at) m ())
-> (at -> DList at) -> at -> WriterT (DList at) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. at -> DList at
forall (f :: * -> *) a. Applicative f => a -> f a
pure

aggregateKey :: Monad m => AggregateKey a -> Aggregatings ac AggregateElem m a
aggregateKey :: AggregateKey a -> Aggregatings ac AggregateElem m a
aggregateKey AggregateKey a
k = do
  AggregateElem -> Aggregatings ac AggregateElem m ()
forall (m :: * -> *) at ac.
Monad m =>
at -> Aggregatings ac at m ()
unsafeAggregateWithTerm (AggregateElem -> Aggregatings ac AggregateElem m ())
-> AggregateElem -> Aggregatings ac AggregateElem m ()
forall a b. (a -> b) -> a -> b
$ AggregateKey a -> AggregateElem
forall a. AggregateKey a -> AggregateElem
aggregateKeyElement AggregateKey a
k
  a -> Aggregatings ac AggregateElem m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Aggregatings ac AggregateElem m a)
-> a -> Aggregatings ac AggregateElem m a
forall a b. (a -> b) -> a -> b
$ AggregateKey a -> a
forall a. AggregateKey a -> a
aggregateKeyRecord AggregateKey a
k

-- | Aggregated query instance.
instance MonadQuery m => MonadAggregate (AggregatingSetT m) where
  groupBy :: Record Flat r -> AggregatingSetT m (Record Aggregated r)
groupBy Record Flat r
p = do
    (AggregateElem -> Aggregatings Set AggregateElem m ())
-> [AggregateElem] -> Aggregatings Set AggregateElem m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AggregateElem -> Aggregatings Set AggregateElem m ()
forall (m :: * -> *) at ac.
Monad m =>
at -> Aggregatings ac at m ()
unsafeAggregateWithTerm [ AggregateColumnRef -> AggregateElem
aggregateColumnRef AggregateColumnRef
col | AggregateColumnRef
col <- Record Flat r -> Tuple
forall c t. Record c t -> Tuple
untypeRecord Record Flat r
p]
    Record Aggregated r -> AggregatingSetT m (Record Aggregated r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Record Aggregated r -> AggregatingSetT m (Record Aggregated r))
-> Record Aggregated r -> AggregatingSetT m (Record Aggregated r)
forall a b. (a -> b) -> a -> b
$ Record Flat r -> Record Aggregated r
forall r. Record Flat r -> Record Aggregated r
Record.unsafeToAggregated Record Flat r
p
  groupBy' :: AggregateKey (Record Aggregated r)
-> AggregatingSetT m (Record Aggregated r)
groupBy'  = AggregateKey (Record Aggregated r)
-> AggregatingSetT m (Record Aggregated r)
forall (m :: * -> *) a ac.
Monad m =>
AggregateKey a -> Aggregatings ac AggregateElem m a
aggregateKey

-- | Partition clause instance
instance Monad m => MonadPartition c (PartitioningSetT c m) where
  partitionBy :: Record c r -> PartitioningSetT c m ()
partitionBy =  (AggregateColumnRef -> PartitioningSetT c m ())
-> Tuple -> PartitioningSetT c m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AggregateColumnRef -> PartitioningSetT c m ()
forall (m :: * -> *) at ac.
Monad m =>
at -> Aggregatings ac at m ()
unsafeAggregateWithTerm (Tuple -> PartitioningSetT c m ())
-> (Record c r -> Tuple) -> Record c r -> PartitioningSetT c m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c r -> Tuple
forall c t. Record c t -> Tuple
untypeRecord

-- | Run 'Aggregatings' to get terms list.
extractAggregateTerms :: (Monad m, Functor m) => Aggregatings ac at m a -> m (a, [at])
extractAggregateTerms :: Aggregatings ac at m a -> m (a, [at])
extractAggregateTerms (Aggregatings WriterT (DList at) m a
ac) = (DList at -> [at]) -> (a, DList at) -> (a, [at])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second DList at -> [at]
forall a. DList a -> [a]
toList ((a, DList at) -> (a, [at])) -> m (a, DList at) -> m (a, [at])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT (DList at) m a -> m (a, DList at)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT (DList at) m a
ac

extractTermList :: Aggregatings ac at Identity a -> (a, [at])
extractTermList :: Aggregatings ac at Identity a -> (a, [at])
extractTermList =  Identity (a, [at]) -> (a, [at])
forall a. Identity a -> a
runIdentity (Identity (a, [at]) -> (a, [at]))
-> (Aggregatings ac at Identity a -> Identity (a, [at]))
-> Aggregatings ac at Identity a
-> (a, [at])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Aggregatings ac at Identity a -> Identity (a, [at])
forall (m :: * -> *) ac at a.
(Monad m, Functor m) =>
Aggregatings ac at m a -> m (a, [at])
extractAggregateTerms

-- | Context monad type to build single grouping set.
type AggregatingSet      = AggregatingSetT      Identity

-- | Context monad type to build grouping power set.
type AggregatingPowerSet = AggregatingPowerSetT Identity

-- | Context monad type to build grouping set list.
type AggregatingSetList  = AggregatingSetListT  Identity

-- | Context monad type to build partition keys set.
type PartitioningSet c   = PartitioningSetT c   Identity

-- | Specify key of single grouping set from Record.
key :: Record Flat r
    -> AggregatingSet (Record Aggregated (Maybe r))
key :: Record Flat r -> AggregatingSet (Record Aggregated (Maybe r))
key Record Flat r
p = do
  (AggregateElem -> Aggregatings Set AggregateElem Identity ())
-> [AggregateElem] -> Aggregatings Set AggregateElem Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AggregateElem -> Aggregatings Set AggregateElem Identity ()
forall (m :: * -> *) at ac.
Monad m =>
at -> Aggregatings ac at m ()
unsafeAggregateWithTerm [ AggregateColumnRef -> AggregateElem
aggregateColumnRef AggregateColumnRef
col | AggregateColumnRef
col <- Record Flat r -> Tuple
forall c t. Record c t -> Tuple
untypeRecord Record Flat r
p]
  Record Aggregated (Maybe r)
-> AggregatingSet (Record Aggregated (Maybe r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Record Aggregated (Maybe r)
 -> AggregatingSet (Record Aggregated (Maybe r)))
-> (Record Aggregated r -> Record Aggregated (Maybe r))
-> Record Aggregated r
-> AggregatingSet (Record Aggregated (Maybe r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record Aggregated r -> Record Aggregated (Maybe r)
forall c r. Record c r -> Record c (Maybe r)
Record.just (Record Aggregated r
 -> AggregatingSet (Record Aggregated (Maybe r)))
-> Record Aggregated r
-> AggregatingSet (Record Aggregated (Maybe r))
forall a b. (a -> b) -> a -> b
$ Record Flat r -> Record Aggregated r
forall r. Record Flat r -> Record Aggregated r
Record.unsafeToAggregated Record Flat r
p

-- | Specify key of single grouping set.
key' :: AggregateKey a
     -> AggregatingSet a
key' :: AggregateKey a -> AggregatingSet a
key' = AggregateKey a -> AggregatingSet a
forall (m :: * -> *) a ac.
Monad m =>
AggregateKey a -> Aggregatings ac AggregateElem m a
aggregateKey

-- | Finalize and specify single grouping set.
set :: AggregatingSet a
    -> AggregatingSetList a
set :: AggregatingSet a -> AggregatingSetList a
set AggregatingSet a
s = do
  let (a
p, AggregateSet
c) = ([AggregateElem] -> AggregateSet)
-> (a, [AggregateElem]) -> (a, AggregateSet)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [AggregateElem] -> AggregateSet
aggregateGroupingSet ((a, [AggregateElem]) -> (a, AggregateSet))
-> (AggregatingSet a -> (a, [AggregateElem]))
-> AggregatingSet a
-> (a, AggregateSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AggregatingSet a -> (a, [AggregateElem])
forall ac at a. Aggregatings ac at Identity a -> (a, [at])
extractTermList (AggregatingSet a -> (a, AggregateSet))
-> AggregatingSet a -> (a, AggregateSet)
forall a b. (a -> b) -> a -> b
$ AggregatingSet a
s
  AggregateSet -> Aggregatings SetList AggregateSet Identity ()
forall (m :: * -> *) at ac.
Monad m =>
at -> Aggregatings ac at m ()
unsafeAggregateWithTerm AggregateSet
c
  a -> AggregatingSetList a
forall (m :: * -> *) a. Monad m => a -> m a
return a
p

-- | Specify key of rollup and cube power set.
bkey :: Record Flat r
     -> AggregatingPowerSet (Record Aggregated (Maybe r))
bkey :: Record Flat r -> AggregatingPowerSet (Record Aggregated (Maybe r))
bkey Record Flat r
p = do
  AggregateBitKey -> Aggregatings Power AggregateBitKey Identity ()
forall (m :: * -> *) at ac.
Monad m =>
at -> Aggregatings ac at m ()
unsafeAggregateWithTerm (AggregateBitKey -> Aggregatings Power AggregateBitKey Identity ())
-> (Tuple -> AggregateBitKey)
-> Tuple
-> Aggregatings Power AggregateBitKey Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuple -> AggregateBitKey
aggregatePowerKey (Tuple -> Aggregatings Power AggregateBitKey Identity ())
-> Tuple -> Aggregatings Power AggregateBitKey Identity ()
forall a b. (a -> b) -> a -> b
$ Record Flat r -> Tuple
forall c t. Record c t -> Tuple
untypeRecord Record Flat r
p
  Record Aggregated (Maybe r)
-> AggregatingPowerSet (Record Aggregated (Maybe r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Record Aggregated (Maybe r)
 -> AggregatingPowerSet (Record Aggregated (Maybe r)))
-> (Record Aggregated r -> Record Aggregated (Maybe r))
-> Record Aggregated r
-> AggregatingPowerSet (Record Aggregated (Maybe r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record Aggregated r -> Record Aggregated (Maybe r)
forall c r. Record c r -> Record c (Maybe r)
Record.just (Record Aggregated r
 -> AggregatingPowerSet (Record Aggregated (Maybe r)))
-> Record Aggregated r
-> AggregatingPowerSet (Record Aggregated (Maybe r))
forall a b. (a -> b) -> a -> b
$ Record Flat r -> Record Aggregated r
forall r. Record Flat r -> Record Aggregated r
Record.unsafeToAggregated Record Flat r
p

finalizePower :: ([AggregateBitKey] -> AggregateElem)
              -> AggregatingPowerSet a -> AggregateKey a
finalizePower :: ([AggregateBitKey] -> AggregateElem)
-> AggregatingPowerSet a -> AggregateKey a
finalizePower [AggregateBitKey] -> AggregateElem
finalize AggregatingPowerSet a
pow = (a, AggregateElem) -> AggregateKey a
forall a. (a, AggregateElem) -> AggregateKey a
unsafeAggregateKey ((a, AggregateElem) -> AggregateKey a)
-> (AggregatingPowerSet a -> (a, AggregateElem))
-> AggregatingPowerSet a
-> AggregateKey a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([AggregateBitKey] -> AggregateElem)
-> (a, [AggregateBitKey]) -> (a, AggregateElem)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [AggregateBitKey] -> AggregateElem
finalize ((a, [AggregateBitKey]) -> (a, AggregateElem))
-> (AggregatingPowerSet a -> (a, [AggregateBitKey]))
-> AggregatingPowerSet a
-> (a, AggregateElem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AggregatingPowerSet a -> (a, [AggregateBitKey])
forall ac at a. Aggregatings ac at Identity a -> (a, [at])
extractTermList (AggregatingPowerSet a -> AggregateKey a)
-> AggregatingPowerSet a -> AggregateKey a
forall a b. (a -> b) -> a -> b
$ AggregatingPowerSet a
pow

-- | Finalize grouping power set as rollup power set.
rollup :: AggregatingPowerSet a -> AggregateKey a
rollup :: AggregatingPowerSet a -> AggregateKey a
rollup =  ([AggregateBitKey] -> AggregateElem)
-> AggregatingPowerSet a -> AggregateKey a
forall a.
([AggregateBitKey] -> AggregateElem)
-> AggregatingPowerSet a -> AggregateKey a
finalizePower [AggregateBitKey] -> AggregateElem
aggregateRollup

-- | Finalize grouping power set as cube power set.
cube   :: AggregatingPowerSet a -> AggregateKey a
cube :: AggregatingPowerSet a -> AggregateKey a
cube   =  ([AggregateBitKey] -> AggregateElem)
-> AggregatingPowerSet a -> AggregateKey a
forall a.
([AggregateBitKey] -> AggregateElem)
-> AggregatingPowerSet a -> AggregateKey a
finalizePower [AggregateBitKey] -> AggregateElem
aggregateCube

-- | Finalize grouping set list.
groupingSets :: AggregatingSetList a -> AggregateKey a
groupingSets :: AggregatingSetList a -> AggregateKey a
groupingSets =  (a, AggregateElem) -> AggregateKey a
forall a. (a, AggregateElem) -> AggregateKey a
unsafeAggregateKey ((a, AggregateElem) -> AggregateKey a)
-> (AggregatingSetList a -> (a, AggregateElem))
-> AggregatingSetList a
-> AggregateKey a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([AggregateSet] -> AggregateElem)
-> (a, [AggregateSet]) -> (a, AggregateElem)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [AggregateSet] -> AggregateElem
aggregateSets ((a, [AggregateSet]) -> (a, AggregateElem))
-> (AggregatingSetList a -> (a, [AggregateSet]))
-> AggregatingSetList a
-> (a, AggregateElem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AggregatingSetList a -> (a, [AggregateSet])
forall ac at a. Aggregatings ac at Identity a -> (a, [at])
extractTermList