module Database.Relational.SqlSyntax.Types (
SubQuery (..),
Duplication (..), SetOp (..), BinOp (..),
Qualifier (..), Qualified (..), qualifier, unQualify, qualify,
Order (..), Nulls (..), OrderColumn, OrderingTerm,
AggregateColumnRef,
AggregateBitKey (..), AggregateSet (..), AggregateElem (..),
AggregateKey (..),
NodeAttr (..), ProductTree (..),
Node (..), nodeAttr, nodeTree,
JoinProduct,
CaseClause (..), WhenClauses(..),
Column (..), Tuple, tupleWidth,
Record, untypeRecord, record, PI,
recordWidth,
typeFromRawColumns,
typeFromScalarSubQuery,
Predicate,
) where
import Prelude hiding (and, product)
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
import Database.Relational.Internal.Config (Config)
import Database.Relational.Internal.ContextType (Flat, Aggregated)
import Database.Relational.Internal.String (StringSQL)
import Database.Relational.Internal.UntypedTable (Untyped)
data Duplication = All | Distinct deriving Show
data SetOp = Union | Except | Intersect deriving Show
newtype BinOp = BinOp (SetOp, Duplication) deriving Show
data Order = Asc | Desc deriving Show
data Nulls = NullsFirst | NullsLast deriving Show
type OrderColumn = StringSQL
type OrderingTerm = ((Order, Maybe Nulls), OrderColumn)
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)
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
deriving Show
newtype Qualifier = Qualifier Int deriving Show
data Qualified a =
Qualified Qualifier a
deriving (Show, Functor, Foldable, Traversable)
qualifier :: Qualified a -> Qualifier
qualifier (Qualified q _) = q
unQualify :: Qualified a -> a
unQualify (Qualified _ a) = a
qualify :: Qualifier -> a -> Qualified a
qualify = Qualified
data NodeAttr = Just' | Maybe deriving Show
type QS = Qualified SubQuery
data ProductTree rs
= Leaf QS
| Join !(Node rs) !(Node rs) !rs
deriving (Show, Functor)
data Node rs = Node !NodeAttr !(ProductTree rs) deriving (Show, Functor)
nodeAttr :: Node rs -> NodeAttr
nodeAttr (Node a _) = a where
nodeTree :: Node rs -> ProductTree rs
nodeTree (Node _ t) = t
type JoinProduct = Maybe (ProductTree [Predicate Flat])
data WhenClauses =
WhenClauses [(Tuple, Tuple)] Tuple
deriving Show
data CaseClause
= CaseSearch WhenClauses
| CaseSimple Tuple WhenClauses
deriving Show
data Column
= RawColumn StringSQL
| SubQueryRef (Qualified Int)
| Scalar SubQuery
| Case CaseClause Int
deriving Show
type Tuple = [Column]
tupleWidth :: Tuple -> Int
tupleWidth = length
newtype Record c t =
Record
{ untypeRecord :: Tuple } deriving Show
type Predicate c = Record c (Maybe Bool)
type PI c a b = Record c a -> Record c b
record :: Tuple -> Record c t
record = Record
recordWidth :: Record c r -> Int
recordWidth = length . untypeRecord
typeFromRawColumns :: [StringSQL]
-> Record c r
typeFromRawColumns = record . map RawColumn
typeFromScalarSubQuery :: SubQuery -> Record c t
typeFromScalarSubQuery = record . (:[]) . Scalar