Copyright | 2017 Kei Hibino |
---|---|
License | BSD3 |
Maintainer | ex8k.hibino@gmail.com |
Stability | experimental |
Portability | unknown |
Safe Haskell | None |
Language | Haskell2010 |
Database.Relational.SqlSyntax
Contents
- The SubQuery
- Set operations
- Qualifiers for nested query
- Ordering types
- Aggregating types
- Product tree type
- Case
- Column, Tuple, Record and Projection
- Predicate to restrict Query result
- Interfaces to manipulate ProductTree type
- Sub-query
- Qualified Sub-query
- Sub-query columns
- Tuple and Record
- Query restriction
- Update and Insert assignments
Description
This module is integrated module of sql-syntax.
- data SubQuery
- = Table Untyped
- | Flat Config Tuple Duplication JoinProduct [Predicate Flat] [OrderingTerm]
- | Aggregated Config Tuple Duplication JoinProduct [Predicate Flat] [AggregateElem] [Predicate Aggregated] [OrderingTerm]
- | Bin BinOp SubQuery SubQuery
- data Duplication
- data SetOp
- newtype BinOp = BinOp (SetOp, Duplication)
- newtype Qualifier = Qualifier Int
- data Qualified a = Qualified Qualifier a
- qualifier :: Qualified a -> Qualifier
- unQualify :: Qualified a -> a
- qualify :: Qualifier -> a -> Qualified a
- data Order
- data Nulls
- type OrderColumn = StringSQL
- type OrderingTerm = ((Order, Maybe Nulls), OrderColumn)
- type AggregateColumnRef = StringSQL
- newtype AggregateBitKey = AggregateBitKey [AggregateColumnRef]
- newtype AggregateSet = AggregateSet [AggregateElem]
- data AggregateElem
- newtype AggregateKey a = AggregateKey (a, AggregateElem)
- data NodeAttr
- data ProductTree rs
- data Node rs = Node !NodeAttr !(ProductTree rs)
- nodeAttr :: Node rs -> NodeAttr
- nodeTree :: Node rs -> ProductTree rs
- type JoinProduct = Maybe (ProductTree [Predicate Flat])
- data CaseClause
- data WhenClauses = WhenClauses [(Tuple, Tuple)] Tuple
- data Column
- type Tuple = [Column]
- tupleWidth :: Tuple -> Int
- data Record c t
- untypeRecord :: Record c t -> Tuple
- record :: Tuple -> Record c t
- type PI c a b = Record c a -> Record c b
- recordWidth :: Record c r -> Int
- typeFromRawColumns :: [StringSQL] -> Record c r
- typeFromScalarSubQuery :: SubQuery -> Record c t
- type Predicate c = Record c (Maybe Bool)
- growProduct :: Maybe (Node (DList (Predicate Flat))) -> (NodeAttr, Qualified SubQuery) -> Node (DList (Predicate Flat))
- restrictProduct :: Node (DList (Predicate Flat)) -> Predicate Flat -> Node (DList (Predicate Flat))
- aggregateColumnRef :: AggregateColumnRef -> AggregateElem
- aggregatePowerKey :: [AggregateColumnRef] -> AggregateBitKey
- aggregateGroupingSet :: [AggregateElem] -> AggregateSet
- aggregateRollup :: [AggregateBitKey] -> AggregateElem
- aggregateCube :: [AggregateBitKey] -> AggregateElem
- aggregateSets :: [AggregateSet] -> AggregateElem
- composeGroupBy :: [AggregateElem] -> StringSQL
- composePartitionBy :: [AggregateColumnRef] -> StringSQL
- aggregateKeyRecord :: AggregateKey a -> a
- aggregateKeyElement :: AggregateKey a -> AggregateElem
- unsafeAggregateKey :: (a, AggregateElem) -> AggregateKey a
- flatSubQuery :: Config -> Tuple -> Duplication -> JoinProduct -> [Predicate Flat] -> [OrderingTerm] -> SubQuery
- aggregatedSubQuery :: Config -> Tuple -> Duplication -> JoinProduct -> [Predicate Flat] -> [AggregateElem] -> [Predicate Aggregated] -> [OrderingTerm] -> SubQuery
- union :: Duplication -> SubQuery -> SubQuery -> SubQuery
- except :: Duplication -> SubQuery -> SubQuery -> SubQuery
- intersect :: Duplication -> SubQuery -> SubQuery -> SubQuery
- caseSearch :: [(Predicate c, Record c a)] -> Record c a -> Record c a
- case' :: Record c a -> [(Record c a, Record c b)] -> Record c b -> Record c b
- composeOrderBy :: [OrderingTerm] -> StringSQL
- showSQL :: SubQuery -> StringSQL
- toSQL :: SubQuery -> String
- unitSQL :: SubQuery -> String
- width :: SubQuery -> Int
- queryWidth :: Qualified SubQuery -> Int
- column :: Qualified SubQuery -> Int -> StringSQL
- tupleFromJoinedSubQuery :: Qualified SubQuery -> Tuple
- recordRawColumns :: Record c r -> [StringSQL]
- composeWhere :: [Predicate Flat] -> StringSQL
- composeHaving :: [Predicate Aggregated] -> StringSQL
- type AssignColumn = StringSQL
- type AssignTerm = StringSQL
- type Assignment = (AssignColumn, AssignTerm)
- composeSets :: [Assignment] -> StringSQL
- composeChunkValues :: Int -> [AssignTerm] -> Keyword
- composeChunkValuesWithColumns :: Int -> [Assignment] -> StringSQL
- composeValuesListWithColumns :: [[Assignment]] -> StringSQL
The SubQuery
Sub-query type
Constructors
Set operations
Set binary operators
Constructors
BinOp (SetOp, Duplication) |
Qualifiers for nested query
Qualifier type.
Qualified query.
Ordering types
Order direction. Ascendant or Descendant.
type OrderColumn = StringSQL Source #
Type for order-by column
type OrderingTerm = ((Order, Maybe Nulls), OrderColumn) Source #
Type for order-by term
Aggregating types
type AggregateColumnRef = StringSQL Source #
Type for group-by term
newtype AggregateBitKey Source #
Type for group key.
Constructors
AggregateBitKey [AggregateColumnRef] |
Instances
newtype AggregateSet Source #
Type for grouping set
Constructors
AggregateSet [AggregateElem] |
Instances
data AggregateElem Source #
Type for group-by tree
Constructors
ColumnRef AggregateColumnRef | |
Rollup [AggregateBitKey] | |
Cube [AggregateBitKey] | |
GroupingSets [AggregateSet] |
Instances
Show AggregateElem Source # | |
MonadQualify q m => MonadQualify q (AggregatingSetT m) Source # | Aggregated |
MonadRestrict c m => MonadRestrict c (AggregatingSetT m) Source # | Aggregated |
MonadQuery m => MonadAggregate (AggregatingSetT m) Source # | Aggregated query instance. |
MonadQuery m => MonadQuery (AggregatingSetT m) Source # | Aggregated |
newtype AggregateKey a Source #
Typeful aggregate element.
Constructors
AggregateKey (a, AggregateElem) |
Product tree type
node attribute for product.
data ProductTree rs Source #
Product tree type. Product tree is constructed by left node and right node.
Instances
Functor ProductTree Source # | |
Show rs => Show (ProductTree rs) Source # | |
Product node. node attribute and product tree.
Constructors
Node !NodeAttr !(ProductTree rs) |
nodeTree :: Node rs -> ProductTree rs Source #
Get tree from node.
type JoinProduct = Maybe (ProductTree [Predicate Flat]) Source #
Type for join product of query.
Case
data CaseClause Source #
case clause
Constructors
CaseSearch WhenClauses | |
CaseSimple Tuple WhenClauses |
Instances
Column, Tuple, Record and Projection
Projected column structure unit with single column width
Phantom typed record. Projected into Haskell record type t
.
untypeRecord :: Record c t -> Tuple Source #
Discard record type
Unsafely generate Record
from SQL string list.
typeFromScalarSubQuery :: SubQuery -> Record c t Source #
Unsafely generate Record
from scalar sub-query.
Predicate to restrict Query result
Interfaces to manipulate ProductTree type
Arguments
:: Maybe (Node (DList (Predicate Flat))) | Current tree |
-> (NodeAttr, Qualified SubQuery) | New leaf to push into right |
-> Node (DList (Predicate Flat)) | Result node |
Push new leaf node into product right term.
Arguments
:: Node (DList (Predicate Flat)) | Target node which has product to restrict |
-> Predicate Flat | Restriction to add |
-> Node (DList (Predicate Flat)) | Result node |
Add restriction into top product of product tree node.
aggregateColumnRef :: AggregateColumnRef -> AggregateElem Source #
Single term aggregation element.
aggregatePowerKey :: [AggregateColumnRef] -> AggregateBitKey Source #
Key of aggregation power set.
aggregateGroupingSet :: [AggregateElem] -> AggregateSet Source #
Single grouping set.
aggregateRollup :: [AggregateBitKey] -> AggregateElem Source #
Rollup aggregation element.
aggregateCube :: [AggregateBitKey] -> AggregateElem Source #
Cube aggregation element.
aggregateSets :: [AggregateSet] -> AggregateElem Source #
Grouping sets aggregation.
composeGroupBy :: [AggregateElem] -> StringSQL Source #
Compose GROUP BY clause from AggregateElem list.
composePartitionBy :: [AggregateColumnRef] -> StringSQL Source #
Compose PARTITION BY clause from AggregateColumnRef list.
aggregateKeyRecord :: AggregateKey a -> a Source #
Extract typed record from AggregateKey
.
aggregateKeyElement :: AggregateKey a -> AggregateElem Source #
Extract untyped term from AggregateKey
.
unsafeAggregateKey :: (a, AggregateElem) -> AggregateKey a Source #
Unsafely bind typed-record and untyped-term into AggregateKey
.
flatSubQuery :: Config -> Tuple -> Duplication -> JoinProduct -> [Predicate Flat] -> [OrderingTerm] -> SubQuery Source #
Unsafely generate flat SubQuery
from untyped components.
aggregatedSubQuery :: Config -> Tuple -> Duplication -> JoinProduct -> [Predicate Flat] -> [AggregateElem] -> [Predicate Aggregated] -> [OrderingTerm] -> SubQuery Source #
Unsafely generate aggregated SubQuery
from untyped components.
except :: Duplication -> SubQuery -> SubQuery -> SubQuery Source #
Except binary operator on SubQuery
intersect :: Duplication -> SubQuery -> SubQuery -> SubQuery Source #
Intersect binary operator on SubQuery
Arguments
:: [(Predicate c, Record c a)] | Each when clauses |
-> Record c a | Else result record |
-> Record c a | Result record |
Search case operator correnponding SQL search CASE. Like, CASE WHEN p0 THEN a WHEN p1 THEN b ... ELSE c END
Arguments
:: Record c a | Record value to match |
-> [(Record c a, Record c b)] | Each when clauses |
-> Record c b | Else result record |
-> Record c b | Result record |
Simple case operator correnponding SQL simple CASE. Like, CASE x WHEN v THEN a WHEN w THEN b ... ELSE c END
composeOrderBy :: [OrderingTerm] -> StringSQL Source #
Compose ORDER BY clause from OrderingTerms
Sub-query
Qualified Sub-query
Sub-query columns
Tuple and Record
Get column SQL string list of record.
Query restriction
composeHaving :: [Predicate Aggregated] -> StringSQL Source #
Compose HAVING clause from QueryRestriction
.
Update and Insert assignments
type AssignColumn = StringSQL Source #
Column SQL String of assignment
type AssignTerm = StringSQL Source #
Value SQL String of assignment
type Assignment = (AssignColumn, AssignTerm) Source #
Assignment pair
composeSets :: [Assignment] -> StringSQL Source #
Compose SET clause from [Assignment
].
Arguments
:: Int | record count per chunk |
-> [AssignTerm] | value expression list |
-> Keyword |
Compose VALUES clause from a row of value expressions.
composeChunkValuesWithColumns Source #
Arguments
:: Int | record count per chunk |
-> [Assignment] | |
-> StringSQL |
Compose columns row and VALUES clause from a row of value expressions.
composeValuesListWithColumns :: [[Assignment]] -> StringSQL Source #
Compose columns row and VALUES clause from rows list of value expressions.