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
|
module SQLParserInfoType
(dbName, getRelations, getNullables, getAttrList, RelationType(..),
ParserInfo(..), getTypes, lookupRel, RelationFM, cdbiModule,
NullableFM, AttributesFM, AttrTypeFM)
where
import Char(toLower)
import List(partition)
import Data.FiniteMap
type RelationFM = FM String (FM String [(String, RelationType)])
type RelationTypes = [((String, String, String), RelationType)]
type NullableFlags = [(String, Bool)]
type NullableFM = FM String Bool
type AttributeLists = [(String,(String, [String]))]
type AttributesFM = FM String (String, [String])
type AttributeTypes = [(String, String)]
type AttrTypeFM = FM String String
data ParserInfo = PInfo String
String
RelationTypes
NullableFlags
AttributeLists
AttributeTypes
data RelationType = MtoN String
| NtoOne String
| OnetoN String
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 _ _) = listToFM (>) nulls
getAttrList :: ParserInfo -> AttributesFM
getAttrList (PInfo _ _ _ _ attrs _ ) = listToFM (>) attrs
getTypes :: ParserInfo -> AttrTypeFM
getTypes (PInfo _ _ _ _ _ types) = listToFM (>) types
lookupRel :: (String, String, String) ->
RelationFM ->
Maybe (RelationType, String)
lookupRel (e1,rel,e2) fm =
case lookupFM fm e1 of
Nothing -> Nothing
Just fm2 -> case lookupFM fm2 e2 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 [] = emptyFM (>)
splitRelations (r:rels) =
let (frst, rest) = selectFirstEntity (frsEnt r) (r:rels)
in plusFM (createFM frst) (splitRelations rest)
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 [] = emptyFM (>)
createFM (e:elems) = unitFM (>) (frsEnt e) (insertElems (e:elems))
insertElems :: [((String, String, String), RelationType)] ->
(FM String [(String, RelationType)])
insertElems [] = emptyFM (>)
insertElems (e:elems) = let (snds, rest) = (selectSecondEntity (sndEnt e)
(e:elems))
in plusFM snds (insertElems rest)
selectSecondEntity :: String ->
[((String, String, String), RelationType)] ->
((FM String [(String, RelationType)]),
[((String, String, String), RelationType)])
selectSecondEntity name rels =
let (fit, nfit) = partition (\((_ , _, n),_) -> n == name) rels
in ((createSubFM fit), nfit)
where createSubFM [] = emptyFM (>)
createSubFM (((_,r,e2),rt):rs) = unitFM (>)
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
|