Fix bug in many-many relation detection introduced but prev PR

This commit is contained in:
Ruslan Talpa
2015-12-22 16:36:02 +02:00
parent 437a592c65
commit a61778dba0
3 changed files with 8 additions and 2 deletions
+3 -1
View File
@@ -127,12 +127,14 @@ addParentRelations [] = []
addParentRelations (rel@(Relation t c ft fc _ _ _ _):rels) = Relation ft fc t c Parent Nothing Nothing Nothing : rel : addParentRelations rels
addManyToManyRelations :: [Relation] -> [Relation]
addManyToManyRelations rels = rels ++ mapMaybe link2Relation links
addManyToManyRelations rels = rels ++ addMirrorRelation (mapMaybe link2Relation links)
where
links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels
groupFn :: Relation -> Text
groupFn (Relation{relTable=Table{tableSchema=s, tableName=t}}) = s<>"_"<>t
combinations k ns = filter ((k==).length) (subsequences ns)
addMirrorRelation [] = []
addMirrorRelation (rel@(Relation t c ft fc _ lt lc1 lc2):rels') = Relation ft fc t c Many lt lc2 lc1 : rel : addMirrorRelation rels'
link2Relation [
Relation{relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c},
Relation{ relColumns=lc2, relFTable=ft, relFColumns=fc}
-1
View File
@@ -129,7 +129,6 @@ addRelations schema allRelations parentNode node@(Node readNode@(query, (name, _
where
rel = note ("no relation between " <> parentTable <> " and " <> name)
$ findRelationByTable schema name parentTable
<|> findRelationByTable schema parentTable name
<|> findRelationByColumn schema parentTable name
addRel :: (ReadQuery, (NodeName, Maybe Relation)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation))
addRel (q, (n, _)) r = (q {from=fromRelation}, (n, Just r))
+5
View File
@@ -214,6 +214,11 @@ spec struct pool = around (withApp cfgDefault struct pool) $ do
get "/tasks?select=id,users{id}" `shouldRespondWith`
[str|[{"id":1,"users":[{"id":1},{"id":3}]},{"id":2,"users":[{"id":1}]},{"id":3,"users":[{"id":1}]},{"id":4,"users":[{"id":1}]},{"id":5,"users":[{"id":2},{"id":3}]},{"id":6,"users":[{"id":2}]},{"id":7,"users":[{"id":2}]},{"id":8,"users":[]}]|]
it "requesting many<->many relation reverse" $
get "/users?select=id,tasks{id}" `shouldRespondWith`
[str|[{"id":1,"tasks":[{"id":1},{"id":2},{"id":3},{"id":4}]},{"id":2,"tasks":[{"id":5},{"id":6},{"id":7}]},{"id":3,"tasks":[{"id":1},{"id":5}]}]|]
it "requesting parents and children on views" $
get "/projects_view?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith`
[str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]