optpragmas { {-# LANGUAGE TupleSections,ScopedTypeVariables,DeriveDataTypeable,OverloadedStrings #-} } {- This file contains the ast nodes definitions. It uses uuagc. * http://www.cs.uu.nl/wiki/bin/view/HUT/AttributeGrammarSystem * http://www.haskell.org/haskellwiki/The_Monad.Reader/Issue4/Why_Attribute_Grammars_Matter The attr and sem definitions are in TypeChecking.ag and the other .ag files, which are included into this file. see here for how to compile: http://jakewheat.github.com/hssqlppp/devel.txt.html -} module {Database.HsSqlPpp.Internals.AstInternal} { --from the ag files: --ast nodes Statement (..) ,QueryExpr (..) ,WithQueryList ,WithQuery(..) ,FnBody (..) ,SetClause (..) ,SetClauseList ,TableRef (..) ,JoinExpr (..) ,JoinType (..) ,JoinHint (..) ,SelectList (..) ,SelectItem (..) ,CopyFromSource (..) ,CopyToSource(..) ,CopyToOption(..) ,CopyFromOption(..) ,TablePartitionDef(..) ,TablePartitionDateTimeInterval(..) ,AttributeDef (..) ,RowConstraint (..) ,TableOption(..) ,AlterDatabaseOperation(..) ,AlterTableOperation(..) ,AlterTableAction(..) ,AlterSequenceOperation(..) ,AlterSequenceAction(..) ,AlterColumnAction(..) ,AlterSchemaOperation(..) ,Constraint (..) ,TypeAttributeDef (..) ,ParamDef (..) ,VarDef (..) ,RaiseType (..) ,CombineType (..) ,Volatility (..) ,Language (..) ,TypeName (..) ,DropType (..) ,Cascade (..) ,Direction (..) ,Distinct (..) ,NullsOrder(..) ,Natural (..) ,IfExists (..) ,Replace(..) ,RestartIdentity (..) ,ScalarExpr (..) ,Name(..) ,nameComponents ,NameComponent(..) ,ncStr ,IntervalField(..) ,ExtractField(..) ,FrameClause(..) ,OdbcLiteralType(..) ,InList (..) ,LiftFlavour(..) ,TriggerWhen(..) ,TriggerEvent(..) ,TriggerFire(..) ,QueryHint(..) ,StatementList ,ScalarExprListStatementListTripleList ,ScalarExprListStatementListTriple ,ScalarExprList ,ParamDefList ,AttributeDefList ,ConstraintList ,TypeAttributeDefList ,TypeNameList ,NameTypeNameListPair ,NameTypeNameListPairList ,ScalarExprStatementListPairList --,SetClauseList ,CaseScalarExprListScalarExprPairList ,MaybeScalarExpr ,TableRefList ,ScalarExprListList ,SelectItemList ,OnExpr ,RowConstraintList ,VarDefList ,ScalarExprStatementListPair ,CaseScalarExprListScalarExprPair ,ScalarExprDirectionPair ,ScalarExprDirectionPairList ,MaybeBoolExpr ,MaybeSelectList ,SetValue(..) ,AlterTableActionList ,NameComponentList ,MaybeNameComponentList -- typechecking ,typeCheckStatements --,typeCheckParameterizedStatement ,typeCheckScalarExpr --,typeCheckScalarExprEnv ,typeCheckQueryExpr ,TypeCheckFlags(..) ,addExplicitCasts ,addImplicitCasts -- annotation ,Annotation(..) --,TypeExtra(..) ,SourcePosition ,ParameterizedStatementType ,getAnnotation ,updateAnnotation ,emptyAnnotation ,makeSelect --,canonicalizeTypeNames } { --import Data.Maybe --import Data.Either --import Data.List --import Control.Applicative import Data.Data --import Data.Char --import Control.Monad.State --import Control.Arrow import Data.Generics import Data.Generics.Uniplate.Data --import Debug.Trace --import Text.Show.Pretty --import Database.HsSqlPpp.Internals.TypesInternal --import Database.HsSqlPpp.Internals.TypeChecking.TypeConversion --import Database.HsSqlPpp.Internals.TypeChecking.Environment hiding (JoinType(..)) --import Database.HsSqlPpp.Internals.Catalog.CatalogInternal (NameComponent(..),ncStr) --import Database.HsSqlPpp.Utils.Utils --import Database.HsSqlPpp.Internals.Dialect --import Data.Text (Text) import qualified Data.Text as T --import qualified Data.Text.Lazy as LT -- very bad, we use types in the syntax outside of the already exception -- in the annotation (which can be removed when the annotation type -- becomes a type parameters -- can replace the use of type extra with (typename,int,int) triple -- to fix this --import Database.HsSqlPpp.Internals.TypesInternal (TypeExtra) } {- ---------------------------------------------------- = TOC of this file * ScalarExprs * QueryExprs * Statements * DML extras * DDL/ utility extras * PlPgsql extras ------------------------------------------------------------- = ScalarExprs Doesn't follow the syntax of postgres exactly, here is a rough table of equivalents pg here -- ---- constant/literal integerlit, floatlit, unknownstringlit, nulllit, boollit column reference identifier positional parameter reference positionalarg subscripted expression specialop field selection expression identifier/binaryop "." normal operator invocation binaryop,prefixop,postfixop special operators (e.g. between) specialop function call app aggregate expression app/ aggregate app window function call windowapp type cast cast scalar subquery scalarsubquery other subquery in scalar context scalarsubquery array constructor specialop row constructor specialop Anything that is represented in the ast as some sort of name plus a list of expressions as arguments is mostly treated as App if it looks mostly like [Identifier](csv of args). Operators are represented by binaryop, prefixop, postfix op. Keyword operators and other non regular syntax are represented using binaryop,prefixop,postfixop if they look like an operator call with text instead of symbols, and specialop otherwise. This includes keyword operators e.g. and, like (ones which can be parsed as normal syntactic operators) unusual syntax operators, e.g. between unusual syntax function calls e.g. substring(x from 5 for 3) arrayctors e.g. array[3,5,6] rowctors e.g. ROW (2,4,6) array subscripting list of keyword operators (regular prefix, infix and postfix):: and, or, not is null, is not null, isnull, notnull is distinct from, is not distinct from is true, is not true,is false, is not false, is unknown, is not unknown like, not like, ilike, not ilike similar to, not similar to in, not in (don't include these here since the argument isn't always an expr) unusual syntax operators and fn calls between, not between, between symmetric overlay, substring, trim any, some, all Some of unusual syntax forms and keywords operators are not yet supported Keyword operators are represented in the ast using the operator constructors, e.g. operator 'and' -> BinaryOp "and" Lots of invalid expressions can be expressed using this type. -} {- TODO: run through each ctor in ssp change the syntax if different port over the parsing get typechecking working for each in ansi mode when get to escape,uescape: fix these in ssp -} data ScalarExpr | NumberLit ann::Annotation d::String | StringLit ann::Annotation value :: String | NullLit ann::Annotation | BooleanLit ann::Annotation b::Bool | TypedStringLit ann::Annotation tn :: TypeName value :: String | Interval ann::Annotation value :: String field :: IntervalField prec :: {Maybe Int} {- > | IntervalLit > {ilSign :: Maybe Bool -- ^ true if + used, false if - used > ,ilLiteral :: String -- ^ literal text > ,ilFrom :: IntervalTypeField > ,ilTo :: Maybe IntervalTypeField > } -} -- the parser produces an identifier when all the -- components are quoted or unquoted name components -- when there are parens or other expressions in the -- mix it produces binaryop "." -- probably should just support both for pretty printing -- and for typechecking | Identifier ann::Annotation -- e.g. tbl i::Name | Star ann::Annotation -- todo: remove this, represent using binary op . | QStar ann::Annotation q::NameComponent -- e.g. a.* | PositionalArg ann::Annotation p::Integer | Placeholder ann::Annotation -- represents a '?' {- > | HostParameter String (Maybe String) -- ^ represents a host > -- parameter, e.g. :a. The > -- Maybe String is for the > -- indicator, e.g. :var > -- indicator :nl -} -- operator variants are used for regular looking -- prefix, postfix and binary operators, -- and for keyword operators which fit regular pattern -- also | PrefixOp ann :: Annotation opName :: Name arg :: ScalarExpr | PostfixOp ann :: Annotation opName :: Name arg :: ScalarExpr | BinaryOp ann :: Annotation opName :: Name arg0 :: ScalarExpr arg1 :: ScalarExpr -- built in operators, keywords operators, etc. which don't -- look like pref/post/bin ops | SpecialOp ann :: Annotation opName :: Name -- change this to a sum type? args::ScalarExprList {- > -- | Used for the operators which look like functions > -- except the arguments are separated by keywords instead > -- of commas. The maybe is for the first unnamed argument > -- if it is present, and the list is for the keyword argument > -- pairs. > | SpecialOpK [Name] (Maybe ValueExpr) [(String,ValueExpr)] -} | Extract ann::Annotation field :: ExtractField e :: ScalarExpr -- App variations -- app is used for regular function calls | App ann::Annotation funName::Name args::ScalarExprList -- aggregate calls can also have a distinct -- and an order by list as well as a regular function -- call looking part. The fn :: ScalarExpr -- should always be an App | AggregateApp ann::Annotation aggDistinct :: Distinct fn :: ScalarExpr orderBy :: ScalarExprDirectionPairList -- similar comments as aggregate, the fn :: ScalarExpr -- should always be an App | WindowApp ann::Annotation fn :: ScalarExpr partitionBy :: ScalarExprList orderBy :: ScalarExprDirectionPairList frm :: {Maybe FrameClause} {- > -- | aggregate application, which adds distinct or all, and > -- order by, to regular function application > | AggregateApp > {aggName :: [Name] -- ^ aggregate function name > ,aggDistinct :: SetQuantifier -- ^ distinct > ,aggArgs :: [ValueExpr]-- ^ args > ,aggOrderBy :: [SortSpec] -- ^ order by > ,aggFilter :: Maybe ValueExpr -- ^ filter > } > -- | aggregates with within group > | AggregateAppGroup > {aggName :: [Name] -- ^ aggregate function name > ,aggArgs :: [ValueExpr] -- ^ args > ,aggGroup :: [SortSpec] -- ^ within group > } > -- | window application, which adds over (partition by a order > -- by b) to regular function application. Explicit frames are > -- not currently supported > | WindowApp > {wnName :: [Name] -- ^ window function name > ,wnArgs :: [ValueExpr] -- ^ args > ,wnPartition :: [ValueExpr] -- ^ partition by > ,wnOrderBy :: [SortSpec] -- ^ order by > ,wnFrame :: Maybe Frame -- ^ frame clause > } -} | Cast ann::Annotation expr::ScalarExpr tn::TypeName -- todo: replace implicit cast with something in annotation -- the idea is to represent casts which were added by desugaring -- differently to normal casts -- and to use this to track changes to the -- nullability, precision or scale | ImplicitCast ann::Annotation expr::ScalarExpr te::TypeExtra -- case: the 'then' parts are boolean valued checks | Case ann::Annotation cases :: CaseScalarExprListScalarExprPairList els :: MaybeScalarExpr -- case simple: supply a comparison value, -- the 'then' parts are the same type as this value | CaseSimple ann::Annotation value :: ScalarExpr cases :: CaseScalarExprListScalarExprPairList els :: MaybeScalarExpr {- > -- | case expression. both flavours supported > | Case > {caseTest :: Maybe ValueExpr -- ^ test value > ,caseWhens :: [([ValueExpr],ValueExpr)] -- ^ when branches > ,caseElse :: Maybe ValueExpr -- ^ else value > } -} | Parens ann::Annotation ex :: ScalarExpr {- > -- | in list literal and in subquery, if the bool is false it > -- means not in was used ('a not in (1,2)') > | In Bool ValueExpr InPredValue -} -- represents in query or in list | InPredicate ann::Annotation expr::ScalarExpr i::Bool list::InList {- > -- | exists, all, any, some subqueries > | SubQueryExpr SubQueryExprType QueryExpr > | QuantifiedComparison > ValueExpr > [Name] -- operator > CompPredQuantifier > QueryExpr > | Match ValueExpr Bool -- true if unique > QueryExpr -} | Exists ann::Annotation sel :: QueryExpr -- scalar meaning appearing in a scalar context not -- scalar valued query expr | ScalarSubQuery ann::Annotation sel :: QueryExpr -- lift app: e.g. x = any (a,2,4) | LiftApp ann::Annotation oper::Name flav::LiftFlavour args::ScalarExprList {- > | Array ValueExpr [ValueExpr] -- ^ represents an array > -- access expression, or an array ctor > -- e.g. a[3]. The first > -- valueExpr is the array, the > -- second is the subscripts/ctor args > | ArrayCtor QueryExpr -- ^ this is used for the query expression version of array constructors, e.g. array(select * from t) > | Collate ValueExpr [Name] > | MultisetBinOp ValueExpr CombineOp SetQuantifier ValueExpr > | MultisetCtor [ValueExpr] > | MultisetQueryCtor QueryExpr > | NextValueFor [Name] -} -- an odbc date/time literal -- e.g. {d '2005-01-01} -- see the odbc tests | OdbcLiteral ann :: Annotation olt :: OdbcLiteralType val :: String -- parses an odbc function call -- it wraps a scalarexpr because we can write -- {fn extract(day from x)} -- as well as regular functions -- maybe this should be a special case since there is -- only one? | OdbcFunc ann :: Annotation ex :: ScalarExpr | AntiScalarExpr String {- == Name and TypeName name could be designed better: the name component list should not be empty -} data Name | Name ann::Annotation is::{[NameComponent]} | AntiName String { nameComponents :: Name -> [NameComponent] nameComponents (Name _ is) = is -- todo: don't use error nameComponents (AntiName _) = error "tried to get namecomponents of antiname" } data TypeName | SimpleTypeName ann::Annotation tn::Name | PrecTypeName ann::Annotation tn::Name prec::Integer | Prec2TypeName ann::Annotation tn::Name prec::Integer prec1::Integer | ArrayTypeName ann::Annotation typ::TypeName | SetOfTypeName ann::Annotation typ::TypeName {- == additional data types for scalar exprs -} --todo: use liftoperator to represent inlist? data InList | InList ann::Annotation exprs :: ScalarExprList | InQueryExpr ann::Annotation sel :: QueryExpr { data LiftFlavour = LiftAny | LiftAll deriving (Show,Eq,Typeable,Data) data Direction = Asc | Desc deriving (Show,Eq,Typeable,Data) data NullsOrder = NullsDefault | NullsFirst | NullsLast deriving (Show,Eq,Typeable,Data) data Distinct = Distinct | All deriving (Show,Eq,Typeable,Data) -- maybe should improve this, since you can have at least union -- distinct and union all just like select distinct and select all data CombineType = Except | Union | Intersect | UnionAll deriving (Show,Eq,Typeable,Data) data IntervalField = IntervalYear | IntervalMonth | IntervalDay | IntervalHour | IntervalMinute | IntervalSecond | IntervalYearToMonth | IntervalDayToHour | IntervalDayToMinute | IntervalDayToSecond | IntervalHourToMinute | IntervalHourToSecond | IntervalMinuteToSecond deriving (Show,Eq,Typeable,Data) data ExtractField = ExtractCentury | ExtractDay | ExtractDecade | ExtractDow | ExtractDoy | ExtractEpoch | ExtractHour | ExtractIsodow | ExtractIsoyear | ExtractMicroseconds | ExtractMillennium | ExtractMilliseconds | ExtractMinute | ExtractMonth | ExtractQuarter | ExtractSecond | ExtractTimezone | ExtractTimezoneHour | ExtractTimezoneMinute | ExtractWeek | ExtractYear deriving (Show,Eq,Typeable,Data) -- todo: this needs fixing, it is currently based on limited frame options data FrameClause = FrameUnboundedPreceding | FrameUnboundedFull | FrameRowsUnboundedPreceding deriving (Show,Eq,Typeable,Data) data OdbcLiteralType = OLDate | OLTime | OLTimestamp deriving (Show,Eq,Typeable,Data) } {- ----------------------------------------------------------- = query expressions -} 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 -- todo: represent parens explicitly in queryexpr -- | QueryExprParens ex:: QueryExpr type WithQueryList = [WithQuery] data WithQuery | WithQuery ann :: Annotation name :: NameComponent colAliases :: {Maybe [NameComponent]} ex :: QueryExpr {- == Select lists -} data SelectList | SelectList ann::Annotation items::SelectItemList data SelectItem | SelExp ann::Annotation ex::ScalarExpr | SelectItem ann::Annotation ex::ScalarExpr name::NameComponent {- == Tablerefs -} data TableRef | Tref ann::Annotation tbl::Name | FunTref ann::Annotation fn::ScalarExpr | SubTref ann::Annotation sel :: QueryExpr | JoinTref ann::Annotation tref0 :: TableRef nat :: Natural joinType :: JoinType joinHint :: {Maybe JoinHint} tref1 :: TableRef onExpr :: OnExpr | TableAlias ann::Annotation tb::NameComponent tref::TableRef | FullAlias ann::Annotation tb::NameComponent cols::{[NameComponent]} tref::TableRef | TableRefParens ann::Annotation tref::TableRef -- represents e.g. {oj t1 left join t2} -- see the odbc tests for more info | OdbcTableRef ann::Annotation tref::TableRef data JoinExpr | JoinOn ann::Annotation expr::ScalarExpr | JoinUsing ann::Annotation x::{[NameComponent]} { data JoinType = Inner | LeftOuter| RightOuter | FullOuter | Cross deriving (Show,Eq,Typeable,Data) data JoinHint = Loop | Hash | Merge deriving (Show,Eq,Typeable,Data) data Natural = Natural | Unnatural deriving (Show,Eq,Typeable,Data) } {- == other queryexpr support types -} -- TODO: maybe rename makeSelect to something better? { -- | '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]) makeSelect :: QueryExpr makeSelect = Select {ann = emptyAnnotation ,selDistinct = All ,selSelectList = (SelectList emptyAnnotation []) ,selTref = [] ,selWhere = Nothing ,selGroupBy = [] ,selHaving = Nothing ,selOrderBy = [] ,selLimit = Nothing ,selOffset = Nothing ,selOption = []} } {- ------------------------------------------------- = SQL top level statements everything is chucked in here: dml, ddl, plpgsql statements todo: maybe split plpgsql out would be nice to have crud and ddl separate, but also quite tedious possible categories: queryexpr: already supported crudStatement: querystatement, insert, update, delete, truncate, copy, ...? sqlStatement: crudStatement | ddl stuff plpgsqlStatement = sqlStatement | plpgsql stuff would this be worth it? Think best compromise is just sql and plpgsql split because might want utility statements mixed up with sql statements (e.g. set, transaction stuff) might want plpgsql without ddl etc. too many variants to produce a sane set of types -} data Statement --queries | QueryStatement ann::Annotation ex::QueryExpr -- dml --table targetcolumns insertdata(values or select statement) returning | Insert ann::Annotation table :: Name targetCols :: {[NameComponent]} insData :: QueryExpr returning :: MaybeSelectList --tablename setitems where returning | Update ann::Annotation table :: Name assigns :: SetClauseList fromList :: TableRefList whr :: MaybeBoolExpr returning :: MaybeSelectList --tablename, where, returning | Delete ann::Annotation table :: Name using :: TableRefList whr :: MaybeBoolExpr returning :: MaybeSelectList --tablename column names, from | CopyFrom ann::Annotation table :: Name targetCols :: {[NameComponent]} source :: CopyFromSource opts :: {[CopyFromOption]} --represents inline data for copy statement | CopyData ann::Annotation insData :: String | CopyTo ann :: Annotation cp :: CopyToSource fn :: String opts :: {[CopyToOption]} | Truncate ann::Annotation tables:: {[Name]} restartIdentity :: RestartIdentity cascade :: Cascade -- ddl | CreateTable ann::Annotation name :: Name atts :: AttributeDefList cons :: ConstraintList partition :: MaybeTablePartitionDef rep :: Replace options :: {[TableOption]} | AlterTable ann::Annotation name :: Name operation :: AlterTableOperation | AlterDatabase ann::Annotation name :: Name operation :: AlterDatabaseOperation | CreateSequence ann::Annotation name::Name incr::Integer min::{Maybe Integer} max::{Maybe Integer} start::Integer cache::Integer | AlterSequence ann::Annotation name::Name operation :: AlterSequenceOperation | CreateTableAs ann::Annotation name :: Name rep :: Replace expr :: QueryExpr | CreateView ann::Annotation name :: Name colNames :: {MaybeNameComponentList} expr :: QueryExpr | AlterView ann::Annotation name :: Name colNames :: {MaybeNameComponentList} expr :: QueryExpr | CreateType ann::Annotation name :: Name atts :: TypeAttributeDefList -- users | CreateUser ann::Annotation name :: Name password :: String | CreateLogin ann::Annotation name :: Name password :: String | AlterUser ann::Annotation name :: Name password :: String | AlterLogin ann::Annotation name :: Name password :: String -- schemas | CreateSchema ann::Annotation name :: Name owner :: {Maybe Name} | AlterSchema ann::Annotation name :: Name operation :: AlterSchemaOperation -- language name args rettype bodyquoteused body vol | CreateFunction ann::Annotation name :: Name params :: ParamDefList rettype :: TypeName rep :: Replace lang :: Language body :: FnBody vol :: Volatility -- name type checkexpression | CreateDomain ann::Annotation name :: Name typ :: TypeName constraintName:: String check :: MaybeBoolExpr | CreateLanguage ann::Annotation name::String | CreateTrigger ann::Annotation name::NameComponent wh :: TriggerWhen events:: {[TriggerEvent]} tbl :: Name firing :: TriggerFire fnName :: Name fnArgs :: ScalarExprList -- ifexists (name,argtypes)* cascadeorrestrict | DropFunction ann::Annotation ifE :: IfExists sigs :: NameTypeNameListPairList cascade :: Cascade -- ifexists names cascadeorrestrict | DropSomething ann::Annotation dropType :: DropType ifE :: IfExists names :: {[Name]} cascade :: Cascade | DropTrigger ann::Annotation ifE :: IfExists name :: NameComponent tbl :: Name cascade :: Cascade | CreateDatabase ann::Annotation nm::Name --misc | Set ann::Annotation name::String values::{[SetValue]} | Notify ann::Annotation name::String {- | SqlStatement ann::Annotation -- todo:: put this in so that the lib can be better used as a pure sql parser stmt::Statement -} | Into ann::Annotation strict::Bool into :: {[Name]} stmt :: Statement | Assignment ann::Annotation target :: Name value :: ScalarExpr | Return ann::Annotation value :: MaybeScalarExpr | ReturnNext ann::Annotation expr :: ScalarExpr | ReturnQuery ann::Annotation sel :: QueryExpr | Raise ann::Annotation level :: RaiseType message :: String args :: ScalarExprList | NullStatement ann::Annotation | Perform ann::Annotation expr :: ScalarExpr | Execute ann::Annotation expr :: ScalarExpr | ForQueryStatement ann::Annotation lb :: {Maybe String} var :: NameComponent sel :: QueryExpr sts :: StatementList | ForIntegerStatement ann::Annotation lb :: {Maybe String} var :: NameComponent from :: ScalarExpr to :: ScalarExpr sts :: StatementList | LoopStatement ann::Annotation lb :: {Maybe String} sts :: StatementList | WhileStatement ann::Annotation lb :: {Maybe String} expr :: ScalarExpr sts :: StatementList | ContinueStatement ann::Annotation lb::{Maybe String} | ExitStatement ann::Annotation lb::{Maybe String} --variable, list of when parts, else part | CaseStatementSimple ann::Annotation val :: ScalarExpr cases :: ScalarExprListStatementListTripleList els :: StatementList | CaseStatement ann::Annotation cases :: ScalarExprListStatementListTripleList els :: StatementList --list is --first if (condition, statements)::elseifs(condition, statements) --last bit is else statements | If ann::Annotation cases :: ScalarExprStatementListPairList els :: StatementList | Block ann::Annotation lb::{Maybe String} vars::VarDefList sts :: StatementList | AntiStatement String | DeclareStatement ann::Annotation ds::{[(String,TypeName,Maybe ScalarExpr)]} | ExecStatement ann::Annotation spName::Name args::ScalarExprList | CreateIndexTSQL ann::Annotation nm::NameComponent obj::Name cols::{[NameComponent]} {- ------------------------------------------------ = dml components -} { data CopyFromSource = CopyFilename String | Stdin deriving (Show,Eq,Typeable,Data) data CopyToSource = CopyTable Name [NameComponent] | CopyQuery QueryExpr deriving (Show,Eq,Typeable,Data) data CopyFromOption = CopyFromFormat String | CopyFromDelimiter String | CopyFromErrorLog String | CopyFromErrorVerbosity Int | CopyFromParsers String | CopyFromDirectory | CopyFromOffset Integer | CopyFromLimit Integer | CopyFromErrorThreshold Int | CopyFromNewlineFormat String deriving (Show,Eq,Typeable,Data) data CopyToOption = CopyToFormat String | CopyToDelimiter String | CopyToErrorLog String | CopyToErrorVerbosity Int deriving (Show,Eq,Typeable,Data) } data SetClause | SetClause ann::Annotation setTarget::NameComponent ex::ScalarExpr | MultiSetClause ann::Annotation setTargets::{[NameComponent]} ex::ScalarExpr {- ------------------------------------------------ = ddl, utility components -} --name type constraints options data AttributeDef | AttributeDef ann::Annotation name :: NameComponent typ :: TypeName cons :: RowConstraintList options :: {[TableOption]} --Constraints which appear attached to an individual field data RowConstraint | DefaultConstraint ann::Annotation name::String expr::ScalarExpr | NullConstraint ann::Annotation name::String | NotNullConstraint ann::Annotation name::String | IdentityConstraint ann::Annotation name::String seedAndInc ::{(Maybe (Integer,Integer))} | RowCheckConstraint ann::Annotation name::String expr::ScalarExpr | RowUniqueConstraint ann::Annotation name::String | RowPrimaryKeyConstraint ann::Annotation name::String | RowReferenceConstraint ann::Annotation name::String table :: Name att :: (Maybe NameComponent) onUpdate :: Cascade onDelete :: Cascade --constraints which appear on a separate row in the create table data Constraint | UniqueConstraint ann::Annotation name::String x::{[NameComponent]} | PrimaryKeyConstraint ann::Annotation name::String x::{[NameComponent]} | CheckConstraint ann::Annotation name::String expr::ScalarExpr -- sourcecols targettable targetcols ondelete onupdate | ReferenceConstraint ann::Annotation name::String atts :: {[NameComponent]} table :: Name tableAtts :: {[NameComponent]} onUpdate :: Cascade onDelete :: Cascade { data TableOption = TableOptionStringVal [String] String | TableOptionNameVal [String] [Name] | TableOptionNumberVal [String] String | TableOptionKeywords [String] deriving (Show,Eq,Typeable,Data) } data TypeAttributeDef | TypeAttDef ann::Annotation name :: NameComponent typ :: TypeName --partition definition data TablePartitionDef | TablePartitionDef ann :: Annotation colname :: NameComponent interval :: Integer timeframe :: TablePartitionDateTimeInterval --partition intervals definition { data TablePartitionDateTimeInterval = Year | Month | Day | Hour | Minute | Second | Millisecond deriving (Show,Eq,Typeable,Data) } data AlterTableOperation | RenameTable ann::Annotation newName :: Name | RenameColumn ann::Annotation oldName :: NameComponent newName :: NameComponent | AlterTableActions ann::Annotation actions :: AlterTableActionList data AlterTableAction | AddColumn ann :: Annotation att :: AttributeDef | DropColumn ann :: Annotation nm :: NameComponent | AlterColumn ann :: Annotation nm :: NameComponent act :: AlterColumnAction | AddConstraint ann :: Annotation con :: Constraint data AlterColumnAction | SetDataType ann :: Annotation typ :: TypeName | SetNotNull ann :: Annotation | DropNotNull ann :: Annotation | SetDefault ann :: Annotation def :: ScalarExpr | DropDefault ann :: Annotation data AlterDatabaseOperation | RenameDatabase ann :: Annotation newName :: Name data AlterSchemaOperation | AlterSchemaName ann::Annotation newName :: Name | AlterSchemaOwner ann::Annotation newName :: Name data AlterSequenceOperation | AlterSequenceOwned ann::Annotation owned :: Name | AlterSequenceRename ann::Annotation name :: Name | AlterSequenceActions ann::Annotation actions :: AlterSequenceActionList data AlterSequenceAction | AlterSequenceIncrement ann::Annotation incr :: Integer | AlterSequenceMin ann::Annotation min :: {Maybe Integer} | AlterSequenceMax ann::Annotation max :: {Maybe Integer} | AlterSequenceStart ann::Annotation start :: Integer | AlterSequenceRestart ann::Annotation restart :: {Maybe Integer} | AlterSequenceCache ann::Annotation cache :: Integer { data SetValue = SetStr Annotation String | SetId Annotation String | SetNum Annotation Double deriving (Show,Eq,Typeable,Data) data TriggerWhen = TriggerBefore | TriggerAfter deriving (Show,Eq,Typeable,Data) data TriggerEvent = TInsert| TUpdate | TDelete | AntiTriggerEvent String deriving (Show,Eq,Typeable,Data) data TriggerFire = EachRow | EachStatement deriving (Show,Eq,Typeable,Data) data DropType = Table | Domain | View | Type | Database | User | Login | Schema deriving (Show,Eq,Typeable,Data) data Cascade = Cascade | Restrict deriving (Show,Eq,Typeable,Data) data IfExists = Require | IfExists deriving (Show,Eq,Typeable,Data) data RestartIdentity = RestartIdentity | ContinueIdentity deriving (Show,Eq,Typeable,Data) } {- == create function stuff -} { data Replace = Replace | NoReplace deriving (Show,Eq,Typeable,Data) data Volatility = Volatile | Stable | Immutable deriving (Show,Eq,Typeable,Data) -- todo: fix the fn body to support to support other languages -- just as as string for now -- probably change Language to be a string also data Language = Sql | Plpgsql deriving (Show,Eq,Typeable,Data) } data FnBody | SqlFnBody ann::Annotation sts :: StatementList | PlpgsqlFnBody ann::Annotation blk :: Statement {- ------------------------------------------------ = plpgsql components -} data ParamDef | ParamDef ann::Annotation name::NameComponent typ::TypeName | ParamDefTp ann::Annotation typ::TypeName data VarDef | VarDef ann::Annotation name :: NameComponent typ :: TypeName value :: (Maybe ScalarExpr) | ParamAlias ann::Annotation name :: NameComponent i :: Integer | VarAlias ann::Annotation name :: NameComponent aliased :: Name { data RaiseType = RNotice | RException | RError deriving (Show,Eq,Typeable,Data) } {- ------------------------------------------------ = query hints -} { data QueryHint = QueryHintPartitionGroup | QueryHintColumnarHostGroup deriving (Show,Eq,Typeable,Data) } {- -------------------------------------------- = boilerplate -} -- some list nodes, not sure if all of these are needed as separately -- named node types type OnExpr = maybe JoinExpr type MaybeSelectList = maybe SelectList type TableRefList = [TableRef] type MaybeScalarExpr = maybe ScalarExpr type MaybeBoolExpr = maybe ScalarExpr type ScalarExprList = [ScalarExpr] --type ScalarExprListList = [ScalarExprList] type ScalarExprListList = [ScalarExprTransposedList] type ScalarExprTransposedList = [ScalarExpr] type SetClauseList = [SetClause] type AttributeDefList = [AttributeDef] type ConstraintList = [Constraint] type MaybeTablePartitionDef = maybe TablePartitionDef type TypeAttributeDefList = [TypeAttributeDef] type ParamDefList = [ParamDef] type TypeNameList = [TypeName] type NameTypeNameListPair = (Name, TypeNameList) type NameTypeNameListPairList = [NameTypeNameListPair] type ScalarExprListStatementListTriple = (ScalarExprList,StatementList) type ScalarExprListStatementListTripleList = [ScalarExprListStatementListTriple] type ScalarExprStatementListPair = (ScalarExpr, StatementList) type ScalarExprStatementListPairList = [ScalarExprStatementListPair] type VarDefList = [VarDef] type SelectItemList = [SelectItem] type RowConstraintList = [RowConstraint] type CaseScalarExprListScalarExprPair = (ScalarExprList,ScalarExpr) type CaseScalarExprListScalarExprPairList = [CaseScalarExprListScalarExprPair] type StatementList = [Statement] type ScalarExprDirectionPair = (ScalarExpr,Direction, NullsOrder) type ScalarExprDirectionPairList = [ScalarExprDirectionPair] type AlterTableActionList = [AlterTableAction] type AlterSequenceActionList = [AlterSequenceAction] type MaybeNameComponentList = maybe NameComponentList type NameComponentList = [NameComponent] -- Add a root data type so you can put initial values for inherited -- attributes in the section which defines and uses those attributes -- rather than in the sem_ calls data Root | Root statements::StatementList deriving Root: Show -- use an expression root also to support type checking, -- etc., individual expressions data ScalarExprRoot | ScalarExprRoot expr::ScalarExpr deriving ScalarExprRoot: Show {- attributes which every node has -} set AllNodes = Statement QueryExpr FnBody TableRef JoinExpr SelectList SelectItem AttributeDef RowConstraint TypeAttributeDef ParamDef VarDef Constraint MaybeTablePartitionDef TablePartitionDef TypeName ScalarExpr InList MaybeScalarExpr MaybeBoolExpr ScalarExprList ScalarExprTransposedList ScalarExprListList AttributeDefList ConstraintList TypeAttributeDefList ParamDefList TypeNameList NameTypeNameListPair NameTypeNameListPairList StatementList ScalarExprListStatementListTriple ScalarExprListStatementListTripleList ScalarExprStatementListPair ScalarExprStatementListPairList VarDefList SelectItemList RowConstraintList CaseScalarExprListScalarExprPair CaseScalarExprListScalarExprPairList TableRefList TableRef OnExpr MaybeSelectList AlterTableOperation AlterTableAction AlterColumnAction AlterDatabaseOperation AlterSchemaOperation AlterSequenceOperation AlterSequenceAction AlterSequenceActionList ScalarExprDirectionPair ScalarExprDirectionPairList AlterTableActionList WithQueryList WithQuery Name SetClause SetClauseList MaybeNameComponentList NameComponentList deriving AllNodes: Show,Eq,Typeable,Data include "Annotation.ag" include "TypeChecking/TypeChecking.ag" { -- TODO: move this somewhere better -- | run canonicalizeTypeName on all the TypeName nodes in an ast {-canonicalizeTypeNames :: Data a => Dialect -> a -> a canonicalizeTypeNames d = (transformBi $ \x -> case x of ScalarType s -> ScalarType $ canonicalizeTypeName d s x' -> x') . (transformBi $ \x -> case x of SimpleTypeName a tn -> SimpleTypeName a (c tn) PrecTypeName a tn i -> PrecTypeName a (c tn) i Prec2TypeName a tn i i1 -> Prec2TypeName a (c tn) i i1 x' -> x') where c (Name a [Nmc nc]) = Name a [Nmc $ T.unpack $ canonicalizeTypeName d $ T.pack nc] c z = z-} }