module Database.Relational.Query.Internal.GroupingSQL (
AggregateColumnRef,
AggregateBitKey (..), AggregateSet (..), AggregateElem (..),
aggregateColumnRef, aggregateEmpty,
aggregatePowerKey, aggregateGroupingSet,
aggregateRollup, aggregateCube, aggregateSets,
composeGroupBy, composePartitionBy,
AggregateKey (..),
aggregateKeyProjection, aggregateKeyElement, unsafeAggregateKey,
) where
import Data.Monoid (Monoid (..), (<>))
import Language.SQL.Keyword (Keyword(..), (|*|))
import qualified Language.SQL.Keyword as SQL
import Database.Relational.Query.Internal.SQL (StringSQL)
type AggregateColumnRef = StringSQL
newtype AggregateBitKey = AggregateBitKey [AggregateColumnRef] deriving Show
newtype AggregateSet = AggregateSet [AggregateElem] deriving Show
data AggregateElem = ColumnRef AggregateColumnRef
| Rollup [AggregateBitKey]
| Cube [AggregateBitKey]
| GroupingSets [AggregateSet]
deriving Show
newtype AggregateKey a = AggregateKey (a, AggregateElem)
aggregateColumnRef :: AggregateColumnRef -> AggregateElem
aggregateColumnRef = ColumnRef
aggregatePowerKey :: [AggregateColumnRef] -> AggregateBitKey
aggregatePowerKey = AggregateBitKey
aggregateGroupingSet :: [AggregateElem] -> AggregateSet
aggregateGroupingSet = AggregateSet
aggregateRollup :: [AggregateBitKey] -> AggregateElem
aggregateRollup = Rollup
aggregateCube :: [AggregateBitKey] -> AggregateElem
aggregateCube = Cube
aggregateSets :: [AggregateSet] -> AggregateElem
aggregateSets = GroupingSets
aggregateEmpty :: [AggregateElem]
aggregateEmpty = []
commaed :: [StringSQL] -> StringSQL
commaed = SQL.fold (|*|)
pComma :: (a -> StringSQL) -> [a] -> StringSQL
pComma qshow = SQL.paren . commaed . map qshow
showsAggregateBitKey :: AggregateBitKey -> StringSQL
showsAggregateBitKey (AggregateBitKey ts) = pComma id ts
composeGroupBy :: [AggregateElem] -> StringSQL
composeGroupBy = d where
d [] = mempty
d es@(_:_) = GROUP <> BY <> rec es
keyList op ss = op <> pComma showsAggregateBitKey ss
rec = commaed . map showsE
showsGs (AggregateSet s) = SQL.paren $ rec s
showsE (ColumnRef t) = t
showsE (Rollup ss) = keyList ROLLUP ss
showsE (Cube ss) = keyList CUBE ss
showsE (GroupingSets ss) = GROUPING <> SETS <> pComma showsGs ss
composePartitionBy :: [AggregateColumnRef] -> StringSQL
composePartitionBy = d where
d [] = mempty
d ts@(_:_) = PARTITION <> BY <> commaed ts
aggregateKeyProjection :: AggregateKey a -> a
aggregateKeyProjection (AggregateKey (p, _c)) = p
aggregateKeyElement :: AggregateKey a -> AggregateElem
aggregateKeyElement (AggregateKey (_p, c)) = c
unsafeAggregateKey :: (a, AggregateElem) -> AggregateKey a
unsafeAggregateKey = AggregateKey