refactor: Rename synonyms to source columns

This commit is contained in:
steve-chavez
2019-11-05 12:55:48 -05:00
committed by Steve Chávez
parent 3b133d5554
commit db41fb454e
2 changed files with 47 additions and 47 deletions
+45 -45
View File
@@ -49,14 +49,14 @@ 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
syns <- HT.statement schema $ allSynonyms cols pgVer
srcCols <- HT.statement schema $ allSourceColumns cols pgVer
childRels <- HT.statement () $ allChildRelations tabs cols
keys <- HT.statement () $ allPrimaryKeys tabs
procs <- HT.statement schema allProcs
let rels = addManyToManyRelations . addParentRelations $ addViewChildRelations syns childRels
let rels = addManyToManyRelations . addParentRelations $ addViewChildRelations srcCols childRels
cols' = addForeignKeys rels cols
keys' = addViewPrimaryKeys syns keys
keys' = addViewPrimaryKeys srcCols keys
return DbStructure {
dbTables = tabs
@@ -109,15 +109,22 @@ decodePks tables =
where
pkRow = (,,) <$> column HD.text <*> column HD.text <*> column HD.text
decodeSynonyms :: [Column] -> HD.Result [Synonym]
decodeSynonyms cols =
mapMaybe (synonymFromRow cols) <$> HD.rowList synRow
decodeSourceColumns :: [Column] -> HD.Result [SourceColumn]
decodeSourceColumns cols =
mapMaybe (sourceColumnFromRow cols) <$> HD.rowList srcColRow
where
synRow = (,,,,,)
srcColRow = (,,,,,)
<$> column HD.text <*> column HD.text
<*> column HD.text <*> column HD.text
<*> column HD.text <*> column HD.text
sourceColumnFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe SourceColumn
sourceColumnFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
where
col1 = findCol s1 t1 c1
col2 = findCol s2 t2 c2
findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols
decodeProcs :: HD.Result (M.HashMap Text [ProcDescription])
decodeProcs =
-- Duplicate rows for a function means they're overloaded, order these by least args according to ProcDescription Ord instance
@@ -250,13 +257,13 @@ addForeignKeys rels = map addFk
return $ ForeignKey colF
{-
Adds Views Child Relations based on Synonyms found, the logic is as follows:
Adds Views Child 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:
t1.c1------t2.c2
When only having a t1_view.c1 synonym, we need to add a View to Table Child Relation
When only having a t1_view.c1 source column, we need to add a View-Table Child Relation
t1.c1----t2.c2 t1.c1----------t2.c2
-> ________/
@@ -264,58 +271,58 @@ When only having a t1_view.c1 synonym, we need to add a View to Table Child Rela
t1_view.c1 t1_view.c1
When only having a t2_view.c2 synonym, we need to add a Table to View Child Relation
When only having a t2_view.c2 source column, we need to add a Table-View Child 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 synonyms, we need to add a View to 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 Child Relation in addition to the prior
t1.c1----t2.c2 t1.c1----------t2.c2
-> \________/
/ \
t1_view.c1 t2_view.c2 t1_view.c1-------t2_view.c1
The logic for composite pks is similar just need to make sure all the Relation columns have synonyms.
The logic for composite pks is similar just need to make sure all the Relation columns have source columns.
-}
addViewChildRelations :: [Synonym] -> [Relation] -> [Relation]
addViewChildRelations allSyns = concatMap (\rel ->
addViewChildRelations :: [SourceColumn] -> [Relation] -> [Relation]
addViewChildRelations allSrcCols = concatMap (\rel ->
rel : case rel of
Relation{relType=Child, relTable, relColumns, relFTable, relFColumns} ->
let colSynsGroupedByView :: [Column] -> [[Synonym]]
colSynsGroupedByView relCols = L.groupBy (\(_, viewCol1) (_, viewCol2) -> colTable viewCol1 == colTable viewCol2) $
filter (\(c, _) -> c `elem` relCols) allSyns
colsSyns = colSynsGroupedByView relColumns
fColsSyns = colSynsGroupedByView relFColumns
getView :: [Synonym] -> Table
let srcColsGroupedByView :: [Column] -> [[SourceColumn]]
srcColsGroupedByView relCols = L.groupBy (\(_, viewCol1) (_, viewCol2) -> colTable viewCol1 == colTable viewCol2) $
filter (\(c, _) -> c `elem` relCols) allSrcCols
relSrcCols = srcColsGroupedByView relColumns
relFSrcCols = srcColsGroupedByView relFColumns
getView :: [SourceColumn] -> Table
getView = colTable . snd . unsafeHead
syns `allSynsOf` cols = S.fromList (fst <$> syns) == S.fromList cols
srcCols `allSrcColsOf` cols = S.fromList (fst <$> srcCols) == S.fromList cols
-- Relation is dependent on the order of relColumns and relFColumns to get the join conditions right in the generated query.
-- So we need to change the order of the synonyms to match the relColumns
-- This could be avoided if the Relation type is improved with a structure that maintains the association of relColumns and relFColumns
syns `sortAccordingTo` columns = sortOn (\(k, _) -> L.lookup k $ zip columns [0::Int ..]) syns
-- So we need to change the order of the SourceColumns to match the relColumns
-- 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 =
[ Relation (getView syns) (snd <$> syns `sortAccordingTo` relColumns)
[ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
relFTable relFColumns
Child Nothing Nothing Nothing
| syns <- colsSyns, syns `allSynsOf` relColumns ]
| srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns ]
tableViewChild =
[ Relation relTable relColumns
(getView fSyns) (snd <$> fSyns `sortAccordingTo` relFColumns)
(getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
Child Nothing Nothing Nothing
| fSyns <- fColsSyns, fSyns `allSynsOf` relFColumns ]
| fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
viewViewChild =
[ Relation (getView syns) (snd <$> syns `sortAccordingTo` relColumns)
(getView fSyns) (snd <$> fSyns `sortAccordingTo` relFColumns)
[ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
(getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
Child Nothing Nothing Nothing
| syns <- colsSyns, syns `allSynsOf` relColumns
, fSyns <- fColsSyns, fSyns `allSynsOf` relFColumns ]
| srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns
, fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
in viewTableChild ++ tableViewChild ++ viewViewChild
@@ -344,10 +351,10 @@ addManyToManyRelations rels = rels ++ addMirrorRelation (mapMaybe link2Relation
| otherwise = Nothing
link2Relation _ = Nothing
addViewPrimaryKeys :: [Synonym] -> [PrimaryKey] -> [PrimaryKey]
addViewPrimaryKeys syns = concatMap (\pk ->
addViewPrimaryKeys :: [SourceColumn] -> [PrimaryKey] -> [PrimaryKey]
addViewPrimaryKeys srcCols = concatMap (\pk ->
let viewPks = (\(_, viewCol) -> PrimaryKey{pkTable=colTable viewCol, pkName=colName viewCol}) <$>
filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) syns in
filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) srcCols in
pk : viewPks)
allTables :: H.Statement () [Table]
@@ -711,9 +718,9 @@ pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
allSynonyms :: [Column] -> PgVersion -> H.Statement Schema [Synonym]
allSynonyms cols pgVer =
H.Statement sql (param HE.text) (decodeSynonyms cols) True
allSourceColumns :: [Column] -> PgVersion -> H.Statement Schema [SourceColumn]
allSourceColumns cols pgVer =
H.Statement sql (param HE.text) (decodeSourceColumns cols) True
-- query explanation at https://gist.github.com/steve-chavez/7ee0e6590cddafb532e5f00c46275569
where
subselectRegex :: Text
@@ -780,13 +787,6 @@ allSynonyms cols pgVer =
where resorigtbl <> '0'
order by view_schema, view_name, view_colum_name; |]
synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe Synonym
synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
where
col1 = findCol s1 t1 c1
col2 = findCol s2 t2 c2
findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols
getPgVersion :: H.Session PgVersion
getPgVersion = H.statement () $ H.Statement sql HE.noParams versionRow False
where
+2 -2
View File
@@ -222,8 +222,8 @@ data Column =
instance Eq Column where
Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
-- | A view column that refers to a table column
type Synonym = (Column, ViewColumn)
-- | The source table column a view column refers to
type SourceColumn = (Column, ViewColumn)
type ViewColumn = Column
data PrimaryKey = PrimaryKey {