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
  | 
module CPP.ICode.Parser.SQL.ParserInfoType
 (dbName, getRelations, getNullables, getAttrList, RelationType(..),
  ParserInfo(..), getTypes, lookupRel, RelationFM, cdbiModule,
  NullableFM, AttributesFM, AttrTypeFM)
where
import Data.Char ( toLower )
import Data.List ( partition )
import qualified Data.Map as Map
type RelationFM = Map.Map String (Map.Map String [(String, RelationType)])
type RelationTypes = [((String, String, String), RelationType)]
type NullableFlags =  [(String, Bool)]
type NullableFM = Map.Map String Bool
type AttributeLists =  [(String,(String, [String]))]
type AttributesFM = Map.Map String (String, [String])
type AttributeTypes = [(String, String)]
type AttrTypeFM = Map.Map String String
data ParserInfo = PInfo String
                        String
                        RelationTypes
                        NullableFlags
                        AttributeLists
                        AttributeTypes
 deriving (Read,Show)
data RelationType = MtoN String
                   | NtoOne String
                   | OnetoN String
 deriving (Read,Show)
dbName :: ParserInfo -> String
dbName (PInfo db _ _ _ _ _ ) = db
cdbiModule :: ParserInfo -> String
cdbiModule (PInfo _ cdbi _ _ _ _) = cdbi
getRelations :: ParserInfo -> RelationFM
getRelations (PInfo _ _ rels _ _ _) = splitRelations rels
getNullables :: ParserInfo -> NullableFM
getNullables (PInfo _ _ _ nulls _ _) = Map.fromList nulls
getAttrList :: ParserInfo -> AttributesFM
getAttrList (PInfo _ _ _ _ attrs _ ) = Map.fromList attrs
getTypes :: ParserInfo -> AttrTypeFM
getTypes (PInfo _ _ _ _ _ types) = Map.fromList types
lookupRel :: (String, String, String) ->
             RelationFM ->
             Maybe (RelationType, String)
lookupRel (e1,rel,e2) fm =
  case Map.lookup e1 fm of
    Nothing  -> Nothing
    Just fm2 -> case Map.lookup e2 fm2 of
                   Nothing -> Nothing
                   Just rels -> fetchRel rel rels
  where fetchRel _ [] = Nothing
        fetchRel rName ((relName, relType):rs) =
              if (toLowerCase rName) == (toLowerCase relName)
                then (Just (relType, relName))
                else fetchRel rName rs
splitRelations ::  [((String, String, String), RelationType)] -> RelationFM
splitRelations []       = Map.empty
splitRelations (r:rels) =
  let (frst, rest) = selectFirstEntity (frsEnt r) (r:rels)
   in Map.union (splitRelations rest) (createFM frst)
frsEnt :: ((String, String, String), RelationType) ->  String
frsEnt ((ent, _ , _ ),_) = ent
sndEnt :: ((String, String, String), RelationType) ->  String
sndEnt (( _ , _ , ent ),_) = ent
selectFirstEntity :: String -> [((String, String, String), RelationType)]
                            -> ([((String,String, String), RelationType)],
                                [((String, String, String), RelationType)])
selectFirstEntity name rels = partition (\(( n, _, _),_) -> n == name) rels
createFM :: [((String, String, String), RelationType)] -> RelationFM
createFM []        = Map.empty
createFM (e:elems) = Map.singleton (frsEnt e) (insertElems (e:elems))
insertElems :: [((String, String, String), RelationType)] ->
               (Map.Map String [(String, RelationType)])
insertElems [] = Map.empty
insertElems (e:elems) = let (snds, rest) = (selectSecondEntity (sndEnt e)
                                                               (e:elems))
                         in Map.union (insertElems rest) snds
selectSecondEntity :: String ->
                      [((String, String, String), RelationType)] ->
                      ((Map.Map String [(String, RelationType)]),
                          [((String, String, String), RelationType)])
selectSecondEntity name rels =
  let (fit, nfit) = partition (\((_ , _, n),_) -> n == name) rels
   in ((createSubFM fit), nfit)
  where createSubFM [] = Map.empty
        createSubFM (((_,r,e2),rt):rs) = Map.singleton
                                                e2
                                                ((r,rt):(map selectRelation rs))
selectRelation :: ((String, String, String), RelationType) ->
                  (String, RelationType)
selectRelation ((_ , r, _), rt) = (r, rt)
toLowerCase :: String -> String
toLowerCase str = map toLower str
 |