hssqlppp-0.0.6: Database/HsSqlPpp/TypeChecking/AstInternal.ag
{-
Copyright 2009 Jake Wheat
This file contains the ast nodes, and the api functions to pass an ast
and get back type information.
It uses the Utrecht University Attribute Grammar system:
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, which is included
into this file.
These ast nodes are both used as the result of successful parsing, and
as the input to the type checker and the pretty printer.
= compiling
use
uuagc -dcfws AstInternal.ag
to generate a new AstInternal.hs from this file
(install uuagc with
cabal install uuagc
)
-}
MODULE {Database.HsSqlPpp.TypeChecking.AstInternal}
{
--from the ag files:
--ast nodes
Statement (..)
,SelectExpression (..)
,FnBody (..)
,SetClause (..)
,TableRef (..)
,JoinExpression (..)
,JoinType (..)
,SelectList (..)
,SelectItem (..)
,CopySource (..)
,AttributeDef (..)
,RowConstraint (..)
,Constraint (..)
,TypeAttributeDef (..)
,ParamDef (..)
,VarDef (..)
,RaiseType (..)
,CombineType (..)
,Volatility (..)
,Language (..)
,TypeName (..)
,DropType (..)
,Cascade (..)
,Direction (..)
,Distinct (..)
,Natural (..)
,IfExists (..)
,RestartIdentity (..)
,Expression (..)
,InList (..)
,StatementList
,ExpressionListStatementListPairList
,ExpressionListStatementListPair
,ExpressionList
,StringList
,ParamDefList
,AttributeDefList
,ConstraintList
,TypeAttributeDefList
,Where
,StringStringListPairList
,StringStringListPair
,ExpressionStatementListPairList
,SetClauseList
,CaseExpressionListExpressionPairList
,MaybeExpression
,MTableRef
,ExpressionListList
,SelectItemList
,OnExpr
,RowConstraintList
,VarDefList
,ExpressionStatementListPair
,MExpression
,CaseExpressionListExpressionPair
,CaseExpressionList
-- annotations
,annotateAst
,annotateAstScope
,annotateExpression
}
{
import Data.Maybe
import Data.List
import Debug.Trace
import Control.Monad.Error
import Control.Arrow
import Data.Either
import Control.Applicative
import Database.HsSqlPpp.TypeChecking.TypeType
import Database.HsSqlPpp.TypeChecking.AstUtils
import Database.HsSqlPpp.TypeChecking.TypeConversion
import Database.HsSqlPpp.TypeChecking.TypeCheckingH
import Database.HsSqlPpp.TypeChecking.Scope
import Database.HsSqlPpp.TypeChecking.ScopeData
import Database.HsSqlPpp.TypeChecking.AstAnnotation
}
{-
================================================================================
SQL top level statements
everything is chucked in here: dml, ddl, plpgsql statements
-}
DATA Statement
--queries
| SelectStatement ann:Annotation ex:SelectExpression
-- dml
--table targetcolumns insertdata(values or select statement) returning
| Insert ann:Annotation
table : String
targetCols : StringList
insData : SelectExpression
returning : (Maybe SelectList)
--tablename setitems where returning
| Update ann:Annotation
table : String
assigns : SetClauseList
whr : Where
returning : (Maybe SelectList)
--tablename, where, returning
| Delete ann:Annotation
table : String
whr : Where
returning : (Maybe SelectList)
--tablename column names, from
| Copy ann:Annotation
table : String
targetCols : StringList
source : CopySource
--represents inline data for copy statement
| CopyData ann:Annotation insData : String
| Truncate ann:Annotation
tables: StringList
restartIdentity : RestartIdentity
cascade : Cascade
-- ddl
| CreateTable ann:Annotation
name : String
atts : AttributeDefList
cons : ConstraintList
| CreateTableAs ann:Annotation
name : String
expr : SelectExpression
| CreateView ann:Annotation
name : String
expr : SelectExpression
| CreateType ann:Annotation
name : String
atts : TypeAttributeDefList
-- language name args rettype bodyquoteused body vol
| CreateFunction ann:Annotation
lang : Language
name : String
params : ParamDefList
rettype : TypeName
bodyQuote : String
body : FnBody
vol : Volatility
-- name type checkexpression
| CreateDomain ann:Annotation
name : String
typ : TypeName
check : (Maybe Expression)
-- ifexists (name,argtypes)* cascadeorrestrict
| DropFunction ann:Annotation
ifE : IfExists
sigs : StringStringListPairList
cascade : Cascade
-- ifexists names cascadeorrestrict
| DropSomething ann:Annotation
dropType : DropType
ifE : IfExists
names : StringList
cascade : Cascade
| Assignment ann:Annotation
target : String
value : Expression
| Return ann:Annotation
value : (Maybe Expression)
| ReturnNext ann:Annotation
expr : Expression
| ReturnQuery ann:Annotation
sel : SelectExpression
| Raise ann:Annotation
level : RaiseType
message : String
args : ExpressionList
| NullStatement ann:Annotation
| Perform ann:Annotation
expr : Expression
| Execute ann:Annotation
expr : Expression
| ExecuteInto ann:Annotation
expr : Expression
targets : StringList
| ForSelectStatement ann:Annotation
var : String
sel : SelectExpression
sts : StatementList
| ForIntegerStatement ann:Annotation
var : String
from : Expression
to : Expression
sts : StatementList
| WhileStatement ann:Annotation
expr : Expression
sts : StatementList
| ContinueStatement ann:Annotation
--variable, list of when parts, else part
| CaseStatement ann:Annotation
val : Expression
cases : ExpressionListStatementListPairList
els : StatementList
--list is
--first if (condition, statements):elseifs(condition, statements)
--last bit is else statements
| If ann:Annotation
cases : ExpressionStatementListPairList
els : StatementList
-- =============================================================================
--Statement components
-- maybe this should be called relation valued expression?
DATA SelectExpression
| Select ann:Annotation
selDistinct : Distinct
selSelectList : SelectList
selTref : MTableRef
selWhere : Where
selGroupBy : ExpressionList
selHaving : MExpression
selOrderBy : ExpressionList
selDir : Direction
selLimit : MExpression
selOffset : MExpression
| CombineSelect ann:Annotation
ctype : CombineType
sel1 : SelectExpression
sel2 : SelectExpression
| Values ann:Annotation
vll:ExpressionListList
TYPE MTableRef = MAYBE TableRef
TYPE Where = MAYBE Expression
TYPE MExpression = MAYBE Expression
DATA FnBody | SqlFnBody sts : StatementList
| PlpgsqlFnBody VarDefList sts : StatementList
DATA SetClause | SetClause att:String val:Expression
| RowSetClause atts:StringList vals:ExpressionList
DATA TableRef | Tref ann:Annotation
tbl:String
| TrefAlias ann:Annotation
tbl : String
alias : String
| JoinedTref ann:Annotation
tbl : TableRef
nat : Natural
joinType : JoinType
tbl1 : TableRef
onExpr : OnExpr
| SubTref ann:Annotation
sel : SelectExpression
alias : String
| TrefFun ann:Annotation
fn:Expression
| TrefFunAlias ann:Annotation
fn:Expression
alias:String
TYPE OnExpr = MAYBE JoinExpression
DATA JoinExpression | JoinOn Expression | JoinUsing StringList
DATA JoinType | Inner | LeftOuter| RightOuter | FullOuter | Cross
-- select columns, into columns
DATA SelectList | SelectList items:SelectItemList StringList
DATA SelectItem | SelExp ex:Expression
| SelectItem ex:Expression name:String
DATA CopySource | CopyFilename String | Stdin
--name type default null constraint
DATA AttributeDef | AttributeDef name : String
typ : TypeName
check : (Maybe Expression)
cons : RowConstraintList
--Constraints which appear attached to an individual field
DATA RowConstraint | NullConstraint
| NotNullConstraint
| RowCheckConstraint Expression
| RowUniqueConstraint
| RowPrimaryKeyConstraint
| RowReferenceConstraint table : String
att : (Maybe String)
onUpdate : Cascade
onDelete : Cascade
--constraints which appear on a separate row in the create table
DATA Constraint | UniqueConstraint StringList
| PrimaryKeyConstraint StringList
| CheckConstraint Expression
-- sourcecols targettable targetcols ondelete onupdate
| ReferenceConstraint atts : StringList
table : String
tableAtts : StringList
onUpdate : Cascade
onDelete : Cascade
DATA TypeAttributeDef | TypeAttDef name : String
typ : TypeName
DATA ParamDef | ParamDef name:String typ:TypeName
| ParamDefTp typ:TypeName
DATA VarDef | VarDef name : String
typ : TypeName
value : (Maybe Expression)
DATA RaiseType | RNotice | RException | RError
DATA CombineType | Except | Union | Intersect | UnionAll
DATA Volatility | Volatile | Stable | Immutable
DATA Language | Sql | Plpgsql
DATA TypeName | SimpleTypeName tn:String
| PrecTypeName tn:String prec:Integer
| ArrayTypeName typ:TypeName
| SetOfTypeName typ:TypeName
DATA DropType | Table
| Domain
| View
| Type
DATA Cascade | Cascade | Restrict
DATA Direction | Asc | Desc
DATA Distinct | Distinct | Dupes
DATA Natural | Natural | Unnatural
DATA IfExists | Require | IfExists
DATA RestartIdentity | RestartIdentity | ContinueIdentity
{-
================================================================================
Expressions
Similarly to the statement type, all expressions are chucked into one
even though there are many restrictions on which expressions can
appear in different places. Maybe this should be called scalar
expression?
-}
DATA Expression | IntegerLit ann:Annotation i:Integer
| FloatLit ann:Annotation d:Double
| StringLit ann:Annotation
quote : String
value : String
| NullLit ann:Annotation
| BooleanLit ann:Annotation b:Bool
| PositionalArg ann:Annotation p:Integer
| Cast ann:Annotation
expr:Expression
tn:TypeName
| Identifier ann:Annotation
i:String
| Case ann:Annotation
cases : CaseExpressionListExpressionPairList
els : MaybeExpression
| CaseSimple ann:Annotation
value : Expression
cases : CaseExpressionListExpressionPairList
els : MaybeExpression
| Exists ann:Annotation
sel : SelectExpression
| FunCall ann:Annotation
funName:String
args:ExpressionList
| InPredicate ann:Annotation
expr:Expression
i:Bool
list:InList
-- windowfn selectitem partitionby orderby orderbyasc?
| WindowFn ann:Annotation
fn : Expression
partitionBy : ExpressionList
orderBy : ExpressionList
dir : Direction
| ScalarSubQuery ann:Annotation
sel : SelectExpression
DATA InList | InList exprs : ExpressionList
| InSelect sel : SelectExpression
TYPE MaybeExpression = MAYBE Expression
{-
list of expression flavours from postgresql with the equivalents in this ast
pg here
-- ----
constant/literal integerlit, floatlit, unknownstringlit, nulllit, boollit
column reference identifier
positional parameter reference positionalarg
subscripted expression funcall
field selection expression identifier
operator invocation funcall
function call funcall
aggregate expression funcall
window function call windowfn
type cast cast
scalar subquery scalarsubquery
array constructor funcall
row constructor funall
Anything that is represented in the ast as some sort of name plus a
list of expressions as arguments is treated as the same type of node:
FunCall.
This includes
symbol operators
regular function calls
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
Most of unusual syntax forms and keywords operators are not yet
supported, so this is mainly a todo list.
Keyword operators are encoded with the function name as a ! followed
by a string
e.g.
operator 'and' -> FunCall "!and" ...
see keywordOperatorTypes value in AstUtils.lhs for the list of
currently supported keyword operators.
-}
-- some list nodes, not sure if all of these are needed as separately
-- named node types
TYPE ExpressionList = [Expression]
TYPE ExpressionListList = [ExpressionList]
TYPE StringList = [String]
TYPE SetClauseList = [SetClause]
TYPE AttributeDefList = [AttributeDef]
TYPE ConstraintList = [Constraint]
TYPE TypeAttributeDefList = [TypeAttributeDef]
TYPE ParamDefList = [ParamDef]
TYPE StringStringListPair = (String,StringList)
TYPE StringStringListPairList = [StringStringListPair]
TYPE ExpressionListStatementListPair = (ExpressionList,StatementList)
TYPE ExpressionListStatementListPairList = [ExpressionListStatementListPair]
TYPE ExpressionStatementListPair = (Expression, StatementList)
TYPE ExpressionStatementListPairList = [ExpressionStatementListPair]
TYPE VarDefList = [VarDef]
TYPE SelectItemList = [SelectItem]
TYPE RowConstraintList = [RowConstraint]
TYPE CaseExpressionListExpressionPair = (CaseExpressionList,Expression)
TYPE CaseExpressionList = [Expression]
TYPE CaseExpressionListExpressionPairList = [CaseExpressionListExpressionPair]
TYPE StatementList = [Statement]
-- Add a root data type so we 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 ExpressionRoot | ExpressionRoot expr:Expression
DERIVING ExpressionRoot: Show
{-
================================================================================
=some basic bookkeeping
attributes which every node has
-}
SET AllNodes = Statement SelectExpression FnBody SetClause TableRef
JoinExpression JoinType
SelectList SelectItem CopySource AttributeDef RowConstraint
Constraint TypeAttributeDef ParamDef VarDef RaiseType
CombineType Volatility Language TypeName DropType Cascade
Direction Distinct Natural IfExists RestartIdentity
Expression InList MaybeExpression
ExpressionList ExpressionListList StringList SetClauseList
AttributeDefList ConstraintList TypeAttributeDefList
ParamDefList StringStringListPair StringStringListPairList
StatementList ExpressionListStatementListPair
ExpressionListStatementListPairList ExpressionStatementListPair
ExpressionStatementListPairList VarDefList SelectItemList
RowConstraintList CaseExpressionListExpressionPair
CaseExpressionListExpressionPairList CaseExpressionList
MTableRef TableRef OnExpr Where MExpression
DERIVING AllNodes: Show,Eq
INCLUDE "TypeChecking.ag"
{-
================================================================================
used to use record syntax to try to insulate code from field changes,
and not have to write out loads of nothings and [] for simple selects,
but don't know how to create haskell named records from uuagc DATA
things
makeSelect :: Statement
makeSelect = Select Dupes (SelectList [SelExp (Identifier "*")] [])
Nothing Nothing [] Nothing [] Asc Nothing Nothing
================================================================================
= annotation functions
-}
{
-- | Takes an ast, and adds annotations, including types, type errors,
-- and statement info. Type checks against defaultScope.
annotateAst :: StatementList -> StatementList
annotateAst = annotateAstScope defaultScope
-- | As annotateAst but you supply an additional scope to add to the
-- defaultScope to type check against. See Scope module for how to
-- read a scope from an existing database so you can type check
-- against it.
annotateAstScope :: Scope -> StatementList -> StatementList
annotateAstScope scope sts =
let t = sem_Root (Root sts)
ta = wrap_Root t Inh_Root {scope_Inh_Root = combineScopes defaultScope scope}
tl = annotatedTree_Syn_Root ta
in case tl of
Root r -> r
-- | Testing utility, mainly used to check an expression for type errors
-- or to get its type.
annotateExpression :: Scope -> Expression -> Expression
annotateExpression scope ex =
let t = sem_ExpressionRoot (ExpressionRoot ex)
rt = (annotatedTree_Syn_ExpressionRoot
(wrap_ExpressionRoot t Inh_ExpressionRoot {scope_Inh_ExpressionRoot = combineScopes defaultScope scope}))
in case rt of
ExpressionRoot e -> e
{-
================================================================================
= instances for Annotated.
Hopefully, some sort of SYB approach can be used to autogenerate these
in the future. It is imperative that this or template haskell or
something similar be used because doing it by hand guarantees some
bits will be missed.
Stupidity watch update: use attributes to do this. Doh.
-}
instance Annotated Statement where
ann a =
case a of
SelectStatement ann _ -> ann
Insert ann _ _ _ _ -> ann
Update ann _ _ _ _ -> ann
Delete ann _ _ _ -> ann
Copy ann _ _ _ -> ann
CopyData ann _ -> ann
Truncate ann _ _ _ -> ann
CreateTable ann _ _ _ -> ann
CreateTableAs ann _ _ -> ann
CreateView ann _ _ -> ann
CreateType ann _ _ -> ann
CreateFunction ann _ _ _ _ _ _ _ -> ann
CreateDomain ann _ _ _ -> ann
DropFunction ann _ _ _ -> ann
DropSomething ann _ _ _ _ -> ann
Assignment ann _ _ -> ann
Return ann _ -> ann
ReturnNext ann _ -> ann
ReturnQuery ann _ -> ann
Raise ann _ _ _ -> ann
NullStatement ann -> ann
Perform ann _ -> ann
Execute ann _ -> ann
ExecuteInto ann _ _ -> ann
ForSelectStatement ann _ _ _ -> ann
ForIntegerStatement ann _ _ _ _ -> ann
WhileStatement ann _ _ -> ann
ContinueStatement ann -> ann
CaseStatement ann _ _ _ -> ann
If ann _ _ -> ann
setAnn st a =
case st of
SelectStatement _ ex -> SelectStatement a ex
Insert _ tbl cols ins ret -> Insert a tbl cols ins ret
Update _ tbl as whr ret -> Update a tbl as whr ret
Delete _ tbl whr ret -> Delete a tbl whr ret
Copy _ tbl cols src -> Copy a tbl cols src
CopyData _ i -> CopyData a i
Truncate _ tbls ri cs -> Truncate a tbls ri cs
CreateTable _ name atts cons -> CreateTable a name atts cons
CreateTableAs _ name ex -> CreateTableAs a name ex
CreateView _ name expr -> CreateView a name expr
CreateType _ name atts -> CreateType a name atts
CreateFunction _ lang name params rettype bodyQuote body vol ->
CreateFunction a lang name params rettype bodyQuote body vol
CreateDomain _ name typ check -> CreateDomain a name typ check
DropFunction _ i s cs -> DropFunction a i s cs
DropSomething _ dt i nms cs -> DropSomething a dt i nms cs
Assignment _ tgt val -> Assignment a tgt val
Return _ v -> Return a v
ReturnNext _ ex -> ReturnNext a ex
ReturnQuery _ sel -> ReturnQuery a sel
Raise _ l m args -> Raise a l m args
NullStatement _ -> NullStatement a
Perform _ expr -> Perform a expr
Execute _ expr -> Execute a expr
ExecuteInto _ expr tgts -> ExecuteInto a expr tgts
ForSelectStatement _ var sel sts -> ForSelectStatement a var sel sts
ForIntegerStatement _ var from to sts -> ForIntegerStatement a var from to sts
WhileStatement _ expr sts -> WhileStatement a expr sts
ContinueStatement _ -> ContinueStatement a
CaseStatement _ val cases els -> CaseStatement a val cases els
If _ cases els -> If a cases els
changeAnnRecurse f st =
case st of
SelectStatement a ex -> SelectStatement (f a) ex
Insert a tbl cols ins ret -> Insert (f a) tbl cols ins ret
Update a tbl as whr ret -> Update (f a) tbl as whr ret
Delete a tbl whr ret -> Delete (f a) tbl whr ret
Copy a tbl cols src -> Copy (f a) tbl cols src
CopyData a i -> CopyData (f a) i
Truncate a tbls ri cs -> Truncate (f a) tbls ri cs
CreateTable a name atts cons -> CreateTable (f a) name atts cons
CreateTableAs a name ex -> CreateTableAs (f a) name ex
CreateView a name expr -> CreateView (f a) name expr
CreateType a name atts -> CreateType (f a) name atts
CreateFunction a lang name params rettype bodyQuote body vol ->
CreateFunction (f a) lang name params rettype bodyQuote doBody vol
where
doBody = case body of
SqlFnBody sts -> SqlFnBody $ cars f sts
PlpgsqlFnBody vars sts -> PlpgsqlFnBody vars $ cars f sts
CreateDomain a name typ check -> CreateDomain (f a) name typ check
DropFunction a i s cs -> DropFunction (f a) i s cs
DropSomething a dt i nms cs -> DropSomething (f a) dt i nms cs
Assignment a tgt val -> Assignment (f a) tgt val
Return a v -> Return (f a) v
ReturnNext a ex -> ReturnNext (f a) ex
ReturnQuery a sel -> ReturnQuery (f a) sel
Raise a l m args -> Raise (f a) l m args
NullStatement a -> NullStatement (f a)
Perform a expr -> Perform (f a) expr
Execute a expr -> Execute (f a) expr
ExecuteInto a expr tgts -> ExecuteInto (f a) expr tgts
ForSelectStatement a var sel sts -> ForSelectStatement (f a) var sel $ cars f sts
ForIntegerStatement a var from to sts -> ForIntegerStatement (f a) var from to $ cars f sts
WhileStatement a expr sts -> WhileStatement (f a) expr $ cars f sts
ContinueStatement a -> ContinueStatement (f a)
CaseStatement a val cases els -> CaseStatement (f a) val doCases $ cars f els
where
doCases = map (second (cars f)) cases
If a cases els -> If (f a) doCases $ cars f els
where
doCases = map (second (cars f)) cases
--where
-- doCases cs = map (\(ex,sts) -> (ex,cars f sts)) cs
getAnnChildren st =
case st of
SelectStatement _ ex -> gacse ex
Insert _ _ _ ins _ -> gacse ins
Update _ _ as whr _ -> mp (gacscl as) ++ gacme whr
Delete _ _ whr _ -> gacme whr
--Copy _ _ _ _ -> []
--CopyData _ _ -> []
--Truncate _ _ _ _ -> []
--CreateTable _ _ _ _ -> []
--CreateTableAs _ _ _ -> []
CreateView _ _ expr -> gacse expr
--CreateType _ _ _ -> []
--CreateFunction a lang name params rettype bodyQuote body vol ->
CreateFunction _ _ _ _ _ _ body _ ->
case body of
SqlFnBody sts -> mp sts
PlpgsqlFnBody _ sts -> mp sts
--CreateDomain _ _ _ _ -> []
--DropFunction _ _ _ _ -> []
--DropSomething _ _ _ _ _ -> []
--Assignment _ _ _ -> []
--Return a v -> Return (f a) v
--ReturnNext a ex -> ReturnNext (f a) ex
--ReturnQuery a sel -> ReturnQuery (f a) sel
--Raise a l m args -> Raise (f a) l m args
--NullStatement a -> NullStatement (f a)
--Perform a expr -> Perform (f a) expr
--Execute a expr -> Execute (f a) expr
--ExecuteInto a expr tgts -> ExecuteInto (f a) expr tgts
ForSelectStatement _ _ sel sts -> gacse sel ++ mp sts
ForIntegerStatement _ _ _ _ sts -> mp sts
WhileStatement _ expr sts -> pack expr : mp sts
--ContinueStatement a -> ContinueStatement (f a)
CaseStatement _ val cases els -> pack val : mp (doCases cases) ++ mp els
If _ cases els -> mp $ doCases cases ++ els
_ -> []
where
doCases = concatMap snd
--gacse :: Annotated a => SelectExpression -> [a]
gacse se = [pack se]
gacscl :: Annotated a => SetClauseList -> [a]
gacscl _ = []
--gacme :: Annotated a => Maybe Expression -> [a]
gacme e = case e of
Nothing -> []
Just e1 -> [pack e1]
mp = map pack
cars = map . changeAnnRecurse
instance Annotated Expression where
ann a =
case a of
IntegerLit ann _ -> ann
FloatLit ann _ -> ann
StringLit ann _ _ -> ann
NullLit ann -> ann
BooleanLit ann _ -> ann
PositionalArg ann _ -> ann
Cast ann _ _ -> ann
Identifier ann _ -> ann
Case ann _ _ -> ann
CaseSimple ann _ _ _ -> ann
Exists ann _ -> ann
FunCall ann _ _ -> ann
InPredicate ann _ _ _ -> ann
WindowFn ann _ _ _ _ -> ann
ScalarSubQuery ann _ -> ann
setAnn ex a =
case ex of
IntegerLit _ i -> IntegerLit a i
FloatLit _ d -> FloatLit a d
StringLit _ q v -> StringLit a q v
NullLit _ -> NullLit a
BooleanLit _ b -> BooleanLit a b
PositionalArg _ p -> PositionalArg a p
Cast _ expr tn -> Cast a expr tn
Identifier _ i -> Identifier a i
Case _ cases els -> Case a cases els
CaseSimple _ val cases els -> CaseSimple a val cases els
Exists _ sel -> Exists a sel
FunCall _ funName args -> FunCall a funName args
InPredicate _ expr i list -> InPredicate a expr i list
WindowFn _ fn par ord dir -> WindowFn a fn par ord dir
ScalarSubQuery _ sel -> ScalarSubQuery a sel
changeAnnRecurse f ex =
case ex of
IntegerLit a i -> IntegerLit (f a) i
FloatLit a d -> FloatLit (f a) d
StringLit a q v -> StringLit (f a) q v
NullLit a -> NullLit a
BooleanLit a b -> BooleanLit (f a) b
PositionalArg a p -> PositionalArg (f a) p
Cast a expr tn -> Cast (f a) (changeAnnRecurse f expr) tn
Identifier a i -> Identifier (f a) i
Case a cases els -> Case (f a) cases els
CaseSimple a val cases els -> CaseSimple (f a) val cases els
Exists a sel -> Exists (f a) sel
FunCall a funName args -> FunCall (f a) funName args
InPredicate a expr i list -> InPredicate (f a) expr i list
WindowFn a fn par ord dir -> WindowFn (f a) fn par ord dir
ScalarSubQuery a sel -> ScalarSubQuery (f a) sel
getAnnChildren ex =
case ex of
Cast _ expr _ -> mp [expr]
Case _ cases els -> gacce cases els
CaseSimple _ val cases els -> pack val : gacce cases els
Exists a sel -> [pack sel]
FunCall _ _ args -> mp args
--InPredicate a expr i list -> InPredicate (f a) expr i list
--WindowFn a fn par ord dir -> WindowFn (f a) fn par ord dir
--ScalarSubQuery a sel -> ScalarSubQuery (f a) sel
_ -> []
where
gacme e = case e of
Nothing -> []
Just e1 -> [pack e1]
gacce cs el = mp (concatMap (\(el,e) -> el ++ [e]) cs) ++ gacme el
mp = map pack
instance Annotated SelectExpression where
ann a =
case a of
Select ann _ _ _ _ _ _ _ _ _ _ -> ann
CombineSelect ann _ _ _ -> ann
Values ann _ -> ann
setAnn ex a =
case ex of
Select _ dis sl tref whr grp hav ord dir lim off ->
Select a dis sl tref whr grp hav ord dir lim off
CombineSelect _ ctype sel1 sel2 -> CombineSelect a ctype sel1 sel2
Values _ vll -> Values a vll
changeAnnRecurse f ex =
case ex of
Select a dis sl tref whr grp hav ord dir lim off ->
Select (f a) dis sl tref whr grp hav ord dir lim off
CombineSelect a ctype sel1 sel2 -> CombineSelect (f a) ctype
(changeAnnRecurse f sel1)
(changeAnnRecurse f sel2)
Values a vll -> Values (f a) vll
getAnnChildren ex =
case ex of
Select a dis sl tref whr grp hav ord dir lim off ->
doSl ++
map pack (maybeToList tref) ++
doME whr ++ mp grp ++ doME hav ++ mp ord ++ doME lim ++ doME off
where
doSl = let SelectList x _ = sl
ses = map (\s -> case s of
SelExp se -> se
SelectItem se _ -> se) x
in map pack ses
doME me = case me of
Nothing -> []
Just e -> [pack e]
CombineSelect _ _ sel1 sel2 -> [pack sel1,pack sel2]
Values _ vll -> mp $ concat vll
where
mp = map pack
instance Annotated TableRef where
ann a =
case a of
Tref ann _ -> ann
TrefAlias ann _ _ -> ann
JoinedTref ann _ _ _ _ _ -> ann
SubTref ann _ _ -> ann
TrefFun ann _ -> ann
TrefFunAlias ann _ _ -> ann
setAnn ex a =
case ex of
Tref _ tbl -> Tref a tbl
TrefAlias _ tbl alias -> TrefAlias a tbl alias
JoinedTref _ tbl nat joinType tbl1 onExpr -> JoinedTref a tbl nat joinType tbl1 onExpr
SubTref _ sel alias -> SubTref a sel alias
TrefFun _ fn -> TrefFun a fn
TrefFunAlias _ fn alias -> TrefFunAlias a fn alias
changeAnnRecurse f ex =
case ex of
Tref a tbl -> Tref (f a) tbl
TrefAlias a tbl alias -> TrefAlias (f a) tbl alias
JoinedTref a tbl nat joinType tbl1 onExpr ->
JoinedTref (f a)
(changeAnnRecurse f tbl)
nat
joinType
(changeAnnRecurse f tbl1)
onExpr
SubTref a sel alias -> SubTref (f a) (changeAnnRecurse f sel) alias
TrefFun a fn -> TrefFun (f a) (changeAnnRecurse f fn)
TrefFunAlias a fn alias -> TrefFunAlias (f a) (changeAnnRecurse f fn) alias
getAnnChildren ex =
case ex of
Tref a tbl -> []
TrefAlias a tbl alias -> []
JoinedTref _ tbl _ _ tbl1 onExpr ->
getAnnChildren tbl ++ getAnnChildren tbl1
SubTref a sel alias -> getAnnChildren sel
TrefFun a fn -> getAnnChildren fn
TrefFunAlias a fn alias -> getAnnChildren fn
}
{-
Future plans:
Investigate how much mileage can get out of making these nodes the
parse tree nodes, and using a separate ast. Hinges on how much extra
value can get from making the types more restrictive for the ast nodes
compared to the parse tree. Starting to think this won't be worth it.
Would like to turn this back into regular Haskell file, maybe could
use AspectAG instead of uuagc to make this happen?
-}