diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index 30f0c52d2..45cc589d8 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -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 diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index 88047d6d6..20ceb0093 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -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 {