Fix for detecting many2many relations when the link table for more then 2 tables

This commit is contained in:
Ruslan Talpa
2015-10-28 10:41:16 +02:00
parent 482a43d722
commit 915ce0fa9d
+7 -3
View File
@@ -8,7 +8,7 @@ module PostgREST.PgStructure where
import Control.Applicative import Control.Applicative
import Control.Monad (join) import Control.Monad (join)
import Data.Functor.Identity import Data.Functor.Identity
import Data.List (elemIndex, find) import Data.List (elemIndex, find, subsequences)
import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Monoid import Data.Monoid
import Data.Text (Text, split) import Data.Text (Text, split)
@@ -172,17 +172,21 @@ allRelations = do
) )
|] |]
let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels
let links = filter ((==2).length) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations links = join $ map (combinations 2) $ filter ((>=1).length) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
return $ simpleRelations ++ mapMaybe link2Relation links return $ simpleRelations ++ mapMaybe link2Relation links
where where
groupFn :: Relation -> Text groupFn :: Relation -> Text
groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
combinations k ns = filter ((k==).length) (subsequences ns)
link2Relation [ link2Relation [
Relation{relSchema=sc, relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c}, Relation{relSchema=sc, relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c},
Relation{ relColumns=lc2, relFTable=ft, relFColumns=fc} Relation{ relColumns=lc2, relFTable=ft, relFColumns=fc}
] = Just $ Relation sc t c ft fc Many (Just lt) (Just lc1) (Just lc2) ]
| lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation sc t c ft fc Many (Just lt) (Just lc1) (Just lc2)
| otherwise = Nothing
link2Relation _ = Nothing link2Relation _ = Nothing
allColumns :: [Relation] -> H.Tx P.Postgres s [Column] allColumns :: [Relation] -> H.Tx P.Postgres s [Column]
allColumns rels = do allColumns rels = do
cols <- H.listEx $ [H.stmt| cols <- H.listEx $ [H.stmt|