module Database.Relational.Query.Monad.Aggregate (
QueryAggregate,
AggregatedQuery,
toSQL,
toSubQuery,
Window, partitionBy, over
) where
import Data.Functor.Identity (Identity (runIdentity))
import Database.Relational.Query.Internal.SQL (showStringSQL)
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.Component
(AggregateColumnRef, Duplication, QueryRestriction, OrderingTerms, AggregateElem, composeOver)
import Database.Relational.Query.Sub (SubQuery, aggregatedSubQuery, JoinProduct)
import qualified Database.Relational.Query.Sub as SubQuery
import Database.Relational.Query.Projectable (PlaceHolders, SqlProjectable, unsafeProjectSql, unsafeShowSql)
import Database.Relational.Query.Monad.Class (MonadRestrict(..), MonadQualify(..), MonadPartition (..))
import Database.Relational.Query.Monad.Trans.Join (join')
import Database.Relational.Query.Monad.Trans.Restricting
(Restrictings, restrictings, extractRestrict)
import Database.Relational.Query.Monad.Trans.Aggregating
(aggregatings, extractAggregateTerms, AggregatingSetT, PartitioningSet)
import Database.Relational.Query.Monad.Trans.Ordering
(Orderings, orderings, extractOrderingTerms)
import Database.Relational.Query.Monad.Type
(ConfigureQuery, askConfig, 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)
aggregatedQuery :: ConfigureQuery a -> QueryAggregate a
aggregatedQuery = orderings . restrictings . aggregatings . restrictings . join'
instance MonadRestrict Flat q => MonadRestrict Flat (Restrictings Aggregated q) where
restrict = restrictings . restrict
instance MonadQualify ConfigureQuery QueryAggregate where
liftQualify = aggregatedQuery
extract :: AggregatedQuery p r
-> ConfigureQuery (((((((PlaceHolders p, Projection Aggregated r), OrderingTerms),
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
partitionBy :: Projection c r -> Window c ()
partitionBy = mapM_ unsafeAddPartitionKey . Projection.columns
extractWindow :: Window c a -> ((a, OrderingTerms), [AggregateColumnRef])
extractWindow = runIdentity . extractAggregateTerms . extractOrderingTerms
over :: SqlProjectable (Projection c)
=> Projection OverWindow a
-> Window c ()
-> Projection c a
wp `over` win = unsafeProjectSql $ unwords [unsafeShowSql wp, showStringSQL (composeOver pt ot)] where
(((), ot), pt) = extractWindow win