--- 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 List(delete)

import Data.FiniteMap

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
       [(Emb _ _)] -> cleanPM vals
       _           ->
           let vlen = (length vals)
           in if vlen == l
                then checkNulls p nullMap tab cols ((KeyExp tab 42):(tail vals))
                else if vlen == (l-1)
                      then checkNulls p nullMap tab cols((KeyExp tab 42):vals)
                      else throwPM p ("Expected values for "++(show l)++" or "
                                      ++(show (l-1))++" (without key) columns,"
                                      ++"but got "++(show vlen))

checkNulls :: Pos -> NullableFM -> String -> [String] -> [Value] -> PM [Value]
checkNulls _ _ _ _ [] = cleanPM []
checkNulls p _ tab [] (_:_) = throwPM p ("Too much values given for table "
                                             ++tab)
checkNulls p nullables tab (c:cols) (v:vals) =
  case v of
     AbsNull -> case lookupFM nullables ((firstLow tab)++c) of
                 (Just True) -> liftPM (\vs -> (v:vs))
                                 (checkNulls p nullables tab cols vals)
                 _           -> throwPM p ("Column "++c++" is not nullable.")
     _       ->  liftPM (\vs -> (v:vs))
                        (checkNulls p nullables tab cols vals)

-- Checks whether there is a value given for each column that is not nullable 
-- or key. In case of columns, which can be null, null values are
-- inserted in case no value is given. 
prepareValues :: Pos ->
                 NullableFM ->
                 Table ->
                 [[Value]] ->
                 [String] ->
                 [ColumnRef] ->
                 PM [[Value]]
prepareValues p nls (Table tab _ _) valss colNames cols =
  case (getNullColumns nls tab colNames cols 0 []) of
     Left col    -> throwPM p ("No value given for column "++col++
                                " but it's not nullable.")
     Right nulls -> sequencePM (map (insertAndCheck nulls) valss)
  where insertAndCheck ns vss = checkNulls p
                                           nls
                                           tab
                                           colNames
                                           (insertNullValues tab ns vss)

-- Returns a list of Ints identifying the columns where null values 
-- are to be inserted or the name of a column which is given without
-- value but con not be null.
getNullColumns ::  NullableFM ->
                   String ->
                   [String] ->
                   [ColumnRef] ->
                   Int ->
                   [Int] ->
                   Either String [Int]
getNullColumns _ _ [] [] _ nulls = Right nulls
getNullColumns nullables tab (n:ns) [] cnt nulls =
 case lookupFM nullables ((firstLow tab)++n) of
    (Just True) -> getNullColumns nullables tab ns [] (cnt+1) (cnt:nulls)
    _           -> Left n
getNullColumns _ _ [] ((Column _ col _ _ _):_) _ _ = Left col
getNullColumns nullables tab (n:ns) cols@((Column _ col _ _ _):cs) cnt nulls =
  if n == (firstUp col)
    then getNullColumns nullables tab ns cs (cnt+1) nulls
    else if n == "Key"
          then getNullColumns nullables tab ns cols (cnt+1) (0:nulls)
          else case lookupFM nullables ((firstLow tab)++n) of
                  (Just True) -> getNullColumns nullables
                                                tab
                                                ns
                                                cols
                                                (cnt+1)
                                                (cnt:nulls)
                  _           -> Left n

