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

refactor: Combine relConstraint and relJunction in relLink

Browse Source
This commit is contained in:
Wolfgang Walther
2021-01-03 17:54:28 +01:00
committed by Wolfgang Walther
parent d173b7d8d6
commit 522308217a
4 changed files with 68 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/DbRequestBuilder.hs
+20 -26
View File
@@ -10,6 +10,7 @@ A query tree is built in case of resource embedding. By inferring the relationsh
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.DbRequestBuilder (
readRequest
@@ -135,13 +136,13 @@ findRel schema allRels origin target hint =
-- In a self reference we get two relationships with the same foreign key and relTable/relFtable but with different cardinalities(m2o/o2m)
-- We output the O2M rel, the M2O rel can be obtained by using the origin column as an embed hint.
let [rel0, rel1] = take 2 rs in
if length rs == 2 && relConstraint rel0 == relConstraint rel1 && relTable rel0 == relTable rel1 && relFTable rel0 == relFTable rel1
if length rs == 2 && relLink rel0 == relLink rel1 && relTable rel0 == relTable rel1 && relFTable rel0 == relFTable rel1
then note (NoRelBetween origin target) (find (\r -> relType r == O2M) rs)
else Left $ AmbiguousRelBetween origin target rs
where
matchFKSingleCol hint_ cols = length cols == 1 && hint_ == (colName <$> head cols)
rel = filter (
\Relation{relTable, relColumns, relConstraint, relFTable, relFColumns, relType, relJunction} ->
\Relation{..} ->
-- Both relationship ends need to be on the exposed schema
schema == tableSchema relTable && schema == tableSchema relFTable &&
(
@@ -152,7 +153,7 @@ findRel schema allRels origin target hint =
-- /projects?select=projects_client_id_fkey(*)
(
origin == tableName relTable && -- projects
Just target == relConstraint -- projects_client_id_fkey
Constraint target == relLink -- projects_client_id_fkey
) ||
-- /projects?select=client_id(*)
(
@@ -163,7 +164,10 @@ findRel schema allRels origin target hint =
isNothing hint || -- hint is optional
-- /projects?select=clients!projects_client_id_fkey(*)
hint == relConstraint || -- projects_client_id_fkey
(
relType /= M2M &&
hint == Just (constName relLink) -- projects_client_id_fkey
) ||
-- /projects?select=clients!client_id(*) or /projects?select=clients!id(*)
matchFKSingleCol hint relColumns || -- client_id
@@ -171,8 +175,8 @@ findRel schema allRels origin target hint =
-- /users?select=tasks!users_tasks(*)
(
relType == M2M && -- many-to-many between users and tasks
hint == (tableName . junTable <$> relJunction) -- users_tasks
relType == M2M && -- many-to-many between users and tasks
hint == Just (tableName $ junTable relLink) -- users_tasks
)
)
) allRels
@@ -181,15 +185,10 @@ findRel schema allRels origin target hint =
addJoinConditions :: Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest
addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_, rel, _, _, depth)) forest) =
case rel of
Just r@Relation{relType=O2M} -> Node (augmentQuery r, nodeProps) <$> updatedForest
Just r@Relation{relType=M2O} -> Node (augmentQuery r, nodeProps) <$> updatedForest
Just r@Relation{relType=M2M, relJunction=junction} ->
case junction of
Just Junction{junTable} ->
let rq = augmentQuery r in
Node (rq{implicitJoins=tableQi junTable:implicitJoins rq}, nodeProps) <$> updatedForest
Nothing ->
Left UnknownRelation
Just r@Relation{relType=M2M, relLink=Junction{junTable}} ->
let rq = augmentQuery r in
Node (rq{implicitJoins=tableQi junTable:implicitJoins rq}, nodeProps) <$> updatedForest
Just r -> Node (augmentQuery r, nodeProps) <$> updatedForest
Nothing -> Node node <$> updatedForest
where
newAlias = case isSelfReference <$> rel of
@@ -206,17 +205,12 @@ addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_
-- previousAlias and newAlias are used in the case of self joins
getJoinConditions :: Maybe Alias -> Maybe Alias -> Relation -> [JoinCondition]
getJoinConditions previousAlias newAlias (Relation Table{tableSchema=tSchema, tableName=tN} cols _ Table{tableName=ftN} fCols typ jun) =
case typ of
O2M ->
zipWith (toJoinCondition tN ftN) cols fCols
M2O ->
zipWith (toJoinCondition tN ftN) cols fCols
M2M -> case jun of
Just (Junction jt _ jc1 _ jc2) ->
let jtn = tableName jt in
zipWith (toJoinCondition tN jtn) cols jc1 ++ zipWith (toJoinCondition ftN jtn) fCols jc2
Nothing -> []
getJoinConditions previousAlias newAlias (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fCols _ lnk) =
case lnk of
Junction Table{tableName=jtn} _ jc1 _ jc2 ->
zipWith (toJoinCondition tN jtn) cols jc1 ++ zipWith (toJoinCondition ftN jtn) fCols jc2
Constraint _ ->
zipWith (toJoinCondition tN ftN) cols fCols
where
toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition
toJoinCondition tb ftb c fc =
src/PostgREST/DbStructure.hs
+19 -18
View File
@@ -357,39 +357,40 @@ addViewM2ORels allSrcCols = concatMap (\rel@Relation{..} -> rel :
srcCols `sortAccordingTo` cols = sortOn (\(k, _) -> L.lookup k $ zip cols [0::Int ..]) srcCols
viewTableM2O =
[ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
relConstraint relFTable relFColumns
M2O Nothing
[ Relation
(getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
relFTable relFColumns
relType relLink
| srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns ]
tableViewM2O =
[ Relation relTable relColumns
relConstraint
(getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
M2O Nothing
[ Relation
relTable relColumns
(getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
relType relLink
| fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
viewViewM2O =
[ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
relConstraint
(getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
M2O Nothing
[ Relation
(getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
(getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns)
relType relLink
| srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns
, fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ]
in viewTableM2O ++ tableViewM2O ++ viewViewM2O)
addO2MRels :: [Relation] -> [Relation]
addO2MRels rels = rels ++ [ Relation ft fc con t c O2M Nothing
| Relation t c con ft fc typ _ <- rels
addO2MRels rels = rels ++ [ Relation ft fc t c O2M lnk
| Relation t c ft fc typ lnk <- rels
, typ == M2O]
addM2MRels :: [Relation] -> [Relation]
addM2MRels rels = rels ++ [ Relation t c Nothing ft fc M2M (Just $ Junction jt1 con1 jc1 con2 jc2)
| Relation jt1 jc1 con1 t c _ _ <- rels
, Relation jt2 jc2 con2 ft fc _ _ <- rels
addM2MRels rels = rels ++ [ Relation t c ft fc M2M (Junction jt1 lnk1 jc1 lnk2 jc2)
| Relation jt1 jc1 t c _ lnk1 <- rels
, Relation jt2 jc2 ft fc _ lnk2 <- rels
, jt1 == jt2
, con1 /= con2]
, lnk1 /= lnk2]
addViewPrimaryKeys :: [SourceColumn] -> [PrimaryKey] -> [PrimaryKey]
addViewPrimaryKeys srcCols = concatMap (\pk ->
@@ -586,7 +587,7 @@ allM2ORels tabs cols =
relFromRow :: [Table] -> [Column] -> (Text, Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation
relFromRow allTabs allCols (rs, rt, cn, rcs, frs, frt, frcs) =
Relation <$> table <*> cols <*> pure (Just cn) <*> tableF <*> colsF <*> pure M2O <*> pure Nothing
Relation <$> table <*> cols <*> tableF <*> colsF <*> pure M2O <*> pure (Constraint cn)
where
findTable s t = find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
findCol s t c = find (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col == c) allCols
src/PostgREST/Error.hs
+11 -12
View File
@@ -4,6 +4,7 @@ Description : PostgREST error HTTP responses
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Error (
errorResponseFor
@@ -95,25 +96,23 @@ instance JSON.ToJSON ApiRequestError where
"message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas)]
compressedRel :: Relation -> JSON.Value
compressedRel rel =
compressedRel Relation{..} =
let
fmtTbl tbl = tableSchema tbl <> "." <> tableName tbl
fmtTbl Table{..} = tableSchema <> "." <> tableName
fmtEls els = "[" <> T.intercalate ", " els <> "]"
in
JSON.object $ [
"origin" .= fmtTbl (relTable rel)
, "target" .= fmtTbl (relFTable rel)
, "cardinality" .= (show $ relType rel :: Text)
"origin" .= fmtTbl relTable
, "target" .= fmtTbl relFTable
, "cardinality" .= (show relType :: Text)
] ++
case (relType rel, relJunction rel, relConstraint rel) of
(M2M, Just (Junction jt (Just const1) _ (Just const2) _), _) -> [
"relationship" .= (fmtTbl jt <> fmtEls [const1] <> fmtEls [const2])
case relLink of
Junction{..} -> [
"relationship" .= (fmtTbl junTable <> fmtEls [constName junLink1] <> fmtEls [constName junLink2])
]
(_, _, Just relCon) -> [
"relationship" .= (relCon <> fmtEls (colName <$> relColumns rel) <> fmtEls (colName <$> relFColumns rel))
Constraint{..} -> [
"relationship" .= (constName <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relFColumns))
]
(_, _, _) ->
mempty
data PgError = PgError Authenticated P.UsageError deriving Show
type Authenticated = Bool
src/PostgREST/Types.hs
+18 -16
View File
@@ -298,31 +298,33 @@ instance Show Cardinality where
show M2O = "m2o"
show M2M = "m2m"
type ConstraintName = Text
{-|
"Relation"ship between two tables.
The order of the relColumns and relFColumns should be maintained to get the join conditions right.
TODO merge relColumns and relFColumns to a tuple or Data.Bimap
-}
data Relation = Relation {
relTable :: Table
, relColumns :: [Column]
, relConstraint :: Maybe ConstraintName -- ^ Just on O2M/M2O, Nothing on M2M
, relFTable :: Table
, relFColumns :: [Column]
, relType :: Cardinality
, relJunction :: Maybe Junction -- ^ Junction for M2M Cardinality
relTable :: Table
, relColumns :: [Column]
, relFTable :: Table
, relFColumns :: [Column]
, relType :: Cardinality
, relLink :: Link -- ^ Constraint on O2M/M2O, Junction for M2M Cardinality
} deriving (Show, Eq, Generic, JSON.ToJSON)
type ConstraintName = Text
-- | Junction table on an M2M relationship
data Junction = Junction {
junTable :: Table
, junConstraint1 :: Maybe ConstraintName
, junCols1 :: [Column]
, junConstraint2 :: Maybe ConstraintName
, junCols2 :: [Column]
} deriving (Show, Eq, Generic, JSON.ToJSON)
data Link
= Constraint { constName :: ConstraintName }
| Junction {
junTable :: Table
, junLink1 :: Link
, junCols1 :: [Column]
, junLink2 :: Link
, junCols2 :: [Column]
}
deriving (Show, Eq, Generic, JSON.ToJSON)
isSelfReference :: Relation -> Bool
isSelfReference r = relTable r == relFTable r