Skip to content

Commit

Permalink
refactor: Combine relConstraint and relJunction in relLink
Browse files Browse the repository at this point in the history
  • Loading branch information
@wolfgangwalther
wolfgangwalther committed Jan 3, 2021
1 parent d173b7d commit 5223082
Show file tree
Hide file tree
Showing 4 changed files with 68 additions and 72 deletions.
46 changes: 20 additions & 26 deletions src/PostgREST/DbRequestBuilder.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 &&
(
Expand All @@ -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(*)
(
Expand All @@ -163,16 +164,19 @@ 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
matchFKSingleCol hint relFColumns || -- id

-- /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
Expand All @@ -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
Expand All @@ -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 =
Expand Down
37 changes: 19 additions & 18 deletions src/PostgREST/DbStructure.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down Expand Up @@ -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
Expand Down
23 changes: 11 additions & 12 deletions src/PostgREST/Error.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ Description : PostgREST error HTTP responses
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}

module PostgREST.Error (
errorResponseFor
Expand Down Expand Up @@ -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
Expand Down
34 changes: 18 additions & 16 deletions src/PostgREST/Types.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)

This comment has been minimized.

Sign in to view

Copy link
@steve-chavez

steve-chavez Apr 15, 2021

Member

Just noted this one while working on the request.spec filtering,

So a Junction junLink1 can be another Junction? We can have recursive junctions? That doesn't seem right. The old Maybe was not elegant in any way but it seemed more correct in terms of types.

@wolfgangwalther Would you be opposed in me refactoring this?

This comment has been minimized.

Sign in to view

Copy link
@wolfgangwalther

wolfgangwalther Apr 15, 2021

Author Member

Hm. I see your point. However, if your idea for refactoring is basically to revert back to the Maybe approach - yeah I don't like it. It would reduce code coverage by introducing impossible pattern match branches (no idea how that's called, you get the idea).

So... can we find a way to satisfy both?

I think {-# LANGUAGE DataKinds #-} could help us here. I don't claim to have understood anything about it, but reading here makes me believe we can maybe do something like this:

{-# LANGUAGE DataKinds #-}

data Link
  = Constraint { constName :: ConstraintName }
  | Junction {
    junTable :: Table
  , junLink1 :: 'Constraint
  , junCols1 :: [Column]
  , junLink2 :: 'Constraint
  , junCols2 :: [Column]
  }
  deriving (Show, Eq, Generic, JSON.ToJSON)

But to be honest this is more of a random guess right now :D.

This comment has been minimized.

Sign in to view

Copy link
@wolfgangwalther

wolfgangwalther Apr 15, 2021

Author Member

Oh, and I think there would be another possibility. Something like this:

data Relation = Relation {
  relTable    :: Table
, relColumns  :: [Column]
, relFTable   :: Table
, relFColumns :: [Column]
, relType     :: Cardinality
, relLink     :: Either Constraint Junction -- ^ Constraint on O2M/M2O, Junction for M2M Cardinality
}

data Constraint = Constraint { constName :: ConstraintName }

data Junction = Junction {
    junTable :: Table
  , junLink1 :: Constraint
  , junCols1 :: [Column]
  , junLink2 :: Constraint
  , junCols2 :: [Column]
  }

But I'm not sure what kind of pattern matching requirements this will introduce.

This comment has been minimized.

Sign in to view

Copy link
@steve-chavez

steve-chavez Apr 15, 2021

Member

Cool. Actually I was just thinking of reverting(:D) but didn't know the coverage implication. I'll check the DataKinds approach.

This comment has been minimized.

Sign in to view

Copy link
@wolfgangwalther

wolfgangwalther Apr 15, 2021

Author Member

The old Maybe was not elegant in any way but it seemed more correct in terms of types.

One last note on this: The Maybe approach before would have allowed a relation to be Constraint and Junction at the same time. So type-wise it was not fully correct either. :/

This comment has been minimized.

Sign in to view

Copy link
@wolfgangwalther

wolfgangwalther Apr 15, 2021

Author Member

And another very last note :D

I'm not sure why junLink1 and junLink2 are not just of type ConstraintName. I think I remember I might have tried that, and it made the code more complicated. But I also might mis-remember.

This comment has been minimized.

Sign in to view

Copy link
@wolfgangwalther

wolfgangwalther Apr 15, 2021

Author Member

I'm not sure why junLink1 and junLink2 are not just of type ConstraintName. I think I remember I might have tried that, and it made the code more complicated. But I also might mis-remember.

Looking at the code this seems quite possible to do. And easily, too. You probably meant to do that from the start...

:D

isSelfReference :: Relation -> Bool
isSelfReference r = relTable r == relFTable r
Expand Down

0 comments on commit 5223082

Please sign in to comment.