-- Inserts null values into the list of values according to the 
-- list of Ints.
insertNullValues :: String -> [Int] -> [Value] -> [Value]
insertNullValues tab nulls vals =
  if 0 `elem` nulls
     then (KeyExp tab 42):(insertNullValues' (delete 0 nulls) 1 vals)
     else (KeyExp tab 42):(insertNullValues' nulls 1 (tail vals))
  where insertNullValues' [] _ [] = []
        insertNullValues' [] _ (v:vs) = (v:vs)
        insertNullValues' (_:ns) cnt [] =
                      AbsNull:(insertNullValues' ns cnt [])
        insertNullValues' (n:ns) cnt (v:vs) =
           if cnt `elem` (n:ns)
            then AbsNull:(insertNullValues' (delete cnt (n:ns)) (cnt+1) (v:vs))
            else v:(insertNullValues' (n:ns) (cnt+1) vs)

-- Inserts all columns for referenced table as fetched from the parser info
-- module into the AST whether they were given before or not. That's needed
-- by the type checker and translator.             
insertColumnRefs :: AttributesFM ->
                    NullableFM ->
                    Table ->
                    PM [ColumnRef]
insertColumnRefs colMap nullMap (Table name _ _) =
  let cols = lookupFM colMap (lowerCase name)
   in case cols of
         (Just (tab,cs)) -> cleanPM (map (buildColRef nullMap name) cs)
         Nothing         -> cleanPM []

buildColRef :: NullableFM -> String -> String -> ColumnRef
buildColRef nullMap tab col =
  case lookupFM nullMap ((firstLow tab)++ col) of
        Nothing  -> (Column (Unique tab) col Unknown False 0) --should not happen
        (Just b) -> (Column (Unique tab) col Unknown b 0)

-- ---------------------common elements --------------------------------

-- Given a table all column names and the original notation of the table name
-- are fetched from the parser info module and inserted into
-- a new finiteMap with the table name (small letters) as key.
-- Throws an error if the table name is not defined. Generates warning 
-- if a different notation is used.
checkTable :: Pos ->
              AttributesFM ->
              Table ->
              PM ((FM String (String,[String])), Table)
checkTable p colMap (Table name al nAl) =
 case lookupFM colMap (lowerCase name) of
      Nothing   -> throwPM p ("There is no Table called "++name)
      (Just (tab,cs)) -> if name == tab
                           then cleanPM ((unitFM (>) (lowerCase name) (tab,cs)),
                                         (Table tab al nAl))
                           else warnOKPM ((unitFM (>) (lowerCase name) (tab,cs)),
                                         (Table tab al nAl))
                                         [(p, ("Different notation used for "++
                                               "table "++tab++" : "++name))]

-- Checks the condition in update and delete statements.
-- Throws an error in case a foreign key constraint is given.
checkCondition :: Pos ->
                  RelationFM ->
                  AttributesFM ->
                  Condition ->
                  FM String (String, [String]) ->
                  PM Condition
checkCondition p rM cM (Not cond) fm = liftPM (\chCond -> Not chCond)
                                              (checkCondition p rM cM cond fm)
checkCondition p rM cM (Cmp logop cond1 cond2) fm =
             combinePMs (\chC1 chC2 -> (Cmp logop chC1 chC2))
                        (checkCondition p rM cM cond1 fm)
                        (checkCondition p rM cM cond2 fm)
checkCondition p rM cM (Exists stat) fm =
             liftPM (\chSub -> Exists chSub)
                    (checkSubquery p rM cM stat fm)
checkCondition p _ _ (IsNull op) fm =
             liftPM (\chOp -> (IsNull chOp))
                    (checkOperand p op fm)
checkCondition p _ _ (NotNull op) fm =
            liftPM (\chOp -> (NotNull chOp))
                   (checkOperand p op fm)
checkCondition p _ _ (AIn op vals) fm =
            combinePMs (\chOp chVals -> AIn chOp chVals)
                       (checkOperand p op fm)
                       (checkValsNotNull p vals)
checkCondition p _ _ (ABinOp op operand1 operand2) fm =
           combinePMs (\chOp1 chOp2 -> ABinOp op chOp1 chOp2)
                      (checkOperand p operand1 fm)
                      (checkOperand p operand2 fm)
checkCondition 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))
checkCondition p _ _ (FK _ _ _) _ = throwPM p ("Foreign Key Constraints are just"
                                               ++" allowed in Select queries.")
checkCondition _ _ _ NoCond _ = cleanPM NoCond

-- In the subquery the outer tables can be used too, so the FM has
-- to be passed on.
checkSubquery :: Pos ->
                 RelationFM ->
                 AttributesFM ->
                 Statement ->
                 FM String (String, [String]) ->
                 PM Statement
checkSubquery p rM cM (Select selHead order lim) fm =
     liftPM (\(chHead, chOrd) -> Select chHead chOrd lim)
            (checkSelect p rM cM selHead order fm)

-- Checks the operands that are used in the condition. 
-- An error is thrown in case a null-value is passed.
checkOperand :: Pos -> Operand -> FM String (String, [String]) -> PM Operand
checkOperand p (Left col) fm = liftPM (\chCol -> Left chCol)
                                      (checkColumnRef p col fm)
checkOperand p op@(Right val) _ =
  case val of
     AbsNull -> throwPM p ("Null values are not allowed in Condition,"++
                            " use 'isNull' or 'notNull' instead.")
     _       -> cleanPM op


-- Checks whether the given column is defined in one of the referenced tables. 
-- Throws an error in case column or table name are not found.
-- In case no alias was given for the column, its name is looked up
-- in all tables that were defined without alias. If it is found in exactly
-- one table this one is set. An error is thrown in all other cases.
checkColumnRef :: Pos ->
                  ColumnRef ->
                  FM String (String, [String]) ->
                  PM ColumnRef
checkColumnRef p cr@(Column (Unique tab) _ _ _ _) fm =
     case lookupFM fm (lowerCase tab) of
          Nothing   -> throwPM p ("Table called "++tab++" is not defined.")
          Just (tn,cols) -> findCorresName p cols tn cr
checkColumnRef p (Column (Def tabs) colName typ n nAl) fm =
   let finalTab = checkAllTables tabs colName fm []
    in case (length finalTab) of
          0 -> throwPM p ("Undefined column name "++colName)
          1 -> checkColumnRef p
                              (Column (Unique (head finalTab)) colName typ n nAl)
                              fm
          _ -> throwPM p ("Column name "++colName++" cannot be related"
                           ++" to a unique table.")

-- Looks up a column name in all tables that were given without an alias.                            
checkAllTables :: [String] ->
                  String ->
                  FM String (String, [String]) ->
                  [String] ->
                  [String]
checkAllTables [] _ _ res = res
checkAllTables (tab:ts) col fm res =
   case lookupFM fm (lowerCase tab) of
     Nothing -> checkAllTables ts col fm res
     Just (tn, cols) -> checkAllColumns tn cols col
 where checkAllColumns _ [] cs = checkAllTables ts cs fm res
       checkAllColumns tabName (c:cs) column =
            if (lowerCase c) == (lowerCase column)
              then checkAllTables ts column fm (tabName:res)
              else checkAllColumns tabName cs column

--In a list of column names finds the corresponding one independent of
--notation differences. Throws an error if name can not be found.
--Generates warning if notation differs.
findCorresName :: Pos -> [String] -> String -> ColumnRef -> PM ColumnRef
findCorresName p [] _ (Column _ c _ _ _) = throwPM p
                                                   ("Undefined column name "++c)
findCorresName p (col:cols) tab column@(Column _ c typ n nAl) =
               if (lowerCase c) == (lowerCase col)
                 then if c == col
                        then cleanPM (Column (Unique tab) col typ n nAl)
                        else warnOKPM (Column (Unique tab) col typ n nAl)
                                      [(p,("Different notation used for column "
                                              ++col++": "++c))]
                 else findCorresName p cols tab column

-- Checks operands that are used in case-expressions and having-clauses.
-- All values (including null-values) go through at this stage just
-- columns are checked. 
checkIfCol :: Pos -> Operand -> FM String (String, [String]) -> PM Operand
checkIfCol _ (Right val) _ = cleanPM (Right val)
checkIfCol p (Left col) fm =
    liftPM (\chCol -> (Left chCol))
           (checkColumnRef p col fm)

-- Checks that none of the values in a list is null.         
checkValsNotNull :: Pos -> [Value] -> PM [Value]
checkValsNotNull p vals =
    sequencePM (map (\v -> case v of
                            AbsNull -> throwPM p ("Found Null-value in"++
                                                  " condition clause.")
                            _       -> cleanPM v)
                    vals)

--auxiliary functions --------------------------

firstUp :: String -> String
firstUp [] = ""
firstUp (s:str) = (toUpper s):str

firstLow :: String -> String
firstLow [] = ""
firstLow (s:str) = (toLower s):str

lowerCase :: String -> String
lowerCase str = map toLower str