From 125f37ea2896aaaada7dce124dfa35ee84644fb0 Mon Sep 17 00:00:00 2001 From: Philip Lykke Carlsen Date: Fri, 28 May 2021 12:39:17 +0200 Subject: [PATCH] Server: Use a bespoke type for nullability instead of Bool GitOrigin-RevId: a793c7a921174611d44b7e7cdc1dc43b132376fe --- .../src-lib/Hasura/GraphQL/Schema/Select.hs | 2 +- server/src-lib/Hasura/RQL/DDL/Relationship.hs | 8 +++---- server/src-lib/Hasura/RQL/Types/Common.hs | 22 ------------------- .../src-lib/Hasura/RQL/Types/Relationship.hs | 21 +++++++++++++++++- 4 files changed, 25 insertions(+), 28 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Schema/Select.hs b/server/src-lib/Hasura/GraphQL/Schema/Select.hs index f363138bd1d..f2363973aaf 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Select.hs @@ -1020,7 +1020,7 @@ relationshipField sourceName relationshipInfo = runMaybeT do ObjRel -> do let desc = Just $ G.Description "An object relationship" selectionSetParser <- lift $ tableSelectionSet sourceName otherTableInfo remotePerms - pure $ pure $ (if nullable then id else P.nonNullableField) $ + pure $ pure $ case nullable of { Nullable -> id; NotNullable -> P.nonNullableField} $ P.subselection_ relFieldName desc selectionSetParser <&> \fields -> IR.AFObjectRelation $ IR.AnnRelationSelectG relName colMapping $ IR.AnnObjectSelectG fields otherTableName $ diff --git a/server/src-lib/Hasura/RQL/DDL/Relationship.hs b/server/src-lib/Hasura/RQL/DDL/Relationship.hs index 589ff3ea3c5..281e9f4f618 100644 --- a/server/src-lib/Hasura/RQL/DDL/Relationship.hs +++ b/server/src-lib/Hasura/RQL/DDL/Relationship.hs @@ -130,7 +130,7 @@ objRelP2Setup source qt foreignKeys (RelDef rn ru _) fieldInfoMap = case ru of reason dependencies = map (mkDependency qt DRLeftColumn) lCols <> map (mkDependency refqt DRRightColumn) rCols - pure (RelInfo rn ObjRel (rmColumns rm) refqt True True io, dependencies) + pure (RelInfo rn ObjRel (rmColumns rm) refqt True Nullable io, dependencies) RUFKeyOn (SameTable columns) -> do foreignTableForeignKeys <- findTable @b qt foreignKeys ForeignKey constraint foreignTable colMap <- getRequiredFkey columns (HS.toList foreignTableForeignKeys) @@ -151,7 +151,7 @@ objRelP2Setup source qt foreignKeys (RelDef rn ru _) fieldInfoMap = case ru of ] <> fmap (drUsingColumnDep @b source qt) (toList columns) colInfo <- traverse ((`HM.lookup` fieldInfoMap) . fromCol @b) columns `onNothing` throw500 "could not find column info in schema cache" - let nullable = all pgiIsNullable colInfo + let nullable = boolToNullable $ all pgiIsNullable colInfo pure (RelInfo rn ObjRel colMap foreignTable False nullable BeforeParent, dependencies) RUFKeyOn (RemoteTable remoteTable remoteCols) -> mkFkeyRel ObjRel AfterParent source rn qt remoteTable remoteCols foreignKeys @@ -181,7 +181,7 @@ arrRelP2Setup foreignKeys source qt (RelDef rn ru _) = case ru of $ TOCol @b c) DRRightColumn) rCols - pure (RelInfo rn ArrRel (rmColumns rm) refqt True True AfterParent, deps) + pure (RelInfo rn ArrRel (rmColumns rm) refqt True Nullable AfterParent, deps) RUFKeyOn (ArrRelUsingFKeyOn refqt refCols) -> mkFkeyRel ArrRel AfterParent source rn qt refqt refCols foreignKeys @@ -215,7 +215,7 @@ mkFkeyRel relType io source rn sourceTable remoteTable remoteColumns foreignKeys $ SOITable @b remoteTable) DRRemoteTable ] <> fmap (drUsingColumnDep @b source remoteTable) (toList remoteColumns) - pure (RelInfo rn relType (reverseHM colMap) remoteTable False False io, dependencies) + pure (RelInfo rn relType (reverseHM colMap) remoteTable False NotNullable io, dependencies) where reverseHM :: Eq y => Hashable y => HashMap x y -> HashMap y x reverseHM = HM.fromList . fmap swap . HM.toList diff --git a/server/src-lib/Hasura/RQL/Types/Common.hs b/server/src-lib/Hasura/RQL/Types/Common.hs index 3543f16299c..5320d16f574 100644 --- a/server/src-lib/Hasura/RQL/Types/Common.hs +++ b/server/src-lib/Hasura/RQL/Types/Common.hs @@ -79,8 +79,6 @@ import Hasura.Base.Error import Hasura.EncJSON import Hasura.Incremental (Cacheable) import Hasura.RQL.DDL.Headers () -import Hasura.RQL.Types.Backend -import Hasura.SQL.Backend (BackendType) import Hasura.SQL.Types newtype RelName @@ -153,26 +151,6 @@ instance ToJSON InsertOrder where BeforeParent -> String "before_parent" AfterParent -> String "after_parent" --- should this be parameterized by both the source and the destination backend? -data RelInfo (b :: BackendType) - = RelInfo - { riName :: !RelName - , riType :: !RelType - , riMapping :: !(HashMap (Column b) (Column b)) - , riRTable :: !(TableName b) - , riIsManual :: !Bool - , riIsNullable :: !Bool - , riInsertOrder :: !InsertOrder - } deriving (Generic) -deriving instance Backend b => Show (RelInfo b) -deriving instance Backend b => Eq (RelInfo b) -instance Backend b => NFData (RelInfo b) -instance Backend b => Cacheable (RelInfo b) -instance Backend b => Hashable (RelInfo b) -instance Backend b => FromJSON (RelInfo b) where - parseJSON = genericParseJSON hasuraJSON -instance Backend b => ToJSON (RelInfo b) where - toJSON = genericToJSON hasuraJSON -- | Postgres OIDs. newtype OID = OID { unOID :: Int } diff --git a/server/src-lib/Hasura/RQL/Types/Relationship.hs b/server/src-lib/Hasura/RQL/Types/Relationship.hs index 3d46ca81ad0..52c97eb49a1 100644 --- a/server/src-lib/Hasura/RQL/Types/Relationship.hs +++ b/server/src-lib/Hasura/RQL/Types/Relationship.hs @@ -265,7 +265,7 @@ data RelInfo (b :: BackendType) , riMapping :: !(HashMap (Column b) (Column b)) , riRTable :: !(TableName b) , riIsManual :: !Bool - , riIsNullable :: !Bool + , riIsNullable :: !Nullable , riInsertOrder :: !InsertOrder } deriving (Generic) deriving instance Backend b => Show (RelInfo b) @@ -280,5 +280,24 @@ instance (Backend b) => FromJSON (RelInfo b) where instance (Backend b) => ToJSON (RelInfo b) where toJSON = genericToJSON hasuraJSON +data Nullable = Nullable | NotNullable + deriving (Eq, Show, Generic) + +instance NFData Nullable +instance Cacheable Nullable +instance Hashable Nullable + +boolToNullable :: Bool -> Nullable +boolToNullable True = Nullable +boolToNullable False = NotNullable + +instance FromJSON Nullable where + parseJSON = fmap boolToNullable . parseJSON + +instance ToJSON Nullable where + toJSON = toJSON . \case + Nullable -> True + NotNullable -> False + fromRel :: RelName -> FieldName fromRel = FieldName . relNameToTxt