refactor: improve disambiguation error message
* reverse backwards relationships * remove redundancy from getJoinSelects * properly name Cardinality constructors
This commit is contained in:
steve-chavez
committed by
Steve Chavez
Steve Chavez
parent
4ef6926791
commit
f9c64d9f65
@@ -47,14 +47,14 @@ import Protolude
|
||||
getDbStructure :: Schema -> PgVersion -> HT.Transaction DbStructure
|
||||
getDbStructure schema pgVer = do
|
||||
HT.sql "set local schema ''" -- for getting the fully qualified name(schema.name) of every db object
|
||||
tabs <- HT.statement () allTables
|
||||
cols <- HT.statement schema $ allColumns tabs
|
||||
srcCols <- HT.statement schema $ allSourceColumns cols pgVer
|
||||
childRels <- HT.statement () $ allChildRelations tabs cols
|
||||
keys <- HT.statement () $ allPrimaryKeys tabs
|
||||
procs <- HT.statement schema allProcs
|
||||
tabs <- HT.statement () allTables
|
||||
cols <- HT.statement schema $ allColumns tabs
|
||||
srcCols <- HT.statement schema $ allSourceColumns cols pgVer
|
||||
m2oRels <- HT.statement () $ allM2ORels tabs cols
|
||||
keys <- HT.statement () $ allPrimaryKeys tabs
|
||||
procs <- HT.statement schema allProcs
|
||||
|
||||
let rels = addManyToManyRelations . addParentRelations $ addViewChildRelations srcCols childRels
|
||||
let rels = addM2MRels . addO2MRels $ addViewM2ORels srcCols m2oRels
|
||||
cols' = addForeignKeys rels cols
|
||||
keys' = addViewPrimaryKeys srcCols keys
|
||||
|
||||
@@ -91,9 +91,9 @@ decodeColumns tables =
|
||||
<*> nullableColumn HD.text
|
||||
<*> nullableColumn HD.text
|
||||
|
||||
decodeRelations :: [Table] -> [Column] -> HD.Result [Relation]
|
||||
decodeRelations tables cols =
|
||||
mapMaybe (relationFromRow tables cols) <$> HD.rowList relRow
|
||||
decodeRels :: [Table] -> [Column] -> HD.Result [Relation]
|
||||
decodeRels tables cols =
|
||||
mapMaybe (relFromRow tables cols) <$> HD.rowList relRow
|
||||
where
|
||||
relRow = (,,,,,)
|
||||
<$> column HD.text
|
||||
@@ -250,20 +250,20 @@ addForeignKeys rels = map addFk
|
||||
addFk col = col { colFK = fk col }
|
||||
fk col = find (lookupFn col) rels >>= relToFk col
|
||||
lookupFn :: Column -> Relation -> Bool
|
||||
lookupFn c Relation{relColumns=cs, relType=rty} = c `elem` cs && rty==Child
|
||||
lookupFn c Relation{relColumns=cs, relType=rty} = c `elem` cs && rty==M2O
|
||||
relToFk col Relation{relColumns=cols, relFColumns=colsF} = do
|
||||
pos <- L.elemIndex col cols
|
||||
colF <- atMay colsF pos
|
||||
return $ ForeignKey colF
|
||||
|
||||
{-
|
||||
Adds Views Child Relations based on SourceColumns found, the logic is as follows:
|
||||
Adds Views M2O Relations based on SourceColumns found, the logic is as follows:
|
||||
|
||||
Having a Relation{relTable=t1, relColumns=[c1], relFTable=t2, relFColumns=[c2], relType=Child} represented by:
|
||||
Having a Relation{relTable=t1, relColumns=[c1], relFTable=t2, relFColumns=[c2], relType=M2O} represented by:
|
||||
|
||||
t1.c1------t2.c2
|
||||
|
||||
When only having a t1_view.c1 source column, we need to add a View-Table Child Relation
|
||||
When only having a t1_view.c1 source column, we need to add a View-Table M2O Relation
|
||||
|
||||
t1.c1----t2.c2 t1.c1----------t2.c2
|
||||
-> ________/
|
||||
@@ -271,14 +271,14 @@ When only having a t1_view.c1 source column, we need to add a View-Table Child R
|
||||
t1_view.c1 t1_view.c1
|
||||
|
||||
|
||||
When only having a t2_view.c2 source column, we need to add a Table-View Child Relation
|
||||
When only having a t2_view.c2 source column, we need to add a Table-View M2O Relation
|
||||
|
||||
t1.c1----t2.c2 t1.c1----------t2.c2
|
||||
-> \________
|
||||
\
|
||||
t2_view.c2 t2_view.c1
|
||||
|
||||
When having t1_view.c1 and a t2_view.c2 source columns, we need to add a View-View Child Relation in addition to the prior
|
||||
When having t1_view.c1 and a t2_view.c2 source columns, we need to add a View-View M2O Relation in addition to the prior
|
||||
|
||||
t1.c1----t2.c2 t1.c1----------t2.c2
|
||||
-> \________/
|
||||
@@ -287,10 +287,10 @@ When having t1_view.c1 and a t2_view.c2 source columns, we need to add a View-Vi
|
||||
|
||||
The logic for composite pks is similar just need to make sure all the Relation columns have source columns.
|
||||
-}
|
||||
addViewChildRelations :: [SourceColumn] -> [Relation] -> [Relation]
|
||||
addViewChildRelations allSrcCols = concatMap (\rel ->
|
||||
addViewM2ORels :: [SourceColumn] -> [Relation] -> [Relation]
|
||||
addViewM2ORels allSrcCols = concatMap (\rel ->
|
||||
rel : case rel of
|
||||
Relation{relType=Child, relTable, relColumns, relFTable, relFColumns} ->
|
||||
Relation{relType=M2O, relTable, relColumns, relFTable, relFColumns} ->
|
||||
|
||||
let srcColsGroupedByView :: [Column] -> [[SourceColumn]]
|
||||
srcColsGroupedByView relCols = L.groupBy (\(_, viewCol1) (_, viewCol2) -> colTable viewCol1 == colTable viewCol2) $
|
||||
@@ -305,36 +305,36 @@ addViewChildRelations allSrcCols = concatMap (\rel ->
|
||||
-- TODO: This could be avoided if the Relation type is improved with a structure that maintains the association of relColumns and relFColumns
|
||||
srcCols `sortAccordingTo` cols = sortOn (\(k, _) -> L.lookup k $ zip cols [0::Int ..]) srcCols
|
||||
|
||||
viewTableChild =
|
||||
viewTableM2O =
|
||||
[ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
|
||||
relFTable relFColumns
|
||||
Child Nothing Nothing Nothing
|
||||
M2O Nothing Nothing Nothing
|
||||
| srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns ]
|
||||
|
||||
tableViewChild =
|
||||
tableViewM2O =
|
||||
[ Relation relTable relColumns
|
||||
(getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
|
||||
Child Nothing Nothing Nothing
|
||||
M2O Nothing Nothing Nothing
|
||||
| fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
|
||||
|
||||
viewViewChild =
|
||||
viewViewM2O =
|
||||
[ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
|
||||
(getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
|
||||
Child Nothing Nothing Nothing
|
||||
M2O Nothing Nothing Nothing
|
||||
| srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns
|
||||
, fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
|
||||
|
||||
in viewTableChild ++ tableViewChild ++ viewViewChild
|
||||
in viewTableM2O ++ tableViewM2O ++ viewViewM2O
|
||||
|
||||
_ -> [])
|
||||
|
||||
addParentRelations :: [Relation] -> [Relation]
|
||||
addParentRelations = concatMap (\rel@(Relation t c ft fc _ _ _ _) -> [rel, Relation ft fc t c Parent Nothing Nothing Nothing])
|
||||
addO2MRels :: [Relation] -> [Relation]
|
||||
addO2MRels = concatMap (\rel@(Relation t c ft fc _ _ _ _) -> [rel, Relation ft fc t c O2M Nothing Nothing Nothing])
|
||||
|
||||
addManyToManyRelations :: [Relation] -> [Relation]
|
||||
addManyToManyRelations rels = rels ++ addMirrorRelation (mapMaybe link2Relation links)
|
||||
addM2MRels :: [Relation] -> [Relation]
|
||||
addM2MRels rels = rels ++ addMirrorRelation (mapMaybe link2Relation links)
|
||||
where
|
||||
links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels
|
||||
links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==M2O). relType) rels
|
||||
groupFn :: Relation -> Text
|
||||
groupFn Relation{relTable=Table{tableSchema=s, tableName=t}} = s <> "_" <> t
|
||||
-- Reference : https://wiki.haskell.org/99_questions/Solutions/26
|
||||
@@ -342,12 +342,12 @@ addManyToManyRelations rels = rels ++ addMirrorRelation (mapMaybe link2Relation
|
||||
combinations 0 _ = [ [] ]
|
||||
combinations n xs = [ y:ys | y:xs' <- tails xs
|
||||
, ys <- combinations (n-1) xs']
|
||||
addMirrorRelation = concatMap (\rel@(Relation t c ft fc _ lt lc1 lc2) -> [rel, Relation ft fc t c Many lt lc2 lc1])
|
||||
addMirrorRelation = concatMap (\rel@(Relation t c ft fc _ lt lc1 lc2) -> [rel, Relation ft fc t c M2M lt lc2 lc1])
|
||||
link2Relation [
|
||||
Relation{relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c},
|
||||
Relation{ relColumns=lc2, relFTable=ft, relFColumns=fc}
|
||||
]
|
||||
| lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation t c ft fc Many (Just lt) (Just lc1) (Just lc2)
|
||||
| lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation t c ft fc M2M (Just lt) (Just lc1) (Just lc2)
|
||||
| otherwise = Nothing
|
||||
link2Relation _ = Nothing
|
||||
|
||||
@@ -567,9 +567,9 @@ columnFromRow tabs (s, t, n, desc, pos, nul, typ, u, l, p, d, e) = buildColumn <
|
||||
parseEnum :: Maybe Text -> [Text]
|
||||
parseEnum = maybe [] (split (==','))
|
||||
|
||||
allChildRelations :: [Table] -> [Column] -> H.Statement () [Relation]
|
||||
allChildRelations tabs cols =
|
||||
H.Statement sql HE.noParams (decodeRelations tabs cols) True
|
||||
allM2ORels :: [Table] -> [Column] -> H.Statement () [Relation]
|
||||
allM2ORels tabs cols =
|
||||
H.Statement sql HE.noParams (decodeRels tabs cols) True
|
||||
where
|
||||
sql = [q|
|
||||
SELECT ns1.nspname AS table_schema,
|
||||
@@ -597,9 +597,9 @@ allChildRelations tabs cols =
|
||||
WHERE confrelid != 0
|
||||
ORDER BY (conrelid, column_info.nums) |]
|
||||
|
||||
relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation
|
||||
relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
|
||||
Relation <$> table <*> cols <*> tableF <*> colsF <*> pure Child <*> pure Nothing <*> pure Nothing <*> pure Nothing
|
||||
relFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation
|
||||
relFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
|
||||
Relation <$> table <*> cols <*> tableF <*> colsF <*> pure M2O <*> pure Nothing <*> pure Nothing <*> pure Nothing
|
||||
where
|
||||
findTable s t = find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
|
||||
findCol s t c = find (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col == c) allCols
|
||||
|
||||
Reference in New Issue
Block a user