jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: simplify addXRels

Browse Source
This commit is contained in:
Wolfgang Walther
2021-01-03 17:54:28 +01:00
committed by Wolfgang Walther
parent 45ebaf0ad8
commit b8e6450af1
1 changed files with 44 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/DbStructure.hs
+44 -59
View File
@@ -12,8 +12,10 @@ These queries are executed once at startup or when PostgREST is reloaded.
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
module PostgREST.DbStructure ( module PostgREST.DbStructure (
getDbStructure getDbStructure
, accessibleTables , accessibleTables
@@ -33,7 +35,6 @@ import qualified Hasql.Transaction as HT
import Contravariant.Extras (contrazip2) import Contravariant.Extras (contrazip2)
import Data.Set as S (fromList) import Data.Set as S (fromList)
import Data.Text (split) import Data.Text (split)
import GHC.Exts (groupWith)
import Protolude hiding (toS) import Protolude hiding (toS)
import Protolude.Conv (toS) import Protolude.Conv (toS)
import Protolude.Unsafe (unsafeHead) import Protolude.Unsafe (unsafeHead)
@@ -52,7 +53,7 @@ getDbStructure schemas extraSearchPath pgVer prepared = do
keys <- HT.statement () $ allPrimaryKeys tabs prepared keys <- HT.statement () $ allPrimaryKeys tabs prepared
procs <- HT.statement schemas $ allProcs prepared procs <- HT.statement schemas $ allProcs prepared
let rels = addM2MRels . addO2MRels $ addViewM2ORels srcCols m2oRels let rels = addO2MRels . addM2MRels $ addViewM2ORels srcCols m2oRels
cols' = addForeignKeys rels cols cols' = addForeignKeys rels cols
keys' = addViewPrimaryKeys srcCols keys keys' = addViewPrimaryKeys srcCols keys
@@ -339,71 +340,55 @@ 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. The logic for composite pks is similar just need to make sure all the Relation columns have source columns.
-} -}
addViewM2ORels :: [SourceColumn] -> [Relation] -> [Relation] addViewM2ORels :: [SourceColumn] -> [Relation] -> [Relation]
addViewM2ORels allSrcCols = concatMap (\rel -> addViewM2ORels allSrcCols = concatMap (\rel@Relation{..} -> rel :
rel : case rel of let
Relation{relType=M2O, relTable, relColumns, relConstraint, relFTable, relFColumns} -> 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
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 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
let srcColsGroupedByView :: [Column] -> [[SourceColumn]] viewTableM2O =
srcColsGroupedByView relCols = L.groupBy (\(_, viewCol1) (_, viewCol2) -> colTable viewCol1 == colTable viewCol2) $ [ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
filter (\(c, _) -> c `elem` relCols) allSrcCols relConstraint relFTable relFColumns
relSrcCols = srcColsGroupedByView relColumns M2O Nothing
relFSrcCols = srcColsGroupedByView relFColumns | srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns ]
getView :: [SourceColumn] -> Table
getView = colTable . snd . unsafeHead
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 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
viewTableM2O = tableViewM2O =
[ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns) [ Relation relTable relColumns
relConstraint relFTable relFColumns relConstraint
M2O Nothing (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
| srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns ] M2O Nothing
| fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
tableViewM2O = viewViewM2O =
[ Relation relTable relColumns [ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
relConstraint relConstraint
(getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns) (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
M2O Nothing M2O Nothing
| fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ] | srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns
, fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
viewViewM2O = in viewTableM2O ++ tableViewM2O ++ viewViewM2O)
[ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
relConstraint
(getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
M2O Nothing
| srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns
, fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
in viewTableM2O ++ tableViewM2O ++ viewViewM2O
_ -> [])
addO2MRels :: [Relation] -> [Relation] addO2MRels :: [Relation] -> [Relation]
addO2MRels = concatMap (\rel@(Relation t c cn ft fc _ _) -> [rel, Relation ft fc cn t c O2M Nothing]) addO2MRels rels = rels ++ [ Relation ft fc con t c O2M Nothing
| Relation t c con ft fc typ _ <- rels
, typ == M2O]
addM2MRels :: [Relation] -> [Relation] addM2MRels :: [Relation] -> [Relation]
addM2MRels rels = rels ++ addMirrorRel (mapMaybe junction2Rel junctions) addM2MRels rels = rels ++ [ Relation t c Nothing ft fc M2M (Just $ Junction jt1 con1 jc1 con2 jc2)
where | Relation jt1 jc1 con1 t c _ _ <- rels
junctions = join $ map (combinations 2) $ groupWith groupFn $ filter ( (==M2O). relType) rels , Relation jt2 jc2 con2 ft fc _ _ <- rels
groupFn :: Relation -> (Text,Text) , jt1 == jt2
groupFn Relation{relTable=Table{tableSchema=s, tableName=t}} = (s,t) , con1 /= con2]
-- Reference : https://wiki.haskell.org/99_questions/Solutions/26
combinations :: Int -> [a] -> [[a]]
combinations 0 _ = [ [] ]
combinations n xs = [ y:ys | y:xs' <- tails xs
, ys <- combinations (n-1) xs']
junction2Rel [
Relation{relTable=jt, relColumns=jc1, relConstraint=const1, relFTable=t, relFColumns=c},
Relation{ relColumns=jc2, relConstraint=const2, relFTable=ft, relFColumns=fc}
]
| jc1 /= jc2 = Just $ Relation t c Nothing ft fc M2M (Just $ Junction jt const1 jc1 const2 jc2)
| otherwise = Nothing
junction2Rel _ = Nothing
addMirrorRel = concatMap (\rel@(Relation t c _ ft fc _ (Just (Junction jt const1 jc1 const2 jc2))) ->
[rel, Relation ft fc Nothing t c M2M (Just (Junction jt const2 jc2 const1 jc1))])
addViewPrimaryKeys :: [SourceColumn] -> [PrimaryKey] -> [PrimaryKey] addViewPrimaryKeys :: [SourceColumn] -> [PrimaryKey] -> [PrimaryKey]
addViewPrimaryKeys srcCols = concatMap (\pk -> addViewPrimaryKeys srcCols = concatMap (\pk ->