module Database.Relational.Query.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.Query.Internal.BaseSQL (Duplication, OrderingTerm, composeOrderBy)
import Database.Relational.Query.Internal.GroupingSQL (AggregateColumnRef, AggregateElem, composePartitionBy)
import Database.Relational.Query.Context (Flat, Aggregated, OverWindow)
import Database.Relational.Query.Projection (Projection)
import qualified Database.Relational.Query.Projection as Projection
import Database.Relational.Query.Sub (SubQuery, QueryRestriction, JoinProduct, aggregatedSubQuery)
import qualified Database.Relational.Query.Sub as SubQuery
import Database.Relational.Query.Projectable (PlaceHolders, SqlProjectable)
import Database.Relational.Query.Monad.Class (MonadRestrict(..))
import Database.Relational.Query.Monad.Trans.Restricting
(Restrictings, restrictings, extractRestrict)
import Database.Relational.Query.Monad.Trans.Aggregating
(extractAggregateTerms, AggregatingSetT, PartitioningSet)
import Database.Relational.Query.Monad.Trans.Ordering
(Orderings, extractOrderingTerms)
import Database.Relational.Query.Monad.BaseType (ConfigureQuery, askConfig)
import Database.Relational.Query.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 = restrictings . restrict
extract :: AggregatedQuery p r
-> ConfigureQuery (((((((PlaceHolders p, Projection Aggregated r), [OrderingTerm]),
QueryRestriction Aggregated),
[AggregateElem]),
QueryRestriction Flat),
JoinProduct), Duplication)
extract = extractCore . extractAggregateTerms . extractRestrict . extractOrderingTerms
toSQL :: AggregatedQuery p r
-> ConfigureQuery String
toSQL = fmap SubQuery.toSQL . toSubQuery
toSubQuery :: AggregatedQuery p r
-> ConfigureQuery SubQuery
toSubQuery q = do
(((((((_ph, pj), ot), grs), ag), rs), pd), da) <- extract q
c <- askConfig
return $ aggregatedSubQuery c (Projection.untype pj) da pd rs ag grs ot
extractWindow :: Window c a -> ((a, [OrderingTerm]), [AggregateColumnRef])
extractWindow = runIdentity . extractAggregateTerms . extractOrderingTerms
over :: SqlProjectable (Projection c)
=> Projection OverWindow a
-> Window c ()
-> Projection c a
wp `over` win =
Projection.unsafeFromSqlTerms
[ c <> OVER <> SQL.paren (composePartitionBy pt <> composeOrderBy ot)
| c <- Projection.columns wp
] where (((), ot), pt) = extractWindow win
infix 8 `over`