Commit 4df5ca45 authored by Michael Hanus's avatar Michael Hanus
Browse files

currypp / SQL added

parent cab3040d
......@@ -16,7 +16,7 @@ currycheck/CurryCheck
currydoc/CurryDoc
currytest/CurryTest
cusage/CheckUsage
erd2cdbi/erd2cdbi
erd2cdbi/ERD2CDBI
erd2curry/erd2curry
genint/GenInt
importcalls/ImportCalls
......
......@@ -93,6 +93,13 @@ concatPR (Errors p1) (Errors p2) = Errors (p1 ++ p2)
concatPR (Errors p1) (OK _) = Errors p1
concatPR (OK _) (Errors p2) = Errors p2
--- Combines two PRs by a given functions
combinePRs :: (a -> b -> c) -> PR a -> PR b -> PR c
combinePRs f (OK x) (OK y) = okPR (f x y)
combinePRs _ (Errors p1) (Errors p2) = Errors (p1 ++ p2)
combinePRs _ (Errors p1) (OK _) = Errors p1
combinePRs _ (OK _) (Errors p2) = Errors p2
--- Join multiple Error Monads into one
sequencePR :: [PR a] -> PR [a]
sequencePR [] = okPR []
......
......@@ -39,6 +39,10 @@ warnOKPM x = warnPM (okPR x)
throwPM :: Pos -> String -> PM _
throwPM p s = cleanWM (throwPMsg p s)
throwMultiPM :: Pos -> [String] -> PM _
throwMultiPM p strs = cleanWM (throwPR (map (\s -> (PError p s)) strs))
--- Return without Errors but with one Warning
singlePM :: a -> Warning -> PM a
singlePM x w = warnOKPM x [w]
......@@ -76,3 +80,12 @@ fstPM = liftPM fst
--- snd defined on PM
sndPM :: PM (a,b) -> PM b
sndPM = liftPM snd
--- combines two PMs by function f, throws error if at least one of
--- the two carries an error
combinePMs :: (a -> b -> c) -> PM a -> PM b -> PM c
combinePMs f p1 p2 = warnPM (combinePRs f (discardWarningsPM p1)
(discardWarningsPM p2))
(concatWarns p1 p2)
where
concatWarns (WM _ w1) (WM _ w2) = w1 ++ w2
--- This module defines the AST structure generated by the parser
--- and used for the translation of SQL statements.
--- @author Julia Krone
--- @version 0.1
-- ---------------------------------------------------------------
module SQLAst where
import Time(CalendarTime)
data Statement = Select SelectHead Order (Maybe Int)
| Update Table [Assign] Condition
| UpdateEntity Table Value
| Delete Table Condition
| Insert Table [ColumnRef] [[Value]]
| Transaction
| InTransaction [Statement]
| Commit
| Rollback
--contains the table (Unique for a given alias
-- Def (default) in case no alias is given),
-- name of column, type of column, nullable, CDBI-alias
data ColumnRef = Column Tab String Type Bool Int
data Tab = Unique String | Def [String]
data Type = I | B | F | C | S | D | Key String | Entity String | Unknown
data Assign = Assign ColumnRef Value
data Value = Emb String Type
| IntExp Int
| KeyExp String Int -- referenced table (name) and value
| FloatExp Float
| StringExp String
| DateExp CalendarTime
| BoolExp Bool
| CharExp Char
| AbsNull
data SelectHead = Set ASetOp SelectHead SelectHead
| Query SelectClause TableRef Condition (Maybe Group)
data SelectClause = SelAll ASpecifier
| SelColumns ASpecifier [SelElement]
data SelElement = Aggregation AFun ASpecifier ColumnRef
| Col ColumnRef
| Case Condition Operand Operand
data Table = Table String String Int -- name alias and CDBI-alias
data TableRef = TableRef Table (Maybe JoinClause)
data JoinClause = CrossJoin Table (Maybe JoinClause)
| InnerJoin Table JoinCond (Maybe JoinClause)
data JoinCond = JC Condition
data ASpecifier = AAll | ADistinct
data Condition = FK (String,Int) AbsRel (String,Int)--(Table, Alias) Relation (Table,Alias)
| Cmp ALogOp Condition Condition
| Not Condition
| Exists Statement
| IsNull Operand
| NotNull Operand
| AIn Operand [Value]
| ABinOp AstOp Operand Operand
| ABetween Operand Operand Operand
| NoCond
data AbsRel = AMToN String
| ANToOne String
| AOneToN String
| NotSpec String
type Operand = Either ColumnRef Value
data AstOp = ALth | ALe | AGth | AGe | AEq | AUnEq | ALike
data ALogOp = AAnd | AOr
data ASetOp = AUnion | AExcept | AIntersect
data Group = GroupBy [ColumnRef] Having
data Having = SimpleHave Condition
| AggrHave AFun ASpecifier ColumnRef AstOp Operand
| Neg Having
| CmpHave ALogOp Having Having
| NoHave
data AFun = ASum | ACount | AAvg | AMin | AMax
data Order = OrderBy [(ColumnRef, Dir)]
data Dir = Asc | Desc
\ No newline at end of file
--- This module checks whether all referenced table- and
--- column- and relation names exist in the data model.
--- In addition it prepares the translation of insert statements
--- (checking correct number of values, inserting null-values, and
--- column names for completion). Furthermore
--- values for key columns (insert) are transformed to
--- a default value, because the CDBI library supports just
--- auto incrementing keys.
--- It is also ensured that foreign key constraints are just used in select
--- statements and that null-values are not used in conditions (instead
--- of the operators isNull and notNull).
--- Throws an error if one of the above is not given or can not be applied.
--- Generates a warning if the notation of aliases referencing the same table
--- differs or if the notation of table name, column name or relationship
--- name differs from the one given in the data model.
--- @author: Julia Krone
--- @version: 0.1
-- ---------------------------------------------------------------------
module SQLConsistency(checkConsistency) where
import Char(toLower, toUpper)
import FiniteMap
import List(delete)
import ParseTypes
import SQLAst
import SQLParserInfoType
--- Invokes the consistency check if a valid AST is given,
--- does nothing otherwise.
checkConsistency :: PM [Statement] -> ParserInfo -> Pos -> PM [Statement]
checkConsistency (WM (Errors err) ws) _ _ = WM (throwPR err) ws
checkConsistency (WM (OK ast) ws) pinfo p =
let relMap = getRelations pinfo
colMap = getAttrList pinfo
nullMap = getNullables pinfo
(WM resPR warns) =
sequencePM (map (checkStatement p relMap colMap nullMap) ast)
in (WM resPR (ws ++ warns))
-- Calls the corresponding functions for each kind of statement
-- and passes needed part of parser information.
checkStatement :: Pos ->
RelationFM ->
AttributesFM ->
NullableFM ->
Statement ->
PM Statement
checkStatement _ _ _ _ Rollback = cleanPM Rollback
checkStatement _ _ _ _ Commit = cleanPM Commit
checkStatement _ _ _ _ Transaction = cleanPM Transaction
checkStatement p relMap colMap nullMap (InTransaction stats) =
liftPM (\chStats -> InTransaction chStats)
(sequencePM (map (checkStatement p relMap colMap nullMap) stats))
checkStatement p relMap colMap _ (Delete tab cond) =
(bindPM (checkTable p colMap tab)
(checkDelete p relMap colMap cond))
checkStatement p _ colMap nullMap (Insert tab cols valss) =
bindPM (checkTable p colMap tab)
(checkInsert p colMap nullMap cols valss)
checkStatement p _ colMap _ (UpdateEntity tab val) =
liftPM (\(_, mTab) -> UpdateEntity mTab val)
(checkTable p colMap tab)
checkStatement p relMap colMap _ (Update tab assigns cond) =
bindPM (checkTable p colMap tab)
(checkColUpdate p relMap colMap assigns cond)
checkStatement p relMap colMap _ (Select selHead order limit) =
liftPM (\(chHead, chOrd) -> Select chHead chOrd limit)
(checkSelect p relMap colMap selHead order (emptyFM (>)))
-- ------------------------delete statement ------------------------------
checkDelete :: Pos ->
RelationFM ->
AttributesFM ->
Condition ->
((FM String (String, [String])), Table) ->
PM Statement
checkDelete p relMap colMap cond (fm, tab) =
liftPM (\chCond -> (Delete tab chCond))
(checkCondition p relMap colMap cond fm)
-- ------------------------ select statement ------------------------------
-- During the checking of SelectHead-node a finiteMap is build up containing
-- lists of column names with their corresponding table name as key. This map
-- is passed to the functions which checks the order-by-clause.
-- This is not the same map as contained in the parser info as it does just
-- contain tables really intrduced in the statement not all defined the model.
checkSelect :: Pos ->
RelationFM ->
AttributesFM ->
SelectHead ->
Order ->
FM String (String, [String]) ->
PM (SelectHead, Order)
checkSelect p relMap colMap selhead order fm =
let (chHead, tabMap) = checkSelHead p relMap colMap selhead fm
in combinePMs (,)
chHead
(checkOrder p tabMap order)
-- First of all the finiteMap is build and then used to check the other
-- parts of the SelectHead-node.
-- In case of a compound selectHead both parts are checked seperately in the
-- same way and the FMs are combined afterwards (overwriting bindings in the
-- second one in case there are duplicates).
-- Throws an error if table name is not defined.
-- Finite Maps from the parserInfo have to be passed down for checking of
-- subqueries which can be part of every condition
-- (also in case-exp and having-clauses).
checkSelHead :: Pos ->
RelationFM ->
AttributesFM ->
SelectHead ->
FM String (String, [String]) ->
(PM SelectHead, FM String (String, [String]))
checkSelHead p relMap colMap (Query selClause (TableRef tab join) cond gr) fm =
let chTabs = checkTableRefs p colMap tab join fm
in case chTabs of
(Right tabMap) -> (combinePMs
(\ (chSelCl, chTables) (chCond, chGr) ->
(Query chSelCl chTables chCond chGr))
(combinePMs
(,)
(checkSelClause p tabMap relMap colMap selClause)
(checkJoinConds p tab join tabMap relMap colMap))
(checkCondGr p relMap colMap tabMap cond gr),
tabMap)
(Left tabname) -> (throwPM p ("Undefined table name: "++tabname),
(emptyFM (>)))
checkSelHead p relMap colMap (Set setOp head1 head2) fm =
let (chHead1, fm1) = checkSelHead p relMap colMap head1 fm
(chHead2, fm2) = checkSelHead p relMap colMap head2 fm
in ((combinePMs (\h1 h2 -> Set setOp h1 h2) chHead1 chHead2),(plusFM fm1 fm2))
checkSelClause :: Pos ->
FM String (String, [String]) ->
RelationFM ->
AttributesFM ->
SelectClause ->
PM SelectClause
checkSelClause _ _ _ _ (SelAll sp) = cleanPM (SelAll sp)
checkSelClause p fm relMap colMap (SelColumns sp elems) =
liftPM (\chElems -> (SelColumns sp chElems))
(checkSelElems p elems fm relMap colMap)
checkSelElems :: Pos ->
[SelElement] ->
FM String (String, [String]) ->
RelationFM ->
AttributesFM ->
PM [SelElement]
checkSelElems p elems fm relMap colMap =
sequencePM (map (checkSelElem p fm relMap colMap) elems)
checkSelElem :: Pos ->
FM String (String, [String]) ->
RelationFM ->
AttributesFM ->
SelElement ->
PM SelElement
checkSelElem p fm _ _ (Col col) = liftPM (\chCol -> (Col chCol))
(checkColumnRef p col fm)
checkSelElem p fm rM cM (Case cond op1 op2) =
combinePMs (\ chCond (chOp1, chOp2) -> (Case chCond chOp1 chOp2))
(checkSelCond p rM cM cond fm)
(combinePMs (,) (checkIfCol p op1 fm)
(checkIfCol p op2 fm))
checkSelElem p fm _ _ (Aggregation fun sp col) =
liftPM (\chCol -> (Aggregation fun sp chCol))
(checkColumnRef p col fm)
-- Fills a FiniteMap with Column names and original notation
-- for each table name referenced in the statement.
-- The column names are fetched from the parser information module.
checkTableRefs :: Pos ->
AttributesFM ->
Table ->
Maybe JoinClause ->
FM String (String, [String]) ->
Either String (FM String (String, [String]))
checkTableRefs p colMap (Table name al nAl) join fm =
let columns = lookupFM colMap (lowerCase name)
in case columns of
Nothing -> Left name
(Just (tn, cols)) ->
case join of
Nothing -> Right (addToFM fm (lowerCase name) (tn,cols))
(Just (CrossJoin tab j)) ->
checkTableRefs p
colMap
tab
j
(addToFM fm (lowerCase name) (tn,cols))
(Just (InnerJoin tab _ j)) ->
checkTableRefs p
colMap
tab
j
(addToFM fm (lowerCase name) (tn,cols))
checkJoinConds :: Pos ->
Table ->
(Maybe JoinClause) ->
FM String (String, [String]) ->
RelationFM ->
AttributesFM ->
PM TableRef
checkJoinConds p tab Nothing fm _ _ =
liftPM (\chTab -> (TableRef chTab Nothing))
(checkTableName p tab fm)
checkJoinConds p tab (Just (CrossJoin tab2 join)) fm relMap colMap =
combinePMs (\(chTab, chTab2) chJoin ->
TableRef chTab (Just (CrossJoin chTab2 chJoin)))
(combinePMs (,) (checkTableName p tab fm)
(checkTableName p tab2 fm))
(checkJoinConds' p join fm relMap colMap)
checkJoinConds p tab (Just (InnerJoin tab2 cond join)) fm relMap colMap =
combinePMs (\(chCond, chJoin) (chTab, chTab2) ->
TableRef chTab (Just (InnerJoin chTab2 chCond chJoin)))
(combinePMs (,)(checkJoinCondition p cond fm relMap colMap)
(checkJoinConds' p join fm relMap colMap))
(combinePMs (,) (checkTableName p tab fm)
(checkTableName p tab2 fm) )
checkJoinCondition :: Pos ->
JoinCond ->
FM String (String, [String]) ->
RelationFM ->
AttributesFM ->
PM JoinCond
checkJoinCondition p (JC cond) fm relMap colMap =
liftPM (\ chCond -> JC chCond)
(checkSelCond p relMap colMap cond fm)
checkJoinConds' :: Pos ->
(Maybe JoinClause) ->
FM String (String, [String]) ->
RelationFM ->
AttributesFM ->
PM (Maybe JoinClause)
checkJoinConds' _ Nothing _ _ _ = cleanPM Nothing
checkJoinConds' p (Just (CrossJoin tab join)) fm relMap colMap =
combinePMs (\chTab chJoin -> Just (CrossJoin chTab chJoin))
(checkTableName p tab fm)
(checkJoinConds' p join fm relMap colMap )
checkJoinConds' p (Just (InnerJoin tab cond join)) fm relMap colMap =
combinePMs (\(chCond, chTab) chJoin -> (Just (InnerJoin chTab chCond chJoin)))
(combinePMs (,)
(checkJoinCondition p cond fm relMap colMap)
(checkTableName p tab fm))
(checkJoinConds' p join fm relMap colMap)
-- Generates warning if different notation is used for table name.
checkTableName :: Pos -> Table -> FM String (String, [String]) -> PM Table
checkTableName p (Table tn al nAl) fm =
case lookupFM fm (lowerCase tn) of
(Just (name, _)) ->
if name == tn
then cleanPM (Table name al nAl)
else warnOKPM (Table name al nAl)
[(p, ("Different notation used for table "++
"name "++name++" : "++tn))]
Nothing -> throwPM p ("Undefined table name: "++tn)
checkCondGr :: Pos ->
RelationFM ->
AttributesFM ->
FM String (String, [String]) ->
Condition ->
Maybe Group ->
PM (Condition, (Maybe Group))
checkCondGr p relMap colMap fm cond gr =
combinePMs (\chCond chGroup -> (chCond, chGroup))
(checkSelCond p relMap colMap cond fm)
(checkGroup p relMap colMap gr fm)
-- To ensure that ForeignKey-Constraints are just used in select statements
-- the checking of conditions in selects is done by this function.
-- The type of relationship is fetched from the parser info module
-- and inserted into the AST-node.
checkSelCond :: Pos ->
RelationFM ->
AttributesFM ->
Condition ->
FM String (String, [String]) ->
PM Condition
checkSelCond p relMap _ (FK (name1, al1) (NotSpec rel) (name2, al2)) fm =
let tab1 = maybe name1 fst (lookupFM fm (lowerCase name1))
tab2 = maybe name2 fst (lookupFM fm (lowerCase name2))
in case (lookupRel (tab1, rel, tab2) relMap) of
Nothing -> throwPM p ("Undefined relation "++rel++" between "++name1++
" and "++name2)
(Just (relType, orgName)) ->
(checkRelation
p
(FK (tab1, al1) (transRel relType) (tab2, al2))
rel
orgName)
checkSelCond p rM cM (Not cond) fm = liftPM (\chCond -> Not chCond)
(checkSelCond p rM cM cond fm)
checkSelCond p rM cM (Cmp logop cond1 cond2) fm =
combinePMs (\chC1 chC2 -> (Cmp logop chC1 chC2))
(checkSelCond p rM cM cond1 fm)
(checkSelCond p rM cM cond2 fm)
checkSelCond p relMap colMap (Exists stat) fm =
liftPM (\chSub -> Exists chSub)
(checkSubquery p relMap colMap stat fm)
checkSelCond p _ _ (IsNull op) fm =
liftPM (\chOp -> (IsNull chOp))
(checkOperand p op fm)
checkSelCond p _ _ (NotNull op) fm =
liftPM (\chOp -> (NotNull chOp))
(checkOperand p op fm)
checkSelCond p _ _ (AIn op vals) fm =
liftPM (\chOp -> AIn chOp vals)
(checkOperand p op fm)
checkSelCond p _ _ (ABinOp op operand1 operand2) fm =
combinePMs (\chOp1 chOp2 -> ABinOp op chOp1 chOp2)
(checkOperand p operand1 fm)
(checkOperand p operand2 fm)
checkSelCond p _ _ (ABetween op1 op2 op3) fm =
combinePMs (\chOp1 (chOp2, chOp3) -> ABetween chOp1 chOp2 chOp3)
(checkOperand p op1 fm)
(combinePMs (,) (checkOperand p op2 fm)
(checkOperand p op3 fm))
checkSelCond _ _ _ NoCond _ = cleanPM NoCond
-- Generates warnings if different notation is used for column name.
checkRelation :: Pos -> Condition -> String -> String -> PM Condition
checkRelation p fkCond relName orgName =
if relName == orgName
then cleanPM fkCond
else warnOKPM fkCond
[(p, ("Different notation used for relationship "++orgName
++" : "++relName))]
transRel :: RelationType -> AbsRel
transRel (NtoOne relN) = (ANToOne relN)
transRel (OnetoN relN) = (AOneToN relN)
transRel (MtoN relN) = (AMToN relN)
checkGroup :: Pos ->
RelationFM ->
AttributesFM ->
(Maybe Group) ->
FM String (String, [String]) ->
PM (Maybe Group)
checkGroup _ _ _ Nothing _ = cleanPM Nothing
checkGroup p relMap colMap (Just (GroupBy cols hav)) fm =
combinePMs (\ chCols chHav -> (Just (GroupBy chCols chHav)))
(sequencePM (map (flip(checkColumnRef p) fm) cols))
(checkHaving p relMap colMap hav fm)
checkHaving :: Pos ->
RelationFM ->
AttributesFM ->
Having ->
FM String (String, [String]) ->
PM Having
checkHaving _ _ _ NoHave _ = cleanPM NoHave
checkHaving p rM cM (CmpHave logop hav1 hav2) fm =
combinePMs (\chHav1 chHav2 -> (CmpHave logop chHav1 chHav2))
(checkHaving p rM cM hav1 fm)
(checkHaving p rM cM hav2 fm)
checkHaving p rM cM (Neg hav) fm = liftPM (\chHav -> (Neg chHav))
(checkHaving p rM cM hav fm)
checkHaving p _ _ (AggrHave fun sp col op operand) fm =
combinePMs (\chCol chOp -> (AggrHave fun sp chCol op chOp))
(checkColumnRef p col fm)
(checkIfCol p operand fm)
checkHaving p rM cM (SimpleHave cond) fm =
liftPM (\chCond -> SimpleHave chCond)
(checkSelCond p rM cM cond fm)
checkOrder :: Pos -> FM String (String, [String]) -> Order -> PM Order
checkOrder p fm (OrderBy colDirs) =
liftPM (\chColDirs -> (OrderBy chColDirs))
(sequencePM (map (checkColDir p fm) colDirs))
checkColDir :: Pos ->
FM String (String, [String]) ->
(ColumnRef, Dir) ->
PM (ColumnRef, Dir)
checkColDir p fm (col, dir) = liftPM (\chCol -> (chCol, dir))
(checkColumnRef p col fm)
-- --------------------------update statement ------------------------------
checkColUpdate :: Pos ->
RelationFM ->
AttributesFM ->
[Assign] ->
Condition ->
(FM String (String, [String]), Table) ->
PM Statement
checkColUpdate p relMap colMap assigns cond (fm, tab) =
combinePMs (\chAssigns chCond -> (Update tab chAssigns chCond))
(sequencePM (map (checkAssign p fm) assigns))
(checkCondition p relMap colMap cond fm)
checkAssign :: Pos -> FM String (String, [String]) -> Assign -> PM Assign
checkAssign p fm (Assign col val) =
liftPM (\chCol -> (Assign chCol val))
(checkColumnRef p col fm)
-- --------------------- insert statement --------------------------------
-- The FM is already filled with corresponding column names.
-- This function checks whether the number of given values corresponds with
-- number of given columns (or no columns are given and/or value is embedded
-- expression). In case column names are given they have to be defined in the
-- referenced table. Finally each list of values is prepared by inserting a
-- default value as key and null-values where they belong to.
-- Throws an error if number of columns or values is wrong, column name is
-- unknown or no value is given for a column that is not nullable.
-- Generates warnings for different notations.
checkInsert :: Pos ->
AttributesFM ->
NullableFM ->
[ColumnRef] ->
[[Value]] ->
(FM String (String, [String]), Table) ->
PM Statement
checkInsert p colMap nullMap cols valss (fm, tab) =
combinePMs (\chCols chValss -> (Insert tab chCols chValss))
(insertColumnRefs colMap nullMap tab)
(checkValueClause p nullMap tab cols valss fm)
checkValueClause :: Pos ->
NullableFM ->
Table ->
[ColumnRef] ->
[[Value]] ->
FM String (String, [String]) ->
PM [[Value]]
checkValueClause p nullMap tab@(Table tn _ _) cols valss fm =
let colNames = foldr (++) [] (map snd (eltsFM fm))
in
if not (and (map (checkValueCnt (length cols)) valss))
then throwPM p ("Number of values given in insert statement is not equal "
++"to number of columns referenced.")
else case cols of
[] -> combinePMs (\ _ vals -> vals)
(checkColumnNames p cols colNames tn)
(checkColumns p nullMap tab valss colNames)
(_:_) -> bindPM (checkColumnNames p cols colNames tn)
(prepareValues p nullMap tab valss colNames)
checkValueCnt :: Int -> [Value] -> Bool
checkValueCnt n vals | n==0 = True --this case will be checked later on
| otherwise = (length vals) == n
checkColumnNames :: Pos -> [ColumnRef] -> [String] -> String -> PM [ColumnRef]
checkColumnNames p cols names tabName =
sequencePM (map (findCorresName p names tabName) cols)
-- Inserts default key value in each list of values and checks whether null
-- values are allowed.
checkColumns :: Pos ->
NullableFM ->
Table ->
[[Value]] ->
[String] ->
PM [[Value]]
checkColumns p nullMap (Table name _ _) valss colNames =
sequencePM (map (insertKeyDefValue p nullMap name colNames) valss)
insertKeyDefValue :: Pos ->
NullableFM ->
String ->
[String] ->
[Value] ->
PM [Value]
insertKeyDefValue p nullMap tab cols vals =
let l = length cols
in case vals of