{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Database.Relational.Monad.Trans.Aggregating
(
Aggregatings, aggregatings,
AggregatingSetT, AggregatingSetListT, AggregatingPowerSetT, PartitioningSetT,
extractAggregateTerms,
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(..))
newtype Aggregatings ac at m a =
Aggregatings (WriterT (DList at) m a)
deriving (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 :: forall (m :: * -> *) a. Monad m => m a -> Aggregatings ac at m a
$clift :: forall ac at (m :: * -> *) a.
Monad m =>
m a -> Aggregatings ac at m a
MonadTrans, 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 :: forall a. a -> Aggregatings ac at m a
$creturn :: forall ac at (m :: * -> *) a.
Monad m =>
a -> Aggregatings ac at m a
>> :: forall a b.
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
>>= :: forall a 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
Monad, 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
<$ :: forall a b. 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 :: forall a b.
(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, 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
<* :: forall a b.
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
*> :: forall a b.
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 :: forall a b c.
(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
<*> :: forall a b.
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 :: forall a. a -> Aggregatings ac at m a
$cpure :: forall ac at (m :: * -> *) a.
Applicative m =>
a -> Aggregatings ac at m a
Applicative)
aggregatings :: Monad m => m a -> Aggregatings ac at m a
aggregatings :: forall (m :: * -> *) a ac at.
Monad m =>
m a -> Aggregatings ac at m a
aggregatings = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
type AggregatingSetT = Aggregatings Set AggregateElem
type AggregatingSetListT = Aggregatings SetList AggregateSet
type AggregatingPowerSetT = Aggregatings Power AggregateBitKey
type PartitioningSetT c = Aggregatings c AggregateColumnRef
instance MonadRestrict c m => MonadRestrict c (AggregatingSetT m) where
restrict :: Predicate c -> AggregatingSetT m ()
restrict = forall (m :: * -> *) a ac at.
Monad m =>
m a -> Aggregatings ac at m a
aggregatings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (m :: * -> *). MonadRestrict c m => Predicate c -> m ()
restrict
instance MonadQualify q m => MonadQualify q (AggregatingSetT m) where
liftQualify :: forall a. q a -> AggregatingSetT m a
liftQualify = forall (m :: * -> *) a ac at.
Monad m =>
m a -> Aggregatings ac at m a
aggregatings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (q :: * -> *) (m :: * -> *) a.
MonadQualify q m =>
q a -> m a
liftQualify
instance MonadQuery m => MonadQuery (AggregatingSetT m) where
setDuplication :: Duplication -> AggregatingSetT m ()
setDuplication = forall (m :: * -> *) a ac at.
Monad m =>
m a -> Aggregatings ac at m a
aggregatings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadQuery m => Duplication -> m ()
setDuplication
restrictJoin :: Predicate Flat -> AggregatingSetT m ()
restrictJoin = forall (m :: * -> *) a ac at.
Monad m =>
m a -> Aggregatings ac at m a
aggregatings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadQuery m => Predicate Flat -> m ()
restrictJoin
query' :: forall p r.
Relation p r -> AggregatingSetT m (PlaceHolders p, Record Flat r)
query' = forall (m :: * -> *) a ac at.
Monad m =>
m a -> Aggregatings ac at m a
aggregatings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat r)
query'
queryMaybe' :: forall p r.
Relation p r
-> AggregatingSetT m (PlaceHolders p, Record Flat (Maybe r))
queryMaybe' = forall (m :: * -> *) a ac at.
Monad m =>
m a -> Aggregatings ac at m a
aggregatings forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) at ac.
Monad m =>
at -> Aggregatings ac at m ()
unsafeAggregateWithTerm = forall ac at (m :: * -> *) a.
WriterT (DList at) m a -> Aggregatings ac at m a
Aggregatings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
aggregateKey :: Monad m => AggregateKey a -> Aggregatings ac AggregateElem m a
aggregateKey :: forall (m :: * -> *) a ac.
Monad m =>
AggregateKey a -> Aggregatings ac AggregateElem m a
aggregateKey AggregateKey a
k = do
forall (m :: * -> *) at ac.
Monad m =>
at -> Aggregatings ac at m ()
unsafeAggregateWithTerm forall a b. (a -> b) -> a -> b
$ forall a. AggregateKey a -> AggregateElem
aggregateKeyElement AggregateKey a
k
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. AggregateKey a -> a
aggregateKeyRecord AggregateKey a
k
instance MonadQuery m => MonadAggregate (AggregatingSetT m) where
groupBy :: forall r. Record Flat r -> AggregatingSetT m (Record Aggregated r)
groupBy Record Flat r
p = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) at ac.
Monad m =>
at -> Aggregatings ac at m ()
unsafeAggregateWithTerm [ AggregateColumnRef -> AggregateElem
aggregateColumnRef AggregateColumnRef
col | AggregateColumnRef
col <- forall c t. Record c t -> Tuple
untypeRecord Record Flat r
p]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall r. Record Flat r -> Record Aggregated r
Record.unsafeToAggregated Record Flat r
p
groupBy' :: forall r.
AggregateKey (Record Aggregated r)
-> AggregatingSetT m (Record Aggregated r)
groupBy' = forall (m :: * -> *) a ac.
Monad m =>
AggregateKey a -> Aggregatings ac AggregateElem m a
aggregateKey
instance Monad m => MonadPartition c (PartitioningSetT c m) where
partitionBy :: forall r. Record c r -> PartitioningSetT c m ()
partitionBy = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) at ac.
Monad m =>
at -> Aggregatings ac at m ()
unsafeAggregateWithTerm forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c t. Record c t -> Tuple
untypeRecord
extractAggregateTerms :: (Monad m, Functor m) => Aggregatings ac at m a -> m (a, [at])
(Aggregatings WriterT (DList at) m a
ac) = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. DList a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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])
= forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) ac at a.
(Monad m, Functor m) =>
Aggregatings ac at m a -> m (a, [at])
extractAggregateTerms
type AggregatingSet = AggregatingSetT Identity
type AggregatingPowerSet = AggregatingPowerSetT Identity
type AggregatingSetList = AggregatingSetListT Identity
type PartitioningSet c = PartitioningSetT c Identity
key :: Record Flat r
-> AggregatingSet (Record Aggregated (Maybe r))
key :: forall r.
Record Flat r -> AggregatingSet (Record Aggregated (Maybe r))
key Record Flat r
p = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) at ac.
Monad m =>
at -> Aggregatings ac at m ()
unsafeAggregateWithTerm [ AggregateColumnRef -> AggregateElem
aggregateColumnRef AggregateColumnRef
col | AggregateColumnRef
col <- forall c t. Record c t -> Tuple
untypeRecord Record Flat r
p]
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c r. Record c r -> Record c (Maybe r)
Record.just forall a b. (a -> b) -> a -> b
$ forall r. Record Flat r -> Record Aggregated r
Record.unsafeToAggregated Record Flat r
p
key' :: AggregateKey a
-> AggregatingSet a
key' :: forall a. AggregateKey a -> AggregatingSet a
key' = forall (m :: * -> *) a ac.
Monad m =>
AggregateKey a -> Aggregatings ac AggregateElem m a
aggregateKey
set :: AggregatingSet a
-> AggregatingSetList a
set :: forall a. AggregatingSet a -> AggregatingSetList a
set AggregatingSet a
s = do
let (a
p, AggregateSet
c) = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [AggregateElem] -> AggregateSet
aggregateGroupingSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ac at a. Aggregatings ac at Identity a -> (a, [at])
extractTermList forall a b. (a -> b) -> a -> b
$ AggregatingSet a
s
forall (m :: * -> *) at ac.
Monad m =>
at -> Aggregatings ac at m ()
unsafeAggregateWithTerm AggregateSet
c
forall (m :: * -> *) a. Monad m => a -> m a
return a
p
bkey :: Record Flat r
-> AggregatingPowerSet (Record Aggregated (Maybe r))
bkey :: forall r.
Record Flat r -> AggregatingPowerSet (Record Aggregated (Maybe r))
bkey Record Flat r
p = do
forall (m :: * -> *) at ac.
Monad m =>
at -> Aggregatings ac at m ()
unsafeAggregateWithTerm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuple -> AggregateBitKey
aggregatePowerKey forall a b. (a -> b) -> a -> b
$ forall c t. Record c t -> Tuple
untypeRecord Record Flat r
p
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c r. Record c r -> Record c (Maybe r)
Record.just forall a b. (a -> b) -> a -> b
$ forall r. Record Flat r -> Record Aggregated r
Record.unsafeToAggregated Record Flat r
p
finalizePower :: ([AggregateBitKey] -> AggregateElem)
-> AggregatingPowerSet a -> AggregateKey a
finalizePower :: forall a.
([AggregateBitKey] -> AggregateElem)
-> AggregatingPowerSet a -> AggregateKey a
finalizePower [AggregateBitKey] -> AggregateElem
finalize AggregatingPowerSet a
pow = forall a. (a, AggregateElem) -> AggregateKey a
unsafeAggregateKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [AggregateBitKey] -> AggregateElem
finalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ac at a. Aggregatings ac at Identity a -> (a, [at])
extractTermList forall a b. (a -> b) -> a -> b
$ AggregatingPowerSet a
pow
rollup :: AggregatingPowerSet a -> AggregateKey a
rollup :: forall a. AggregatingPowerSet a -> AggregateKey a
rollup = forall a.
([AggregateBitKey] -> AggregateElem)
-> AggregatingPowerSet a -> AggregateKey a
finalizePower [AggregateBitKey] -> AggregateElem
aggregateRollup
cube :: AggregatingPowerSet a -> AggregateKey a
cube :: forall a. AggregatingPowerSet a -> AggregateKey a
cube = forall a.
([AggregateBitKey] -> AggregateElem)
-> AggregatingPowerSet a -> AggregateKey a
finalizePower [AggregateBitKey] -> AggregateElem
aggregateCube
groupingSets :: AggregatingSetList a -> AggregateKey a
groupingSets :: forall a. AggregatingSetList a -> AggregateKey a
groupingSets = forall a. (a, AggregateElem) -> AggregateKey a
unsafeAggregateKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [AggregateSet] -> AggregateElem
aggregateSets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ac at a. Aggregatings ac at Identity a -> (a, [at])
extractTermList