Safe Haskell | None |
---|---|
Language | Haskell2010 |
Database.HsSqlPpp.Syntax
Contents
Description
This module contains the ast node data types. They are very permissive, in that they allow a lot of invalid SQL to be represented. The type checking process should catch all invalid trees, but doesn't quite manage at the moment. Sorry about all the seemingly pointless type synonyms below, they are an artefact of using UUAGC. You can see labels for the fields by looking at the ag source here: https://github.com/JakeWheat/hssqlppp/blob/master/src/Database/HsSqlPpp/Internals/AstInternal.ag
- data Name
- data NameComponent
- nameComponents :: Name -> [NameComponent]
- ncStr :: NameComponent -> String
- data TypeName
- data ScalarExpr
- = NumberLit Annotation String
- | StringLit Annotation String
- | NullLit Annotation
- | BooleanLit Annotation Bool
- | TypedStringLit Annotation TypeName String
- | Interval Annotation String IntervalField (Maybe Int)
- | Identifier Annotation Name
- | Star Annotation
- | QStar Annotation NameComponent
- | PositionalArg Annotation Integer
- | Placeholder Annotation
- | PrefixOp Annotation Name ScalarExpr
- | PostfixOp Annotation Name ScalarExpr
- | BinaryOp Annotation Name ScalarExpr ScalarExpr
- | SpecialOp Annotation Name ScalarExprList
- | Extract Annotation ExtractField ScalarExpr
- | App Annotation Name ScalarExprList
- | AggregateApp Annotation Distinct ScalarExpr ScalarExprDirectionPairList
- | WindowApp Annotation ScalarExpr ScalarExprList ScalarExprDirectionPairList (Maybe FrameClause)
- | Cast Annotation ScalarExpr TypeName
- | ImplicitCast Annotation ScalarExpr TypeExtra
- | Case Annotation CaseScalarExprListScalarExprPairList MaybeScalarExpr
- | CaseSimple Annotation ScalarExpr CaseScalarExprListScalarExprPairList MaybeScalarExpr
- | Parens Annotation ScalarExpr
- | InPredicate Annotation ScalarExpr Bool InList
- | Exists Annotation QueryExpr
- | ScalarSubQuery Annotation QueryExpr
- | LiftApp Annotation Name LiftFlavour ScalarExprList
- | OdbcLiteral Annotation OdbcLiteralType String
- | OdbcFunc Annotation ScalarExpr
- | AntiScalarExpr String
- data InList
- = InList Annotation ScalarExprList
- | InQueryExpr Annotation QueryExpr
- data LiftFlavour
- data Direction
- data NullsOrder
- data Distinct
- data CombineType
- data IntervalField
- data ExtractField
- = ExtractCentury
- | ExtractDay
- | ExtractDecade
- | ExtractDow
- | ExtractDoy
- | ExtractEpoch
- | ExtractHour
- | ExtractIsodow
- | ExtractIsoyear
- | ExtractMicroseconds
- | ExtractMillennium
- | ExtractMilliseconds
- | ExtractMinute
- | ExtractMonth
- | ExtractQuarter
- | ExtractSecond
- | ExtractTimezone
- | ExtractTimezoneHour
- | ExtractTimezoneMinute
- | ExtractWeek
- | ExtractYear
- data FrameClause
- data OdbcLiteralType
- = OLDate
- | OLTime
- | OLTimestamp
- data QueryExpr
- = Select {
- ann :: Annotation
- selDistinct :: Distinct
- selSelectList :: SelectList
- selTref :: TableRefList
- selWhere :: MaybeBoolExpr
- selGroupBy :: ScalarExprList
- selHaving :: MaybeBoolExpr
- selOrderBy :: ScalarExprDirectionPairList
- selLimit :: MaybeScalarExpr
- selOffset :: MaybeScalarExpr
- selOption :: [QueryHint]
- | CombineQueryExpr {
- ann :: Annotation
- cqType :: CombineType
- cqQe0 :: QueryExpr
- cqQe1 :: QueryExpr
- | Values {
- ann :: Annotation
- qeValues :: ScalarExprListList
- | WithQueryExpr {
- ann :: Annotation
- withs :: WithQueryList
- withQe :: QueryExpr
- = Select {
- makeSelect :: QueryExpr
- data WithQuery = WithQuery Annotation NameComponent (Maybe [NameComponent]) QueryExpr
- data SelectList = SelectList Annotation SelectItemList
- data SelectItem
- data TableRef
- = Tref Annotation Name
- | FunTref Annotation ScalarExpr
- | SubTref Annotation QueryExpr
- | JoinTref Annotation TableRef Natural JoinType (Maybe JoinHint) TableRef OnExpr
- | TableAlias Annotation NameComponent TableRef
- | FullAlias Annotation NameComponent [NameComponent] TableRef
- | TableRefParens Annotation TableRef
- | OdbcTableRef Annotation TableRef
- data JoinExpr
- data JoinType
- = Inner
- | LeftOuter
- | RightOuter
- | FullOuter
- | Cross
- data JoinHint
- data QueryHint
- type OnExpr = Maybe JoinExpr
- data Natural
- data Statement
- = QueryStatement Annotation QueryExpr
- | Insert Annotation Name [NameComponent] QueryExpr MaybeSelectList
- | Update Annotation Name SetClauseList TableRefList MaybeBoolExpr MaybeSelectList
- | Delete Annotation Name TableRefList MaybeBoolExpr MaybeSelectList
- | CopyFrom Annotation Name [NameComponent] CopyFromSource [CopyFromOption]
- | CopyData Annotation String
- | CopyTo Annotation CopyToSource String [CopyToOption]
- | Truncate Annotation [Name] RestartIdentity Cascade
- | CreateTable Annotation Name AttributeDefList ConstraintList MaybeTablePartitionDef Replace
- | AlterTable Annotation Name AlterTableOperation
- | AlterDatabase Annotation Name AlterDatabaseOperation
- | CreateSequence Annotation Name Integer (Maybe Integer) (Maybe Integer) Integer Integer
- | AlterSequence Annotation Name AlterSequenceOperation
- | CreateTableAs Annotation Name Replace QueryExpr
- | CreateView Annotation Name MaybeNameComponentList QueryExpr
- | AlterView Annotation Name MaybeNameComponentList QueryExpr
- | CreateType Annotation Name TypeAttributeDefList
- | CreateUser Annotation Name String
- | CreateLogin Annotation Name String
- | AlterUser Annotation Name String
- | AlterLogin Annotation Name String
- | CreateSchema Annotation NameComponent (Maybe Name)
- | AlterSchema Annotation NameComponent AlterSchemaOperation
- | CreateFunction Annotation Name ParamDefList TypeName Replace Language FnBody Volatility
- | CreateDomain Annotation Name TypeName String MaybeBoolExpr
- | CreateLanguage Annotation String
- | CreateTrigger Annotation NameComponent TriggerWhen [TriggerEvent] Name TriggerFire Name ScalarExprList
- | DropFunction Annotation IfExists NameTypeNameListPairList Cascade
- | DropSomething Annotation DropType IfExists [Name] Cascade
- | DropTrigger Annotation IfExists NameComponent Name Cascade
- | CreateDatabase Annotation Name
- | Set Annotation String [SetValue]
- | Notify Annotation String
- | Into Annotation Bool [Name] Statement
- | Assignment Annotation Name ScalarExpr
- | Return Annotation MaybeScalarExpr
- | ReturnNext Annotation ScalarExpr
- | ReturnQuery Annotation QueryExpr
- | Raise Annotation RaiseType String ScalarExprList
- | NullStatement Annotation
- | Perform Annotation ScalarExpr
- | Execute Annotation ScalarExpr
- | ForQueryStatement Annotation (Maybe String) NameComponent QueryExpr StatementList
- | ForIntegerStatement Annotation (Maybe String) NameComponent ScalarExpr ScalarExpr StatementList
- | LoopStatement Annotation (Maybe String) StatementList
- | WhileStatement Annotation (Maybe String) ScalarExpr StatementList
- | ContinueStatement Annotation (Maybe String)
- | ExitStatement Annotation (Maybe String)
- | CaseStatementSimple Annotation ScalarExpr ScalarExprListStatementListTripleList StatementList
- | CaseStatement Annotation ScalarExprListStatementListTripleList StatementList
- | If Annotation ScalarExprStatementListPairList StatementList
- | Block Annotation (Maybe String) VarDefList StatementList
- | AntiStatement String
- | DeclareStatement Annotation [(String, TypeName, Maybe ScalarExpr)]
- | ExecStatement Annotation Name ScalarExprList
- | CreateIndexTSQL Annotation NameComponent Name [NameComponent]
- data CopyToSource
- data CopyFromSource
- data CopyToOption
- data CopyFromOption
- data SetClause
- data AttributeDef = AttributeDef Annotation NameComponent TypeName MaybeScalarExpr RowConstraintList
- data RowConstraint
- = NullConstraint Annotation String
- | NotNullConstraint Annotation String
- | IdentityConstraint Annotation String (Maybe (Integer, Integer))
- | RowCheckConstraint Annotation String ScalarExpr
- | RowUniqueConstraint Annotation String
- | RowPrimaryKeyConstraint Annotation String
- | RowReferenceConstraint Annotation String Name (Maybe NameComponent) Cascade Cascade
- data Constraint
- data TablePartitionDef = TablePartitionDef Annotation NameComponent Integer TablePartitionDateTimeInterval
- data TablePartitionDateTimeInterval
- data TypeAttributeDef = TypeAttDef Annotation NameComponent TypeName
- data AlterDatabaseOperation = RenameDatabase Annotation Name
- data AlterSchemaOperation
- data AlterTableOperation
- = RenameTable Annotation Name
- | RenameColumn Annotation NameComponent NameComponent
- | AlterTableActions Annotation AlterTableActionList
- data AlterTableAction
- data AlterSequenceOperation
- = AlterSequenceOwned Annotation Name
- | AlterSequenceRename Annotation Name
- | AlterSequenceActions Annotation AlterSequenceActionList
- data AlterSequenceAction
- data AlterColumnAction
- data TriggerWhen
- data TriggerEvent
- data TriggerFire
- data DropType
- data Cascade
- data IfExists
- data RestartIdentity
- data Replace
- data Volatility
- data Language
- data FnBody
- = SqlFnBody Annotation StatementList
- | PlpgsqlFnBody Annotation Statement
- data ParamDef
- data VarDef
- data RaiseType
- = RNotice
- | RException
- | RError
- data SetValue
Name and TypeName
Constructors
Name Annotation [NameComponent] | |
AntiName String |
data NameComponent Source #
Instances
nameComponents :: Name -> [NameComponent] Source #
ncStr :: NameComponent -> String Source #
Scalar expressions
data ScalarExpr Source #
Constructors
Instances
Constructors
InList Annotation ScalarExprList | |
InQueryExpr Annotation QueryExpr |
data LiftFlavour Source #
Instances
data CombineType Source #
Instances
data IntervalField Source #
Constructors
Instances
data ExtractField Source #
Constructors
Instances
data FrameClause Source #
Instances
Query expressions
Constructors
Select | |
Fields
| |
CombineQueryExpr | |
Fields
| |
Values | |
Fields
| |
WithQueryExpr | |
Fields
|
makeSelect :: QueryExpr Source #
'default' valued select, use for creating select values
makeSelect :: QueryExpr makeSelect = Select {ann = emptyAnnotation ,selDistinct = All ,selSelectList = (SelectList emptyAnnotation []) ,selTref = [] ,selWhere = Nothing ,selGroupBy = [] ,selHaving = Nothing ,selOrderBy = [] ,selLimit = Nothing ,selOffset = Nothing ,selOption = []}
On its own, it isn't valid syntax: to use it you have to replace the select list at minimum
use something like this
s = makeSelect {selSelectList = sl [se $ i "a"] ,selTref = [tref "t"]} where a = emptyAnnotation sl = SelectList a se = SelExp a i = Identifier a tref t = Tref a (Name a [Nmc t])
Constructors
WithQuery Annotation NameComponent (Maybe [NameComponent]) QueryExpr |
data SelectItem Source #
Constructors
SelExp Annotation ScalarExpr | |
SelectItem Annotation ScalarExpr NameComponent |
Instances
Constructors
Constructors
JoinOn Annotation ScalarExpr | |
JoinUsing Annotation [NameComponent] |
Constructors
Inner | |
LeftOuter | |
RightOuter | |
FullOuter | |
Cross |
Constructors
QueryHintPartitionGroup | |
QueryHintColumnarHostGroup |
Statements
Constructors
dml components
data CopyToOption Source #
Constructors
CopyToFormat String | |
CopyToDelimiter String | |
CopyToErrorLog String | |
CopyToErrorVerbosity Int |
Instances
data CopyFromOption Source #
Constructors
Instances
ddl components
data AttributeDef Source #
Constructors
AttributeDef Annotation NameComponent TypeName MaybeScalarExpr RowConstraintList |
Instances
data RowConstraint Source #
Constructors
Instances
data Constraint Source #
Constructors
Instances
data TablePartitionDef Source #
Instances
data AlterDatabaseOperation Source #
Constructors
RenameDatabase Annotation Name |
data AlterSchemaOperation Source #
Constructors
AlterSchemaName Annotation NameComponent | |
AlterSchemaOwner Annotation Name |
data AlterTableOperation Source #
Constructors
RenameTable Annotation Name | |
RenameColumn Annotation NameComponent NameComponent | |
AlterTableActions Annotation AlterTableActionList |
data AlterTableAction Source #
Constructors
AddColumn Annotation AttributeDef | |
DropColumn Annotation NameComponent | |
AlterColumn Annotation NameComponent AlterColumnAction | |
AddConstraint Annotation Constraint |
Instances
data AlterSequenceOperation Source #
Constructors
AlterSequenceOwned Annotation Name | |
AlterSequenceRename Annotation Name | |
AlterSequenceActions Annotation AlterSequenceActionList |
data AlterSequenceAction Source #
data AlterColumnAction Source #
run canonicalizeTypeName on all the TypeName nodes in an ast
Constructors
SetDataType Annotation TypeName | |
SetNotNull Annotation | |
DropNotNull Annotation | |
SetDefault Annotation ScalarExpr | |
DropDefault Annotation |
Instances
function ddl components
data Volatility Source #
Instances
Constructors
SqlFnBody Annotation StatementList | |
PlpgsqlFnBody Annotation Statement |
PlPgsql components
Constructors
ParamDef Annotation NameComponent TypeName | |
ParamDefTp Annotation TypeName |
Constructors
RNotice | |
RException | |
RError |
utility
Constructors
SetStr Annotation String | |
SetId Annotation String | |
SetNum Annotation Double |