-- | -- Module : Database.Relational.SqlSyntax.Aggregate -- Copyright : 2013-2017 Kei Hibino -- License : BSD3 -- -- Maintainer : ex8k.hibino@gmail.com -- Stability : experimental -- Portability : unknown -- -- This module provides grouping-sets structure of SQL syntax tree. module Database.Relational.SqlSyntax.Aggregate ( aggregateColumnRef, aggregatePowerKey, aggregateGroupingSet, aggregateRollup, aggregateCube, aggregateSets, composeGroupBy, composePartitionBy, aggregateKeyRecord, aggregateKeyElement, unsafeAggregateKey, ) where import Data.Monoid (Monoid (..), (<>)) import Language.SQL.Keyword (Keyword(..), (|*|)) import qualified Language.SQL.Keyword as SQL import Database.Relational.Internal.String (StringSQL) import Database.Relational.SqlSyntax.Types (AggregateBitKey (..), AggregateSet (..), AggregateElem (..), AggregateColumnRef, AggregateKey (..), ) -- | Single term aggregation element. aggregateColumnRef :: AggregateColumnRef -> AggregateElem aggregateColumnRef = ColumnRef -- | Key of aggregation power set. aggregatePowerKey :: [AggregateColumnRef] -> AggregateBitKey aggregatePowerKey = AggregateBitKey -- | Single grouping set. aggregateGroupingSet :: [AggregateElem] -> AggregateSet aggregateGroupingSet = AggregateSet -- | Rollup aggregation element. aggregateRollup :: [AggregateBitKey] -> AggregateElem aggregateRollup = Rollup -- | Cube aggregation element. aggregateCube :: [AggregateBitKey] -> AggregateElem aggregateCube = Cube -- | Grouping sets aggregation. aggregateSets :: [AggregateSet] -> AggregateElem aggregateSets = GroupingSets 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 -- | Compose GROUP BY clause from AggregateElem list. 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 -- | Compose PARTITION BY clause from AggregateColumnRef list. composePartitionBy :: [AggregateColumnRef] -> StringSQL composePartitionBy = d where d [] = mempty d ts@(_:_) = PARTITION <> BY <> commaed ts -- | Extract typed record from 'AggregateKey'. aggregateKeyRecord :: AggregateKey a -> a aggregateKeyRecord (AggregateKey (p, _c)) = p -- | Extract untyped term from 'AggregateKey'. aggregateKeyElement :: AggregateKey a -> AggregateElem aggregateKeyElement (AggregateKey (_p, c)) = c -- | Unsafely bind typed-record and untyped-term into 'AggregateKey'. unsafeAggregateKey :: (a, AggregateElem) -> AggregateKey a unsafeAggregateKey = AggregateKey