--- This module resolves the pseudonym-tablename-binding for all columns --- and all relationship constraints in each parsed statement --- with the help of a symboltable. --- Errors are thrown whenever an alias can not be resolved, --- because it was not defined or is not visible or it was defined --- more than once. An error is also thrown for an alias that was --- defined but not used. ---@author: Julia Krone ---@version: 0.1 -- ------------------------------------------------------------------------ module SQLNamer(nameStatements) where import Data.Char (toLower) import ParseTypes import SQLAst import Symboltab --- Takes a list of completely parsed statements (wrapped in a PM), --- inserts the name of the corresponding table (resolving the --- pseudonym if given) and sets the right alias (int) for CDBI --- in each AST-node representing a column. The correct CDBI-alias --- is also set for each table-node and relationship-constraint-node. --- An error is thrown, if the referenced alias was not defined --- in the corresponding statement or if it is defined more than once. --- Consistence with the data model is not checked at this stage. ---@param pm - the PM containing list of parsed statements ---@return unchanged PM if it contained errors --- PM with named columns otherwise nameStatements :: PM [Statement] -> Pos -> PM [Statement] nameStatements (WM (Errors err) ws) _ = WM (throwPR err) ws nameStatements (WM (OK ast) ws) p = let (WM resPR warns) = sequencePM (map (nameStatement p emptyTable) ast) in (WM resPR (ws ++ warns)) -- Symboltable structure used for the naming process. -- The first finite map saves the notation given by the user, -- the pseudonym and the CDBI-alias. The second FM keeps track of how often -- a table name was referenced to calculate the correct CDBI-alias. type AliasSymTab = Symboltable [(String,String, Int)] Int --naming-function for statement node nameStatement :: Pos -> AliasSymTab -> Statement -> PM Statement nameStatement p st (Select selhead order lim) = let (nSelHeadPm, st1) = nameSelHead p st selhead in combinePMs (\nSelHead nOrder -> Select nSelHead nOrder lim) nSelHeadPm (nameOrder p st1 order) nameStatement p st (Update tab assigns cond) = nameUpdate p st tab assigns cond nameStatement _ _ (UpdateEntity tab val) = cleanPM (UpdateEntity tab val) nameStatement p st (Delete tab cond) = nameDelete p tab st cond nameStatement p st (Insert tab cols valss) = nameInsert p tab st cols valss nameStatement _ _ Transaction = cleanPM Transaction nameStatement p _ (InTransaction stats) = liftPM (\nStats -> (InTransaction nStats)) (sequencePM (map (nameStatement p emptyTable) stats)) nameStatement _ _ Commit = cleanPM Commit nameStatement _ _ Rollback = cleanPM Rollback -- naming-funtion for selectHead-node nameSelHead :: Pos -> AliasSymTab -> SelectHead -> (PM SelectHead, AliasSymTab) nameSelHead p st (Query selclause tabs cond group) = let symtab = insertTabs tabs st in case symtab of Right st1 -> ((combinePMs (\(nsc, ntabs) (nCond, nGroup) -> (Query nsc ntabs nCond nGroup)) (combinePMs (,)(nameSelClause p st1 selclause) (nameTableRefs p st1 tabs)) (combinePMs (,)(nameCond p st1 cond) (nameGroup p st1 group))), st1) Left err -> ((throwPM p err), st) nameSelHead p st (Set op h1 h2) = let (nhead1, st1) = nameSelHead p st h1 (nhead2, st2) = nameSelHead p emptyTable h2 in ((combinePMs (\nh1 nh2 -> (Set op nh1 nh2)) nhead1 nhead2) ,(combineST st1 st2)) -- naming-function for SelectClause-node nameSelClause :: Pos -> AliasSymTab -> SelectClause -> PM SelectClause nameSelClause _ _ sc@(SelAll _) = cleanPM sc nameSelClause p st (SelColumns sp elems) = liftPM (\nElems -> (SelColumns sp nElems)) (nameElems p st elems) -- naming-function for TableRef-node nameTableRefs :: Pos -> AliasSymTab -> TableRef -> PM TableRef nameTableRefs p st (TableRef tab Nothing) = liftPM (\nTab -> (TableRef nTab Nothing)) (nameTable p st tab) nameTableRefs p st (TableRef tab (Just (CrossJoin tab2 join))) = combinePMs (\(nTab, nTab2) nJoin -> (TableRef nTab (Just (CrossJoin nTab2 nJoin)))) (combinePMs (,) (nameTable p st tab) (nameTable p st tab2)) (nameJoins p st join) nameTableRefs p st (TableRef tab (Just (InnerJoin tab2 cond join))) = combinePMs (\(nTab, nTab2) (nJoinCond, nJoin) -> (TableRef nTab (Just (InnerJoin nTab2 nJoinCond nJoin)))) (combinePMs (,) (nameTable p st tab) (nameTable p st tab2)) (combinePMs (,) (nameJoinCond p st cond) (nameJoins p st join)) -- naming-function for JoinClause-node nameJoins :: Pos -> AliasSymTab -> Maybe JoinClause -> PM (Maybe JoinClause) nameJoins _ _ Nothing = cleanPM Nothing nameJoins p st (Just (CrossJoin tab join)) = combinePMs (\nTab nJoin -> (Just (CrossJoin nTab nJoin))) (nameTable p st tab) (nameJoins p st join) nameJoins p st (Just (InnerJoin tab cond join)) = combinePMs (\nTab (nCond, nJoin) -> (Just (InnerJoin nTab nCond nJoin))) (nameTable p st tab) (combinePMs (,)(nameJoinCond p st cond) (nameJoins p st join)) -- naming-function for JoinCond-node nameJoinCond :: Pos -> AliasSymTab -> JoinCond -> PM JoinCond nameJoinCond p st (JC cond)= liftPM (\nCond -> (JC nCond)) (nameCond p st cond) -- naming-function for Condition-node nameCond :: Pos -> AliasSymTab -> Condition -> PM Condition nameCond p st (FK (ps1,_) rel (ps2,_)) = combinePMs (\nTab1 nTab2 -> (FK nTab1 rel nTab2)) (getTable p ps1 st) (getTable p ps2 st) nameCond p st (Cmp op cond1 cond2) = combinePMs (\nCond1 nCond2 ->(Cmp op nCond1 nCond2)) (nameCond p st cond1) (nameCond p st cond2) nameCond p st (Not cond) = liftPM (\nCond -> (Not nCond)) (nameCond p st cond) nameCond p st (Exists stat) = liftPM (\nStat -> (Exists nStat)) (nameStatement p (enterScope st) stat) nameCond p st (IsNull op) = liftPM (\nOp -> (IsNull nOp)) (nameOperand p st op) nameCond p st (NotNull op) = liftPM (\nOp -> (NotNull nOp)) (nameOperand p st op) nameCond p st (AIn op vals) = liftPM (\nOp -> (AIn nOp vals)) (nameOperand p st op) nameCond p st (ABinOp bop op1 op2) = combinePMs (\nOp1 nOp2 -> (ABinOp bop nOp1 nOp2)) (nameOperand p st op1) (nameOperand p st op2) nameCond p st (ABetween op1 op2 op3) = combinePMs (\nOp1 (nOp2,nOp3) -> (ABetween nOp1 nOp2 nOp3)) (nameOperand p st op1) (combinePMs (,) (nameOperand p st op2) (nameOperand p st op3)) nameCond _ _ NoCond = cleanPM NoCond -- naming-function for Group-node nameGroup :: Pos -> AliasSymTab -> Maybe Group -> PM (Maybe Group) nameGroup p st (Just (GroupBy cols hav)) = combinePMs (\nCols nHave -> (Just (GroupBy nCols nHave))) (nameColumns p st cols) (nameHaving p st hav) nameGroup _ _ Nothing = cleanPM Nothing nameElems :: Pos -> AliasSymTab -> [SelElement] -> PM [SelElement] nameElems p st elems = sequencePM (map (nameSingleElem p st) elems) -- naming-function for an Element-node in SelectClause nameSingleElem :: Pos -> AliasSymTab -> SelElement -> PM SelElement nameSingleElem p st (Aggregation fun sp col) = liftPM (\nCol -> (Aggregation fun sp nCol)) (nameSingleColumn p st col) nameSingleElem p st (Col col) = liftPM (\nCol -> (Col nCol)) (nameSingleColumn p st col) nameSingleElem p st (Case cond op1 op2) = combinePMs (\nCond (nOp1, nOp2) -> (Case nCond nOp1 nOp2)) (nameCond p st cond) (combinePMs (,) (nameOperand p st op1) (nameOperand p st op2)) -- naming-function for an operand-node nameOperand :: Pos -> AliasSymTab-> Operand -> PM Operand nameOperand p st (Left col) = liftPM (\nCol -> (Left nCol)) (nameSingleColumn p st col) nameOperand _ _ (Right val) = cleanPM (Right val) -- naming-function for Having-node nameHaving :: Pos -> AliasSymTab -> Having -> PM Having nameHaving p st (SimpleHave cond) = liftPM (\nCond -> (SimpleHave nCond)) (nameCond p st cond) nameHaving p st (AggrHave fun sp col bop op) = combinePMs (\nCol nOp -> (AggrHave fun sp nCol bop nOp)) (nameSingleColumn p st col ) (nameOperand p st op) nameHaving p st (Neg have) = liftPM (\nHave -> (Neg nHave)) (nameHaving p st have) nameHaving p st (CmpHave lop have1 have2) = combinePMs (\nH1 nH2 -> (CmpHave lop nH1 nH2)) (nameHaving p st have1) (nameHaving p st have2) nameHaving _ _ NoHave = cleanPM NoHave -- naming-function for Order-node nameOrder :: Pos -> AliasSymTab -> Order -> PM Order nameOrder p st (OrderBy colDirs) = liftPM (\nOrds -> OrderBy nOrds) (sequencePM (map (nameSingleOrder p st) colDirs)) -- naming-function for a single column-direction-pair in Order-clause nameSingleOrder :: Pos -> AliasSymTab -> (ColumnRef, Dir) -> PM (ColumnRef, Dir) nameSingleOrder p st (col, dir) = liftPM (\nCol -> (nCol,dir)) (nameSingleColumn p st col) nameUpdate :: Pos -> AliasSymTab -> Table -> [Assign] -> Condition -> PM Statement nameUpdate p st tab assigns cond = let symtab = insertTab tab st in case symtab of Right st1 -> combinePMs (\nAssigns nCond -> (Update tab nAssigns nCond)) (nameAssignments p st1 assigns) (nameCond p st1 cond) -- this should not happen in update statements Left err -> throwPM p err nameAssignments :: Pos -> AliasSymTab -> [Assign] -> PM [Assign] nameAssignments p st assigns = sequencePM (map (nameAssign p st) assigns) -- naming-function for Assign-node nameAssign :: Pos -> AliasSymTab -> Assign -> PM Assign nameAssign p st (Assign col val) = liftPM (\nCol -> (Assign nCol val)) (nameSingleColumn p st col) nameInsert :: Pos -> Table -> AliasSymTab -> [ColumnRef] -> [[Value]] -> PM Statement nameInsert p tab st cols valss = let symtab = insertTab tab st in case symtab of Right st1 -> liftPM (\nCols -> (Insert tab nCols valss)) (nameColumns p st1 cols) --this should not happen in isert statements Left err -> throwPM p err nameDelete :: Pos -> Table -> AliasSymTab -> Condition -> PM Statement nameDelete p tab st cond = let symtab = insertTab tab st in case symtab of Right st1 -> liftPM (\nCond -> (Delete tab nCond)) (nameCond p st1 cond) --this should not happen in delete statements Left err -> throwPM p err --insert of one or more wrapped in TableRef-node insertTabs :: TableRef -> AliasSymTab -> Either String AliasSymTab insertTabs (TableRef tab join) st = checkJoinForTabs join (insertTab tab st) checkJoinForTabs :: Maybe JoinClause -> Either String AliasSymTab -> Either String AliasSymTab checkJoinForTabs Nothing st = st checkJoinForTabs (Just (CrossJoin tab join)) (Right st) = checkJoinForTabs join (insertTab tab st) checkJoinForTabs (Just (InnerJoin tab _ join)) (Right st) = checkJoinForTabs join (insertTab tab st) checkJoinForTabs (Just _) (Left tab) = (Left tab) -- inserts a single table into the symbol table, returns modified symbol table -- Increases count for CDBI-alias and also inserts it. -- In case of default alias "table" also the tablename itself is -- inserted as alias. insertTab :: Table -> AliasSymTab -> Either String AliasSymTab insertTab (Table name al _) st = let cnt = lookupSecondTable (toLowerCase name) st in let n = case cnt of Nothing -> 0 Just c -> c in if(al == "table") then case lookupFirstTable (toLowerCase name) st of Nothing -> Right (insertDefFirstTab (toLowerCase al) [(name, al, n)] (++) (insertSecondTable (toLowerCase name) (n+1) (insertFirstTable (toLowerCase name) [(name, name, n)] st))) (Just _) -> Left ("Ambiguous table reference: "++name) else case lookupFirstTable (toLowerCase al) st of Nothing -> Right (insertFirstTable (toLowerCase al) [(name, al, n)] (insertSecondTable (toLowerCase name) (n+1) st)) (Just _) -> Left ("Alias "++al++" was defined for more " ++"than one table.") nameColumns :: Pos -> AliasSymTab -> [ColumnRef] -> PM [ColumnRef] nameColumns p st cols = sequencePM (map (nameSingleColumn p st) cols) -- naming-function for ColumnRef-node -- replaces alias with table name and inserts CDBI-alias into column node -- If alias is not found an error is thrown. -- Warning is generated if notation of aliases differs. nameSingleColumn :: Pos -> AliasSymTab -> ColumnRef -> PM ColumnRef nameSingleColumn p st (Column (Unique pseudo) column typ nullable _) = case lookupFirstTable (toLowerCase pseudo) st of Nothing -> throwPM p ("Table alias "++pseudo++ " was not defined or "++ "is not visible.") (Just ((tab, orgAl, cnt):_)) -> if orgAl == pseudo then cleanPM (Column (Unique tab) column typ nullable cnt) else warnOKPM (Column (Unique tab) column typ nullable cnt) [(p, ("Found different notation of same "++ "alias: "++pseudo++" and "++orgAl))] nameSingleColumn p st (Column (Def pseudo) column typ nullable cnt) = case lookupFirstTable (toLowerCase (head pseudo)) st of --can just be default name "table" Nothing -> throwPM p ("No table given for column " ++column++". Maybe alias was" ++" defined but not used.") (Just tabs) -> let tns = map fstOfTriple tabs in cleanPM (Column (Def tns) column typ nullable cnt) -- inserts correct CDBI-Alias into each table-node -- ensures that alias is unique nameTable :: Pos -> AliasSymTab -> Table -> PM Table nameTable p st (Table name al _) = let key = if(al == "table") then (toLowerCase name) else (toLowerCase al) in case lookupFirstTable key st of Nothing -> throwPM p ("No Table found for table "++name) --can not happen (Just ((n, _ , cnt):_)) -> if ((toLowerCase n) == (toLowerCase name)) then cleanPM (Table name al cnt) else throwPM p ("Alias "++key++ " is defined for" ++ " more than one table.") -- Lookup-function used by relationship constraint -- Error is thrown if alias was not defined, a warning -- is generated if notation differs from defined alias. getTable :: Pos -> String -> AliasSymTab -> PM (String, Int) getTable p pseudo st = case lookupFirstTable (toLowerCase pseudo) st of Nothing -> throwPM p ("Table alias "++pseudo++ " was not defined.") (Just ((tab, orgAl, cnt):_)) -> if orgAl == pseudo then cleanPM (tab, cnt) else warnOKPM (tab, cnt) [(p, ("Found different notation of same "++ "alias or table: "++pseudo++" and "++ orgAl))] toLowerCase :: String -> String toLowerCase str = map toLower str fstOfTriple :: (a,b,c) -> a fstOfTriple (ele, _ , _) = ele