SQLConsistency.curry 34.1 KB
Newer Older
Michael Hanus's avatar
Michael Hanus committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
--- 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
       [(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