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
|