Ability to embed using a specific relation when there are multiple between tables, fixes #907 (#918)

* Ability to embed using a specific relation when there are multiple between tables, fixes #907

* fix lint errors

* fix code comments

* add type comments
This commit is contained in:
Ruslan Talpa
2017-07-25 19:01:35 +03:00
committed by GitHub
parent 6d5f72bf5f
commit b03e3fbec7
6 changed files with 92 additions and 35 deletions
+1
View File
@@ -10,6 +10,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
- #889, Allow more than two conditions in a single and/or - @steve-chavez
- #883, Binary output support for RPC - @steve-chavez
- #885, Postgres COMMENTs on SCHEMA/TABLE/COLUMN are used for OpenAPI - @ldesgoui
- #907, Ability to embed using a specific relation when there are multiple between tables - @ruslantalpa
### Fixed
+46 -12
View File
@@ -91,9 +91,9 @@ augumentRequestWithJoin schema allRels request =
>>= addJoinFilters schema
addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
addRelations schema allRelations parentNode (Node readNode@(query, (name, _, alias)) forest) =
addRelations schema allRelations parentNode (Node readNode@(query, (name, _, alias, relationDetail)) forest) =
case parentNode of
(Just (Node (Select{from=[parentNodeTable]}, (_, _, _)) _)) ->
(Just (Node (Select{from=[parentNodeTable]}, (_, _, _, _)) _)) ->
Node <$> readNode' <*> forest'
where
forest' = updateForest $ hush node'
@@ -101,10 +101,10 @@ addRelations schema allRelations parentNode (Node readNode@(query, (name, _, ali
readNode' = addRel readNode <$> rel
rel :: Either ApiRequestError Relation
rel = note (NoRelationBetween parentNodeTable name)
$ findRelation schema name parentNodeTable
$ findRelation schema name parentNodeTable relationDetail
where
findRelation s nodeTableName parentNodeTableName =
findRelation s nodeTableName parentNodeTableName Nothing =
find (\r ->
s == tableSchema (relTable r) && -- match schema for relation table
s == tableSchema (relFTable r) && -- match schema for relation foriegn table
@@ -141,14 +141,48 @@ addRelations schema allRelations parentNode (Node readNode@(query, (name, _, ali
-- addRelation will turn project_id to project so the above condition will match
)
) allRelations
where n `colMatches` rc = (toS ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (toS n :: BS.ByteString)
addRel :: (ReadQuery, (NodeName, Maybe Relation, Maybe Alias)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
addRel (query', (n, _, a)) r = (query' {from=fromRelation}, (n, Just r, a))
findRelation s nodeTableName parentNodeTableName (Just rd) =
find (\r ->
s == tableSchema (relTable r) && -- match schema for relation table
s == tableSchema (relFTable r) && -- match schema for relation foriegn table
(
-- (request) => clients { ..., project.client_id{...} }
-- will match
-- (relation type) => parent
-- (entity) => clients {id}
-- (foriegn entity) => projects {client_id}
(
nodeTableName == tableName (relTable r) && -- match relation table name
parentNodeTableName == tableName (relFTable r) && -- && -- match relation foreign table name
length (relColumns r) == 1 &&
rd == (colName . unsafeHead . relColumns) r
)
||
-- (request) => tasks { ..., users.tasks_users{...} }
-- will match
-- (relation type) => many
-- (entity) => users
-- (foriegn entity) => tasks
(
relType r == Many &&
nodeTableName == tableName (relTable r) && -- match relation table name
parentNodeTableName == tableName (relFTable r) && -- match relation foreign table name
rd == tableName (fromJust (relLTable r))
)
)
) allRelations
n `colMatches` rc = (toS ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (toS n :: BS.ByteString)
addRel :: (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail))
addRel (query', (n, _, a, _)) r = (query' {from=fromRelation}, (n, Just r, a, Nothing))
where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from query')
_ -> n' <$> updateForest (Just (n' forest))
where
n' = Node (query, (name, Just r, alias))
n' = Node (query, (name, Just r, alias, Nothing))
t = Table schema name Nothing True -- !!! TODO find another way to get the table from the query
r = Relation t [] t [] Root Nothing Nothing Nothing
where
@@ -156,7 +190,7 @@ addRelations schema allRelations parentNode (Node readNode@(query, (name, _, ali
updateForest n = mapM (addRelations schema allRelations n) forest
addJoinFilters :: Schema -> ReadRequest -> Either ApiRequestError ReadRequest
addJoinFilters schema (Node node@(query, nodeProps@(_, relation, _)) forest) =
addJoinFilters schema (Node node@(query, nodeProps@(_, relation, _, _)) forest) =
case relation of
Just Relation{relType=Root} -> Node node <$> updatedForest -- this is the root node
Just Relation{relType=Parent} -> Node node <$> updatedForest
@@ -239,7 +273,7 @@ addProperty f (path, a) (Node rn forest) =
maybeNode = find fnd forst
where
fnd :: ReadRequest -> Bool
fnd (Node (_,(n,_,_)) _) = n == name
fnd (Node (_,(n,_,_,_)) _) = n == name
-- in a relation where one of the tables mathces "TableName"
-- replace the name to that table with pg_source
@@ -281,7 +315,7 @@ fieldNames (Node (sel, _) forest) =
map (fst . view _1) (select sel) ++ map colName fks
where
fks = concatMap (fromMaybe [] . f) forest
f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _)) _) = Just cols
f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _, _)) _) = Just cols
f _ = Nothing
-- Traditional filters(e.g. id=eq.1) are added as root nodes of the LogicTree
+15 -13
View File
@@ -56,17 +56,17 @@ lexeme p = ws *> p <* ws
pReadRequest :: Text -> Parser ReadRequest
pReadRequest rootNodeName = do
fieldTree <- pFieldForest
return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing)) []) fieldTree
return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing, Nothing)) []) fieldTree
where
readQuery = Select [] [rootNodeName] [] Nothing allRange
treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest
treeEntry (Node fld@((fn, _),_,alias) fldForest) (Node (q, i) rForest) =
treeEntry (Node fld@((fn, _),_,alias,relationDetail) fldForest) (Node (q, i) rForest) =
case fldForest of
[] -> Node (q {select=fld:select q}, i) rForest
_ -> Node (q, i) newForest
where
newForest =
foldr treeEntry (Node (Select [] [fn] [] Nothing allRange, (fn, Nothing, alias)) []) fldForest:rForest
foldr treeEntry (Node (Select [] [fn] [] Nothing allRange, (fn, Nothing, alias, relationDetail)) []) fldForest:rForest
pTreePath :: Parser (EmbedPath, Field)
pTreePath = do
@@ -78,9 +78,9 @@ pFieldForest :: Parser [Tree SelectItem]
pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
pFieldTree :: Parser (Tree SelectItem)
pFieldTree = try (Node <$> pSimpleSelect <*> between (char '{') (char '}') pFieldForest)
<|> try (Node <$> pSimpleSelect <*> between (char '(') (char ')') pFieldForest)
<|> Node <$> pSelect <*> pure []
pFieldTree = try (Node <$> pRelationSelect <*> between (char '{') (char '}') pFieldForest)
<|> try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest)
<|> Node <$> pFieldSelect <*> pure []
pStar :: Parser Text
pStar = toS <$> (string "*" *> pure ("*"::ByteString))
@@ -109,25 +109,27 @@ pField = lexeme $ (,) <$> pFieldName <*> optionMaybe pJsonPath
aliasSeparator :: Parser ()
aliasSeparator = char ':' >> notFollowedBy (char ':')
pSimpleSelect :: Parser SelectItem
pSimpleSelect = lexeme $ try ( do
pRelationSelect :: Parser SelectItem
pRelationSelect = lexeme $ try ( do
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
fld <- pField
return (fld, Nothing, alias)
relationDetail <- optionMaybe ( try( char '.' *> pFieldName ) )
return (fld, Nothing, alias, relationDetail)
)
pSelect :: Parser SelectItem
pSelect = lexeme $
pFieldSelect :: Parser SelectItem
pFieldSelect = lexeme $
try (
do
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
fld <- pField
cast' <- optionMaybe (string "::" *> many letter)
return (fld, toS <$> cast', alias)
return (fld, toS <$> cast', alias, Nothing)
)
<|> do
s <- pStar
return ((s, Nothing), Nothing, Nothing)
return ((s, Nothing), Nothing, Nothing, Nothing)
pOperation :: Parser Operand -> Parser Operand -> Parser Operation
pOperation parserVText parserVTextL = try ( string "not" *> pDelimiter *> (Operation True <$> pExpr)) <|> Operation False <$> pExpr
+7 -7
View File
@@ -199,7 +199,7 @@ pgFmtLit x =
requestToCountQuery :: Schema -> DbRequest -> SqlQuery
requestToCountQuery _ (DbMutate _) = undefined
requestToCountQuery schema (DbRead (Node (Select _ _ logicForest _ _, (mainTbl, _, _)) _)) =
requestToCountQuery schema (DbRead (Node (Select _ _ logicForest _ _, (mainTbl, _, _, _)) _)) =
unwords [
"SELECT pg_catalog.count(*)",
"FROM ", fromQi qi,
@@ -215,7 +215,7 @@ requestToCountQuery schema (DbRead (Node (Select _ _ logicForest _ _, (mainTbl,
filteredLogic = filter nonFKRoot logicForest
requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery
requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest ord range, (nodeName, maybeRelation, _)) forest)) =
requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest ord range, (nodeName, maybeRelation, _, _)) forest)) =
query
where
mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation)
@@ -243,14 +243,14 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest
(joins, selects) = foldr getQueryParts ([],[]) forest
getQueryParts :: Tree ReadNode -> ([SqlFragment], [SqlFragment]) -> ([SqlFragment], [SqlFragment])
getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (j,sel:s)
getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (j,sel:s)
where
sel = "COALESCE(("
<> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
<> "FROM (" <> subquery <> ") " <> pgFmtIdent table
<> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
where subquery = requestToQuery schema False (DbRead (Node n forst))
getQueryParts (Node n@(_, (name, Just r@Relation{relType=Parent,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (joi:j,sel:s)
getQueryParts (Node n@(_, (name, Just r@Relation{relType=Parent,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (joi:j,sel:s)
where
node_name = fromMaybe name alias
local_table_name = table <> "_" <> node_name
@@ -260,7 +260,7 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest
joi = " LEFT OUTER JOIN ( " <> subquery <> " ) AS " <> pgFmtIdent local_table_name <>
" ON " <> intercalate " AND " ( map (pgFmtFilter qi . replaceTableName local_table_name) (getJoinFilters r) )
where subquery = requestToQuery schema True (DbRead (Node n forst))
getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (j,sel:s)
getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (j,sel:s)
where
sel = "COALESCE (("
<> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
@@ -410,8 +410,8 @@ pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment
pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment
pgFmtSelectItem table (f@(_, jp), Nothing, alias) = pgFmtField table f <> pgFmtAs jp alias
pgFmtSelectItem table (f@(_, jp), Just cast, alias) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs jp alias
pgFmtSelectItem table (f@(_, jp), Nothing, alias, _) = pgFmtField table f <> pgFmtAs jp alias
pgFmtSelectItem table (f@(_, jp), Just cast, alias, _) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs jp alias
pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment
pgFmtFilter table (Filter fld (Operation hasNot_ ex)) = notOp <> " " <> case ex of
+14 -2
View File
@@ -114,6 +114,12 @@ data QualifiedIdentifier = QualifiedIdentifier {
data RelationType = Child | Parent | Many | Root deriving (Show, Eq)
{-|
The name 'Relation' here is used with the meaning
"What is the relation between the current node and the parent node".
It has nothing to do with PostgreSQL referring to tables/views as relations.
-}
data Relation = Relation {
relTable :: Table
, relColumns :: [Column]
@@ -182,7 +188,13 @@ type Field = (FieldName, Maybe JsonPath)
type Alias = Text
type Cast = Text
type NodeName = Text
type SelectItem = (Field, Maybe Cast, Maybe Alias)
{-|
This type will hold information about which particular 'Relation' between two tables to choose when there are multiple ones.
Specifically, it will contain the name of the foreign key or the join table in many to many relations.
-}
type RelationDetail = Text
type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe RelationDetail)
-- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path ["clients", "projects"]
type EmbedPath = [Text]
data Filter = Filter { field::Field, operation::Operation } deriving (Show, Eq)
@@ -191,7 +203,7 @@ data ReadQuery = Select { select::[SelectItem], from::[TableName], where_::[Logi
data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON, returning::[FieldName] }
| Delete { in_::TableName, where_::[LogicTree], returning::[FieldName] }
| Update { in_::TableName, qPayload::PayloadJSON, where_::[LogicTree], returning::[FieldName] } deriving (Show, Eq)
type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail))
type ReadRequest = Tree ReadNode
type MutateRequest = MutateQuery
data DbRequest = DbRead ReadRequest | DbMutate MutateRequest
+9 -1
View File
@@ -257,10 +257,18 @@ spec = do
it "requesting children 2 levels" $
get "/clients?id=eq.1&select=id,projects{id,tasks{id}}" `shouldRespondWith`
[str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]
it "requesting children 2 levels (with relation path fixed)" $
get "/clients?id=eq.1&select=id,projects:projects.client_id{id,tasks{id}}" `shouldRespondWith`
[str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]
it "requesting many<->many relation" $
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 (with relation path fixed)" $
get "/tasks?select=id,users:users.users_tasks{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 with rename" $
get "/tasks?id=eq.1&select=id,theUsers:users{id}" `shouldRespondWith`