{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Database.Relational.Monad.Aggregate (
QueryAggregate,
AggregatedQuery,
toSQL,
toSubQuery,
Window, over
) where
import Data.Functor.Identity (Identity (runIdentity))
import Data.Monoid ((<>))
import Language.SQL.Keyword (Keyword(..))
import qualified Language.SQL.Keyword as SQL
import Database.Relational.Internal.ContextType (Flat, Aggregated, OverWindow)
import Database.Relational.SqlSyntax
(Duplication, Record, SubQuery, Predicate, JoinProduct,
OrderingTerm, composeOrderBy, aggregatedSubQuery,
AggregateColumnRef, AggregateElem, composePartitionBy, )
import qualified Database.Relational.SqlSyntax as Syntax
import qualified Database.Relational.Record as Record
import Database.Relational.Projectable (PlaceHolders, SqlContext)
import Database.Relational.Monad.Class (MonadRestrict(..))
import Database.Relational.Monad.Trans.Restricting
(Restrictings, restrictings, extractRestrict)
import Database.Relational.Monad.Trans.Aggregating
(extractAggregateTerms, AggregatingSetT, PartitioningSet)
import Database.Relational.Monad.Trans.Ordering
(Orderings, extractOrderingTerms)
import Database.Relational.Monad.BaseType (ConfigureQuery, askConfig)
import Database.Relational.Monad.Type (QueryCore, extractCore, OrderedQuery)
type QueryAggregate = Orderings Aggregated (Restrictings Aggregated (AggregatingSetT QueryCore))
type AggregatedQuery p r = OrderedQuery Aggregated (Restrictings Aggregated (AggregatingSetT QueryCore)) p r
type Window c = Orderings c (PartitioningSet c)
instance MonadRestrict Flat q => MonadRestrict Flat (Restrictings Aggregated q) where
restrict :: Predicate Flat -> Restrictings Aggregated q ()
restrict = forall (m :: * -> *) a c. Monad m => m a -> Restrictings c m a
restrictings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (m :: * -> *). MonadRestrict c m => Predicate c -> m ()
restrict
extract :: AggregatedQuery p r
-> ConfigureQuery (((((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
[Predicate Aggregated]),
[AggregateElem]),
[Predicate Flat]),
JoinProduct), Duplication)
= forall a.
QueryCore a
-> ConfigureQuery
(((a, [Predicate Flat]), JoinProduct), Duplication)
extractCore 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) c a.
(Monad m, Functor m) =>
Restrictings c m a -> m (a, [Predicate c])
extractRestrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) c a.
(Monad m, Functor m) =>
Orderings c m a -> m (a, [OrderingTerm])
extractOrderingTerms
toSQL :: AggregatedQuery p r
-> ConfigureQuery String
toSQL :: forall p r. AggregatedQuery p r -> ConfigureQuery String
toSQL = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SubQuery -> String
Syntax.toSQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p r. AggregatedQuery p r -> ConfigureQuery SubQuery
toSubQuery
toSubQuery :: AggregatedQuery p r
-> ConfigureQuery SubQuery
toSubQuery :: forall p r. AggregatedQuery p r -> ConfigureQuery SubQuery
toSubQuery AggregatedQuery p r
q = do
(((((((PlaceHolders p
_ph, Record Aggregated r
pj), [OrderingTerm]
ot), [Predicate Aggregated]
grs), [AggregateElem]
ag), [Predicate Flat]
rs), JoinProduct
pd), Duplication
da) <- forall p r.
AggregatedQuery p r
-> ConfigureQuery
(((((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
[Predicate Aggregated]),
[AggregateElem]),
[Predicate Flat]),
JoinProduct),
Duplication)
extract AggregatedQuery p r
q
Config
c <- ConfigureQuery Config
askConfig
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Config
-> Tuple
-> Duplication
-> JoinProduct
-> [Predicate Flat]
-> [AggregateElem]
-> [Predicate Aggregated]
-> [OrderingTerm]
-> SubQuery
aggregatedSubQuery Config
c (forall c r. Record c r -> Tuple
Record.untype Record Aggregated r
pj) Duplication
da JoinProduct
pd [Predicate Flat]
rs [AggregateElem]
ag [Predicate Aggregated]
grs [OrderingTerm]
ot
extractWindow :: Window c a -> ((a, [OrderingTerm]), [AggregateColumnRef])
= 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) c a.
(Monad m, Functor m) =>
Orderings c m a -> m (a, [OrderingTerm])
extractOrderingTerms
over :: SqlContext c
=> Record OverWindow a
-> Window c ()
-> Record c a
Record OverWindow a
wp over :: forall c a.
SqlContext c =>
Record OverWindow a -> Window c () -> Record c a
`over` Window c ()
win =
forall c t. [StringSQL] -> Record c t
Record.unsafeFromSqlTerms
[ StringSQL
c forall a. Semigroup a => a -> a -> a
<> StringSQL
OVER forall a. Semigroup a => a -> a -> a
<> StringSQL -> StringSQL
SQL.paren (Tuple -> StringSQL
composePartitionBy Tuple
pt forall a. Semigroup a => a -> a -> a
<> [OrderingTerm] -> StringSQL
composeOrderBy [OrderingTerm]
ot)
| StringSQL
c <- forall c r. Record c r -> [StringSQL]
Record.columns Record OverWindow a
wp
] where (((), [OrderingTerm]
ot), Tuple
pt) = forall c a. Window c a -> ((a, [OrderingTerm]), Tuple)
extractWindow Window c ()
win
infix 8 `over`