module Hasura.RQL.DDL.Relationship
  ( CreateArrRel (..),
    CreateObjRel (..),
    execCreateRelationship,
    runCreateRelationship,
    defaultBuildObjectRelationshipInfo,
    defaultBuildArrayRelationshipInfo,
    DropRel,
    execDropRel,
    runDropRel,
    dropRelationshipInMetadata,
    SetRelComment,
    runSetRelComment,
    nativeQueryRelationshipSetup,
  )
where

import Control.Lens ((.~))
import Data.Aeson.Types
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.HashMap.Strict.NonEmpty qualified as NEHashMap
import Data.HashSet qualified as Set
import Data.Sequence qualified as Seq
import Data.Text.Extended
import Data.Tuple (swap)
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.NativeQuery.Types (NativeQueryName)
import Hasura.Prelude
import Hasura.RQL.DDL.Permission
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Table.Cache
import Hasura.Table.Metadata
  ( TableMetadata,
    tmArrayRelationships,
    tmObjectRelationships,
  )

--------------------------------------------------------------------------------
-- Create local relationship

newtype CreateArrRel b = CreateArrRel {forall (b :: BackendType).
CreateArrRel b -> WithTable b (ArrRelDef b)
unCreateArrRel :: WithTable b (ArrRelDef b)}
  deriving newtype (Value -> Parser [CreateArrRel b]
Value -> Parser (CreateArrRel b)
(Value -> Parser (CreateArrRel b))
-> (Value -> Parser [CreateArrRel b]) -> FromJSON (CreateArrRel b)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall (b :: BackendType).
Backend b =>
Value -> Parser [CreateArrRel b]
forall (b :: BackendType).
Backend b =>
Value -> Parser (CreateArrRel b)
$cparseJSON :: forall (b :: BackendType).
Backend b =>
Value -> Parser (CreateArrRel b)
parseJSON :: Value -> Parser (CreateArrRel b)
$cparseJSONList :: forall (b :: BackendType).
Backend b =>
Value -> Parser [CreateArrRel b]
parseJSONList :: Value -> Parser [CreateArrRel b]
FromJSON)

newtype CreateObjRel b = CreateObjRel {forall (b :: BackendType).
CreateObjRel b -> WithTable b (ObjRelDef b)
unCreateObjRel :: WithTable b (ObjRelDef b)}
  deriving newtype (Value -> Parser [CreateObjRel b]
Value -> Parser (CreateObjRel b)
(Value -> Parser (CreateObjRel b))
-> (Value -> Parser [CreateObjRel b]) -> FromJSON (CreateObjRel b)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall (b :: BackendType).
Backend b =>
Value -> Parser [CreateObjRel b]
forall (b :: BackendType).
Backend b =>
Value -> Parser (CreateObjRel b)
$cparseJSON :: forall (b :: BackendType).
Backend b =>
Value -> Parser (CreateObjRel b)
parseJSON :: Value -> Parser (CreateObjRel b)
$cparseJSONList :: forall (b :: BackendType).
Backend b =>
Value -> Parser [CreateObjRel b]
parseJSONList :: Value -> Parser [CreateObjRel b]
FromJSON)

execCreateRelationship ::
  forall b m a.
  ( BackendMetadata b,
    CacheRM m,
    MonadError QErr m,
    ToJSON a
  ) =>
  RelType ->
  WithTable b (RelDef a) ->
  Metadata ->
  m (MetadataObjId, MetadataModifier)
execCreateRelationship :: forall (b :: BackendType) (m :: * -> *) a.
(BackendMetadata b, CacheRM m, MonadError QErr m, ToJSON a) =>
RelType
-> WithTable b (RelDef a)
-> Metadata
-> m (MetadataObjId, MetadataModifier)
execCreateRelationship RelType
relType (WithTable SourceName
source TableName b
tableName RelDef a
relDef) Metadata
_ = do
  let relName :: RelName
relName = RelDef a -> RelName
forall a. RelDef a -> RelName
_rdName RelDef a
relDef
  -- Check if any field with relationship name already exists in the table
  FieldInfoMap (FieldInfo b)
tableFields <- TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
 -> FieldInfoMap (FieldInfo b))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> m (FieldInfoMap (FieldInfo b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableCoreInfo b)
askTableCoreInfo @b SourceName
source TableName b
tableName
  Maybe (FieldInfo b) -> (FieldInfo b -> m Any) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (FieldName -> FieldInfoMap (FieldInfo b) -> Maybe (FieldInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (RelName -> FieldName
fromRel RelName
relName) FieldInfoMap (FieldInfo b)
tableFields)
    ((FieldInfo b -> m Any) -> m ()) -> (FieldInfo b -> m Any) -> m ()
forall a b. (a -> b) -> a -> b
$ m Any -> FieldInfo b -> m Any
forall a b. a -> b -> a
const
    (m Any -> FieldInfo b -> m Any) -> m Any -> FieldInfo b -> m Any
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m Any
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyExists
    (Text -> m Any) -> Text -> m Any
forall a b. (a -> b) -> a -> b
$ Text
"field with name "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName
relName
    RelName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" already exists in table "
    Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName

  HashMap (TableName b) (TableInfo b)
tableCache <-
    m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
      m SchemaCache
-> (SchemaCache -> m (HashMap (TableName b) (TableInfo b)))
-> m (HashMap (TableName b) (TableInfo b))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe (HashMap (TableName b) (TableInfo b))
 -> m (HashMap (TableName b) (TableInfo b))
 -> m (HashMap (TableName b) (TableInfo b)))
-> m (HashMap (TableName b) (TableInfo b))
-> Maybe (HashMap (TableName b) (TableInfo b))
-> m (HashMap (TableName b) (TableInfo b))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe (HashMap (TableName b) (TableInfo b))
-> m (HashMap (TableName b) (TableInfo b))
-> m (HashMap (TableName b) (TableInfo b))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (Code -> Text -> m (HashMap (TableName b) (TableInfo b))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound Text
"Could not find source.")
      (Maybe (HashMap (TableName b) (TableInfo b))
 -> m (HashMap (TableName b) (TableInfo b)))
-> (SchemaCache -> Maybe (HashMap (TableName b) (TableInfo b)))
-> SchemaCache
-> m (HashMap (TableName b) (TableInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName
-> SourceCache -> Maybe (HashMap (TableName b) (TableInfo b))
forall (b :: BackendType).
Backend b =>
SourceName -> SourceCache -> Maybe (TableCache b)
unsafeTableCache SourceName
source
      (SourceCache -> Maybe (HashMap (TableName b) (TableInfo b)))
-> (SchemaCache -> SourceCache)
-> SchemaCache
-> Maybe (HashMap (TableName b) (TableInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaCache -> SourceCache
scSources

  let comment :: Maybe Text
comment = RelDef a -> Maybe Text
forall a. RelDef a -> Maybe Text
_rdComment RelDef a
relDef
      metadataObj :: MetadataObjId
metadataObj =
        SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source
          (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
          (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
tableName
          (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$ RelName -> RelType -> TableMetadataObjId
MTORel RelName
relName RelType
relType
  TableMetadata b -> TableMetadata b
addRelationshipToMetadata <- case RelType
relType of
    RelType
ObjRel -> do
      ObjRelDef b
value <- Value -> m (ObjRelDef b)
forall a (m :: * -> *). (FromJSON a, QErrM m) => Value -> m a
decodeValue (Value -> m (ObjRelDef b)) -> Value -> m (ObjRelDef b)
forall a b. (a -> b) -> a -> b
$ RelDef a -> Value
forall a. ToJSON a => a -> Value
toJSON RelDef a
relDef
      forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m) =>
TableCache b
-> TableName b -> Either (ObjRelDef b) (ArrRelDef b) -> m ()
validateRelationship @b
        HashMap (TableName b) (TableInfo b)
tableCache
        TableName b
tableName
        (ObjRelDef b -> Either (ObjRelDef b) (ArrRelDef b)
forall a b. a -> Either a b
Left ObjRelDef b
value)
      (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TableMetadata b -> TableMetadata b)
 -> m (TableMetadata b -> TableMetadata b))
-> (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$ (Relationships (ObjRelDef b)
 -> Identity (Relationships (ObjRelDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Relationships (ObjRelDef b) -> f (Relationships (ObjRelDef b)))
-> TableMetadata b -> f (TableMetadata b)
tmObjectRelationships ((Relationships (ObjRelDef b)
  -> Identity (Relationships (ObjRelDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Relationships (ObjRelDef b) -> Relationships (ObjRelDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName
-> ObjRelDef b
-> Relationships (ObjRelDef b)
-> Relationships (ObjRelDef b)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert RelName
relName (RelName
-> RelUsing b (ObjRelUsingChoice b) -> Maybe Text -> ObjRelDef b
forall a. RelName -> a -> Maybe Text -> RelDef a
RelDef RelName
relName (ObjRelDef b -> RelUsing b (ObjRelUsingChoice b)
forall a. RelDef a -> a
_rdUsing ObjRelDef b
value) Maybe Text
comment)
    RelType
ArrRel -> do
      ArrRelDef b
value <- Value -> m (ArrRelDef b)
forall a (m :: * -> *). (FromJSON a, QErrM m) => Value -> m a
decodeValue (Value -> m (ArrRelDef b)) -> Value -> m (ArrRelDef b)
forall a b. (a -> b) -> a -> b
$ RelDef a -> Value
forall a. ToJSON a => a -> Value
toJSON RelDef a
relDef
      forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m) =>
TableCache b
-> TableName b -> Either (ObjRelDef b) (ArrRelDef b) -> m ()
validateRelationship @b
        HashMap (TableName b) (TableInfo b)
tableCache
        TableName b
tableName
        (ArrRelDef b -> Either (ObjRelDef b) (ArrRelDef b)
forall a b. b -> Either a b
Right ArrRelDef b
value)
      (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TableMetadata b -> TableMetadata b)
 -> m (TableMetadata b -> TableMetadata b))
-> (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$ (Relationships (ArrRelDef b)
 -> Identity (Relationships (ArrRelDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Relationships (ArrRelDef b) -> f (Relationships (ArrRelDef b)))
-> TableMetadata b -> f (TableMetadata b)
tmArrayRelationships ((Relationships (ArrRelDef b)
  -> Identity (Relationships (ArrRelDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Relationships (ArrRelDef b) -> Relationships (ArrRelDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName
-> ArrRelDef b
-> Relationships (ArrRelDef b)
-> Relationships (ArrRelDef b)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert RelName
relName (RelName
-> RelUsing b (ArrRelUsingFKeyOn b) -> Maybe Text -> ArrRelDef b
forall a. RelName -> a -> Maybe Text -> RelDef a
RelDef RelName
relName (ArrRelDef b -> RelUsing b (ArrRelUsingFKeyOn b)
forall a. RelDef a -> a
_rdUsing ArrRelDef b
value) Maybe Text
comment)

  let metadataModifier :: MetadataModifier
metadataModifier = (Metadata -> Metadata) -> MetadataModifier
MetadataModifier do
        forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
tableName
          ASetter' Metadata (TableMetadata b)
-> (TableMetadata b -> TableMetadata b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TableMetadata b -> TableMetadata b
addRelationshipToMetadata

  (MetadataObjId, MetadataModifier)
-> m (MetadataObjId, MetadataModifier)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataObjId
metadataObj, MetadataModifier
metadataModifier)

runCreateRelationship ::
  forall m b a.
  (MonadError QErr m, CacheRWM m, ToJSON a, MetadataM m, BackendMetadata b) =>
  RelType ->
  WithTable b (RelDef a) ->
  m EncJSON
runCreateRelationship :: forall (m :: * -> *) (b :: BackendType) a.
(MonadError QErr m, CacheRWM m, ToJSON a, MetadataM m,
 BackendMetadata b) =>
RelType -> WithTable b (RelDef a) -> m EncJSON
runCreateRelationship RelType
relType WithTable b (RelDef a)
withTable = do
  (MetadataObjId
metadataObj, MetadataModifier
metadataModifier) <-
    m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata m Metadata
-> (Metadata -> m (MetadataObjId, MetadataModifier))
-> m (MetadataObjId, MetadataModifier)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RelType
-> WithTable b (RelDef a)
-> Metadata
-> m (MetadataObjId, MetadataModifier)
forall (b :: BackendType) (m :: * -> *) a.
(BackendMetadata b, CacheRM m, MonadError QErr m, ToJSON a) =>
RelType
-> WithTable b (RelDef a)
-> Metadata
-> m (MetadataObjId, MetadataModifier)
execCreateRelationship RelType
relType WithTable b (RelDef a)
withTable

  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
metadataObj MetadataModifier
metadataModifier
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

defaultBuildObjectRelationshipInfo ::
  forall b m.
  (QErrM m, Backend b) =>
  SourceName ->
  HashMap (TableName b) (HashSet (ForeignKey b)) ->
  TableName b ->
  ObjRelDef b ->
  m (RelInfo b, Seq SchemaDependency)
defaultBuildObjectRelationshipInfo :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
SourceName
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> TableName b
-> ObjRelDef b
-> m (RelInfo b, Seq SchemaDependency)
defaultBuildObjectRelationshipInfo SourceName
source HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys TableName b
qt (RelDef RelName
rn ObjRelUsing b
ru Maybe Text
_) = case ObjRelUsing b
ru of
  RUManual (RelManualTableConfig {rmtTable :: forall (b :: BackendType). RelManualTableConfig b -> TableName b
rmtTable = TableName b
refqt, rmtCommon :: forall (b :: BackendType).
RelManualTableConfig b -> RelManualCommon b
rmtCommon = RelManualCommon b
common}) -> do
    let ([Column b]
lCols, [Column b]
rCols) = [(Column b, Column b)] -> ([Column b], [Column b])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Column b, Column b)] -> ([Column b], [Column b]))
-> [(Column b, Column b)] -> ([Column b], [Column b])
forall a b. (a -> b) -> a -> b
$ HashMap (Column b) (Column b) -> [(Column b, Column b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (HashMap (Column b) (Column b) -> [(Column b, Column b)])
-> HashMap (Column b) (Column b) -> [(Column b, Column b)]
forall a b. (a -> b) -> a -> b
$ RelManualCommon b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelManualCommon b -> HashMap (Column b) (Column b)
rmColumns RelManualCommon b
common
        io :: InsertOrder
io = InsertOrder -> Maybe InsertOrder -> InsertOrder
forall a. a -> Maybe a -> a
fromMaybe InsertOrder
BeforeParent (Maybe InsertOrder -> InsertOrder)
-> Maybe InsertOrder -> InsertOrder
forall a b. (a -> b) -> a -> b
$ RelManualCommon b -> Maybe InsertOrder
forall (b :: BackendType). RelManualCommon b -> Maybe InsertOrder
rmInsertOrder RelManualCommon b
common
        mkDependency :: TableName b -> DependencyReason -> Column b -> SchemaDependency
mkDependency TableName b
tableName DependencyReason
reason Column b
col =
          SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
            ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
                (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
tableName
                (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). Column b -> TableObjId b
TOCol @b Column b
col
            )
            DependencyReason
reason
        dependencies :: Seq SchemaDependency
dependencies =
          (TableName b -> DependencyReason -> Column b -> SchemaDependency
mkDependency TableName b
qt DependencyReason
DRLeftColumn (Column b -> SchemaDependency)
-> Seq (Column b) -> Seq SchemaDependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Column b] -> Seq (Column b)
forall a. [a] -> Seq a
Seq.fromList [Column b]
lCols)
            Seq SchemaDependency
-> Seq SchemaDependency -> Seq SchemaDependency
forall a. Semigroup a => a -> a -> a
<> (TableName b -> DependencyReason -> Column b -> SchemaDependency
mkDependency TableName b
refqt DependencyReason
DRRightColumn (Column b -> SchemaDependency)
-> Seq (Column b) -> Seq SchemaDependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Column b] -> Seq (Column b)
forall a. [a] -> Seq a
Seq.fromList [Column b]
rCols)
    (RelInfo b, Seq SchemaDependency)
-> m (RelInfo b, Seq SchemaDependency)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelName
-> RelType
-> HashMap (Column b) (Column b)
-> RelTarget b
-> Bool
-> InsertOrder
-> RelInfo b
forall (b :: BackendType).
RelName
-> RelType
-> HashMap (Column b) (Column b)
-> RelTarget b
-> Bool
-> InsertOrder
-> RelInfo b
RelInfo RelName
rn RelType
ObjRel (RelManualCommon b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelManualCommon b -> HashMap (Column b) (Column b)
rmColumns RelManualCommon b
common) (TableName b -> RelTarget b
forall (b :: BackendType). TableName b -> RelTarget b
RelTargetTable TableName b
refqt) Bool
True InsertOrder
io, Seq SchemaDependency
dependencies)
  RUFKeyOn (SameTable NonEmpty (Column b)
columns) -> do
    HashSet (ForeignKey b)
foreignTableForeignKeys <-
      TableName b
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> Maybe (HashSet (ForeignKey b))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TableName b
qt HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys
        Maybe (HashSet (ForeignKey b))
-> m (HashSet (ForeignKey b)) -> m (HashSet (ForeignKey b))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m (HashSet (ForeignKey b))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text
"table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
qt TableName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist in source: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
sourceNameToText SourceName
source)
    ForeignKey Constraint b
constraint TableName b
foreignTable NEHashMap (Column b) (Column b)
colMap <- NonEmpty (Column b) -> [ForeignKey b] -> m (ForeignKey b)
forall (m :: * -> *) (b :: BackendType).
(QErrM m, Backend b) =>
NonEmpty (Column b) -> [ForeignKey b] -> m (ForeignKey b)
getRequiredFkey NonEmpty (Column b)
columns (HashSet (ForeignKey b) -> [ForeignKey b]
forall a. HashSet a -> [a]
Set.toList HashSet (ForeignKey b)
foreignTableForeignKeys)
    let dependencies :: Seq SchemaDependency
dependencies =
          [SchemaDependency] -> Seq SchemaDependency
forall a. [a] -> Seq a
Seq.fromList
            [ SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
                ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
                    (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                    (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
qt
                    (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). ConstraintName b -> TableObjId b
TOForeignKey @b (Constraint b -> ConstraintName b
forall (b :: BackendType). Constraint b -> ConstraintName b
_cName Constraint b
constraint)
                )
                DependencyReason
DRFkey,
              -- this needs to be added explicitly to handle the remote table being untracked. In this case,
              -- neither the using_col nor the constraint name will help.
              SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
                ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
                    (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                    (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). TableName b -> SourceObjId b
SOITable @b TableName b
foreignTable
                )
                DependencyReason
DRRemoteTable
            ]
            Seq SchemaDependency
-> Seq SchemaDependency -> Seq SchemaDependency
forall a. Semigroup a => a -> a -> a
<> (forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> Column b -> SchemaDependency
drUsingColumnDep @b SourceName
source TableName b
qt (Column b -> SchemaDependency)
-> Seq (Column b) -> Seq SchemaDependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Column b] -> Seq (Column b)
forall a. [a] -> Seq a
Seq.fromList (NonEmpty (Column b) -> [Column b]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Column b)
columns))
    (RelInfo b, Seq SchemaDependency)
-> m (RelInfo b, Seq SchemaDependency)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelName
-> RelType
-> HashMap (Column b) (Column b)
-> RelTarget b
-> Bool
-> InsertOrder
-> RelInfo b
forall (b :: BackendType).
RelName
-> RelType
-> HashMap (Column b) (Column b)
-> RelTarget b
-> Bool
-> InsertOrder
-> RelInfo b
RelInfo RelName
rn RelType
ObjRel (NEHashMap (Column b) (Column b) -> HashMap (Column b) (Column b)
forall k v. NEHashMap k v -> HashMap k v
NEHashMap.toHashMap NEHashMap (Column b) (Column b)
colMap) (TableName b -> RelTarget b
forall (b :: BackendType). TableName b -> RelTarget b
RelTargetTable TableName b
foreignTable) Bool
False InsertOrder
BeforeParent, Seq SchemaDependency
dependencies)
  RUFKeyOn (RemoteTable TableName b
remoteTable NonEmpty (Column b)
remoteCols) ->
    RelType
-> InsertOrder
-> SourceName
-> RelName
-> TableName b
-> TableName b
-> NonEmpty (Column b)
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> m (RelInfo b, Seq SchemaDependency)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
RelType
-> InsertOrder
-> SourceName
-> RelName
-> TableName b
-> TableName b
-> NonEmpty (Column b)
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> m (RelInfo b, Seq SchemaDependency)
mkFkeyRel RelType
ObjRel InsertOrder
AfterParent SourceName
source RelName
rn TableName b
qt TableName b
remoteTable NonEmpty (Column b)
remoteCols HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys

-- | set up a relationship from a Native Query onto another data source
nativeQueryRelationshipSetup ::
  forall b m.
  (QErrM m, Backend b) =>
  SourceName ->
  NativeQueryName ->
  RelType ->
  RelDef (RelManualNativeQueryConfig b) ->
  m (RelInfo b, Seq SchemaDependency)
nativeQueryRelationshipSetup :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
SourceName
-> NativeQueryName
-> RelType
-> RelDef (RelManualNativeQueryConfig b)
-> m (RelInfo b, Seq SchemaDependency)
nativeQueryRelationshipSetup SourceName
sourceName NativeQueryName
nativeQueryName RelType
relType (RelDef RelName
relName (RelManualNativeQueryConfig {rmnNativeQueryName :: forall (b :: BackendType).
RelManualNativeQueryConfig b -> NativeQueryName
rmnNativeQueryName = NativeQueryName
refqt, rmnCommon :: forall (b :: BackendType).
RelManualNativeQueryConfig b -> RelManualCommon b
rmnCommon = RelManualCommon b
common}) Maybe Text
_) = do
  let ([Column b]
lCols, [Column b]
rCols) = [(Column b, Column b)] -> ([Column b], [Column b])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Column b, Column b)] -> ([Column b], [Column b]))
-> [(Column b, Column b)] -> ([Column b], [Column b])
forall a b. (a -> b) -> a -> b
$ HashMap (Column b) (Column b) -> [(Column b, Column b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (HashMap (Column b) (Column b) -> [(Column b, Column b)])
-> HashMap (Column b) (Column b) -> [(Column b, Column b)]
forall a b. (a -> b) -> a -> b
$ RelManualCommon b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelManualCommon b -> HashMap (Column b) (Column b)
rmColumns RelManualCommon b
common
      io :: InsertOrder
io = case RelType
relType of
        RelType
ObjRel -> InsertOrder -> Maybe InsertOrder -> InsertOrder
forall a. a -> Maybe a -> a
fromMaybe InsertOrder
BeforeParent (Maybe InsertOrder -> InsertOrder)
-> Maybe InsertOrder -> InsertOrder
forall a b. (a -> b) -> a -> b
$ RelManualCommon b -> Maybe InsertOrder
forall (b :: BackendType). RelManualCommon b -> Maybe InsertOrder
rmInsertOrder RelManualCommon b
common
        RelType
ArrRel -> InsertOrder
AfterParent
      deps :: Seq SchemaDependency
deps =
        ( (Column b -> SchemaDependency)
-> Seq (Column b) -> Seq SchemaDependency
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \Column b
c ->
                SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
                  ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
sourceName
                      (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                      (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
NativeQueryName -> NativeQueryObjId b -> SourceObjId b
SOINativeQueryObj @b NativeQueryName
nativeQueryName
                      (NativeQueryObjId b -> SourceObjId b)
-> NativeQueryObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). Column b -> NativeQueryObjId b
NQOCol @b Column b
c
                  )
                  DependencyReason
DRLeftColumn
            )
            ([Column b] -> Seq (Column b)
forall a. [a] -> Seq a
Seq.fromList [Column b]
lCols)
        )
          Seq SchemaDependency
-> Seq SchemaDependency -> Seq SchemaDependency
forall a. Semigroup a => a -> a -> a
<> (Column b -> SchemaDependency)
-> Seq (Column b) -> Seq SchemaDependency
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \Column b
c ->
                SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
                  ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
sourceName
                      (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                      (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
NativeQueryName -> NativeQueryObjId b -> SourceObjId b
SOINativeQueryObj @b NativeQueryName
refqt
                      (NativeQueryObjId b -> SourceObjId b)
-> NativeQueryObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). Column b -> NativeQueryObjId b
NQOCol @b Column b
c
                  )
                  DependencyReason
DRRightColumn
            )
            ([Column b] -> Seq (Column b)
forall a. [a] -> Seq a
Seq.fromList [Column b]
rCols)
  (RelInfo b, Seq SchemaDependency)
-> m (RelInfo b, Seq SchemaDependency)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelName
-> RelType
-> HashMap (Column b) (Column b)
-> RelTarget b
-> Bool
-> InsertOrder
-> RelInfo b
forall (b :: BackendType).
RelName
-> RelType
-> HashMap (Column b) (Column b)
-> RelTarget b
-> Bool
-> InsertOrder
-> RelInfo b
RelInfo RelName
relName RelType
relType (RelManualCommon b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelManualCommon b -> HashMap (Column b) (Column b)
rmColumns RelManualCommon b
common) (NativeQueryName -> RelTarget b
forall (b :: BackendType). NativeQueryName -> RelTarget b
RelTargetNativeQuery NativeQueryName
refqt) Bool
True InsertOrder
io, Seq SchemaDependency
deps)

defaultBuildArrayRelationshipInfo ::
  forall b m.
  (QErrM m, Backend b) =>
  SourceName ->
  HashMap (TableName b) (HashSet (ForeignKey b)) ->
  TableName b ->
  ArrRelDef b ->
  m (RelInfo b, Seq SchemaDependency)
defaultBuildArrayRelationshipInfo :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
SourceName
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> TableName b
-> ArrRelDef b
-> m (RelInfo b, Seq SchemaDependency)
defaultBuildArrayRelationshipInfo SourceName
source HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys TableName b
qt (RelDef RelName
rn ArrRelUsing b
ru Maybe Text
_) = case ArrRelUsing b
ru of
  RUManual (RelManualTableConfig {rmtTable :: forall (b :: BackendType). RelManualTableConfig b -> TableName b
rmtTable = TableName b
refqt, rmtCommon :: forall (b :: BackendType).
RelManualTableConfig b -> RelManualCommon b
rmtCommon = RelManualCommon b
common}) -> do
    let ([Column b]
lCols, [Column b]
rCols) = [(Column b, Column b)] -> ([Column b], [Column b])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Column b, Column b)] -> ([Column b], [Column b]))
-> [(Column b, Column b)] -> ([Column b], [Column b])
forall a b. (a -> b) -> a -> b
$ HashMap (Column b) (Column b) -> [(Column b, Column b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (HashMap (Column b) (Column b) -> [(Column b, Column b)])
-> HashMap (Column b) (Column b) -> [(Column b, Column b)]
forall a b. (a -> b) -> a -> b
$ RelManualCommon b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelManualCommon b -> HashMap (Column b) (Column b)
rmColumns RelManualCommon b
common
        deps :: Seq SchemaDependency
deps =
          ( (Column b -> SchemaDependency)
-> Seq (Column b) -> Seq SchemaDependency
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              ( \Column b
c ->
                  SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
                    ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
                        (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                        (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
qt
                        (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). Column b -> TableObjId b
TOCol @b Column b
c
                    )
                    DependencyReason
DRLeftColumn
              )
              ([Column b] -> Seq (Column b)
forall a. [a] -> Seq a
Seq.fromList [Column b]
lCols)
          )
            Seq SchemaDependency
-> Seq SchemaDependency -> Seq SchemaDependency
forall a. Semigroup a => a -> a -> a
<> (Column b -> SchemaDependency)
-> Seq (Column b) -> Seq SchemaDependency
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              ( \Column b
c ->
                  SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
                    ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
                        (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                        (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
refqt
                        (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). Column b -> TableObjId b
TOCol @b Column b
c
                    )
                    DependencyReason
DRRightColumn
              )
              ([Column b] -> Seq (Column b)
forall a. [a] -> Seq a
Seq.fromList [Column b]
rCols)
    (RelInfo b, Seq SchemaDependency)
-> m (RelInfo b, Seq SchemaDependency)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelName
-> RelType
-> HashMap (Column b) (Column b)
-> RelTarget b
-> Bool
-> InsertOrder
-> RelInfo b
forall (b :: BackendType).
RelName
-> RelType
-> HashMap (Column b) (Column b)
-> RelTarget b
-> Bool
-> InsertOrder
-> RelInfo b
RelInfo RelName
rn RelType
ArrRel (RelManualCommon b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelManualCommon b -> HashMap (Column b) (Column b)
rmColumns RelManualCommon b
common) (TableName b -> RelTarget b
forall (b :: BackendType). TableName b -> RelTarget b
RelTargetTable TableName b
refqt) Bool
True InsertOrder
AfterParent, Seq SchemaDependency
deps)
  RUFKeyOn (ArrRelUsingFKeyOn TableName b
refqt NonEmpty (Column b)
refCols) ->
    RelType
-> InsertOrder
-> SourceName
-> RelName
-> TableName b
-> TableName b
-> NonEmpty (Column b)
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> m (RelInfo b, Seq SchemaDependency)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
RelType
-> InsertOrder
-> SourceName
-> RelName
-> TableName b
-> TableName b
-> NonEmpty (Column b)
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> m (RelInfo b, Seq SchemaDependency)
mkFkeyRel RelType
ArrRel InsertOrder
AfterParent SourceName
source RelName
rn TableName b
qt TableName b
refqt NonEmpty (Column b)
refCols HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys

mkFkeyRel ::
  forall b m.
  (QErrM m) =>
  (Backend b) =>
  RelType ->
  InsertOrder ->
  SourceName ->
  RelName ->
  TableName b ->
  TableName b ->
  NonEmpty (Column b) ->
  HashMap (TableName b) (HashSet (ForeignKey b)) ->
  m (RelInfo b, Seq SchemaDependency)
mkFkeyRel :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
RelType
-> InsertOrder
-> SourceName
-> RelName
-> TableName b
-> TableName b
-> NonEmpty (Column b)
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> m (RelInfo b, Seq SchemaDependency)
mkFkeyRel RelType
relType InsertOrder
io SourceName
source RelName
rn TableName b
sourceTable TableName b
remoteTable NonEmpty (Column b)
remoteColumns HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys = do
  HashSet (ForeignKey b)
foreignTableForeignKeys <-
    TableName b
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> Maybe (HashSet (ForeignKey b))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TableName b
remoteTable HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys
      Maybe (HashSet (ForeignKey b))
-> m (HashSet (ForeignKey b)) -> m (HashSet (ForeignKey b))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m (HashSet (ForeignKey b))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text
"table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
remoteTable TableName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist in source: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
sourceNameToText SourceName
source)
  let keysThatReferenceUs :: [ForeignKey b]
keysThatReferenceUs = (ForeignKey b -> Bool) -> [ForeignKey b] -> [ForeignKey b]
forall a. (a -> Bool) -> [a] -> [a]
filter ((TableName b -> TableName b -> Bool
forall a. Eq a => a -> a -> Bool
== TableName b
sourceTable) (TableName b -> Bool)
-> (ForeignKey b -> TableName b) -> ForeignKey b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignKey b -> TableName b
forall (b :: BackendType). ForeignKey b -> TableName b
_fkForeignTable) (HashSet (ForeignKey b) -> [ForeignKey b]
forall a. HashSet a -> [a]
Set.toList HashSet (ForeignKey b)
foreignTableForeignKeys)
  ForeignKey Constraint b
constraint TableName b
_foreignTable NEHashMap (Column b) (Column b)
colMap <- NonEmpty (Column b) -> [ForeignKey b] -> m (ForeignKey b)
forall (m :: * -> *) (b :: BackendType).
(QErrM m, Backend b) =>
NonEmpty (Column b) -> [ForeignKey b] -> m (ForeignKey b)
getRequiredFkey NonEmpty (Column b)
remoteColumns [ForeignKey b]
keysThatReferenceUs
  let dependencies :: Seq SchemaDependency
dependencies =
        [SchemaDependency] -> Seq SchemaDependency
forall a. [a] -> Seq a
Seq.fromList
          [ SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
              ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
                  (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                  (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
remoteTable
                  (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). ConstraintName b -> TableObjId b
TOForeignKey @b (Constraint b -> ConstraintName b
forall (b :: BackendType). Constraint b -> ConstraintName b
_cName Constraint b
constraint)
              )
              DependencyReason
DRRemoteFkey,
            SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
              ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
                  (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                  (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). TableName b -> SourceObjId b
SOITable @b TableName b
remoteTable
              )
              DependencyReason
DRRemoteTable
          ]
          Seq SchemaDependency
-> Seq SchemaDependency -> Seq SchemaDependency
forall a. Semigroup a => a -> a -> a
<> ( forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> Column b -> SchemaDependency
drUsingColumnDep @b SourceName
source TableName b
remoteTable
                 (Column b -> SchemaDependency)
-> Seq (Column b) -> Seq SchemaDependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Column b] -> Seq (Column b)
forall a. [a] -> Seq a
Seq.fromList (NonEmpty (Column b) -> [Column b]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Column b)
remoteColumns)
             )
  (RelInfo b, Seq SchemaDependency)
-> m (RelInfo b, Seq SchemaDependency)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelName
-> RelType
-> HashMap (Column b) (Column b)
-> RelTarget b
-> Bool
-> InsertOrder
-> RelInfo b
forall (b :: BackendType).
RelName
-> RelType
-> HashMap (Column b) (Column b)
-> RelTarget b
-> Bool
-> InsertOrder
-> RelInfo b
RelInfo RelName
rn RelType
relType (HashMap (Column b) (Column b) -> HashMap (Column b) (Column b)
forall y x. Hashable y => HashMap x y -> HashMap y x
reverseMap (NEHashMap (Column b) (Column b) -> HashMap (Column b) (Column b)
forall k v. NEHashMap k v -> HashMap k v
NEHashMap.toHashMap NEHashMap (Column b) (Column b)
colMap)) (TableName b -> RelTarget b
forall (b :: BackendType). TableName b -> RelTarget b
RelTargetTable TableName b
remoteTable) Bool
False InsertOrder
io, Seq SchemaDependency
dependencies)
  where
    reverseMap :: (Hashable y) => HashMap x y -> HashMap y x
    reverseMap :: forall y x. Hashable y => HashMap x y -> HashMap y x
reverseMap = [(y, x)] -> HashMap y x
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(y, x)] -> HashMap y x)
-> (HashMap x y -> [(y, x)]) -> HashMap x y -> HashMap y x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((x, y) -> (y, x)) -> [(x, y)] -> [(y, x)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x, y) -> (y, x)
forall a b. (a, b) -> (b, a)
swap ([(x, y)] -> [(y, x)])
-> (HashMap x y -> [(x, y)]) -> HashMap x y -> [(y, x)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap x y -> [(x, y)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList

-- | Try to find a foreign key constraint, identifying a constraint by its set of columns
getRequiredFkey ::
  (QErrM m, Backend b) =>
  NonEmpty (Column b) ->
  [ForeignKey b] ->
  m (ForeignKey b)
getRequiredFkey :: forall (m :: * -> *) (b :: BackendType).
(QErrM m, Backend b) =>
NonEmpty (Column b) -> [ForeignKey b] -> m (ForeignKey b)
getRequiredFkey NonEmpty (Column b)
cols [ForeignKey b]
fkeys =
  case [ForeignKey b]
filteredFkeys of
    [ForeignKey b
k] -> ForeignKey b -> m (ForeignKey b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignKey b
k
    [] -> Code -> Text -> m (ForeignKey b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ConstraintError Text
"no foreign constraint exists on the given column(s)"
    [ForeignKey b]
_ -> Code -> Text -> m (ForeignKey b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ConstraintError Text
"more than one foreign key constraint exists on the given column(s)"
  where
    filteredFkeys :: [ForeignKey b]
filteredFkeys = (ForeignKey b -> Bool) -> [ForeignKey b] -> [ForeignKey b]
forall a. (a -> Bool) -> [a] -> [a]
filter ((HashSet (Column b) -> HashSet (Column b) -> Bool
forall a. Eq a => a -> a -> Bool
== [Column b] -> HashSet (Column b)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList (NonEmpty (Column b) -> [Column b]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Column b)
cols)) (HashSet (Column b) -> Bool)
-> (ForeignKey b -> HashSet (Column b)) -> ForeignKey b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap (Column b) (Column b) -> HashSet (Column b)
forall k a. HashMap k a -> HashSet k
HashMap.keysSet (HashMap (Column b) (Column b) -> HashSet (Column b))
-> (ForeignKey b -> HashMap (Column b) (Column b))
-> ForeignKey b
-> HashSet (Column b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEHashMap (Column b) (Column b) -> HashMap (Column b) (Column b)
forall k v. NEHashMap k v -> HashMap k v
NEHashMap.toHashMap (NEHashMap (Column b) (Column b) -> HashMap (Column b) (Column b))
-> (ForeignKey b -> NEHashMap (Column b) (Column b))
-> ForeignKey b
-> HashMap (Column b) (Column b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignKey b -> NEHashMap (Column b) (Column b)
forall (b :: BackendType).
ForeignKey b -> NEHashMap (Column b) (Column b)
_fkColumnMapping) [ForeignKey b]
fkeys

drUsingColumnDep ::
  forall b.
  (Backend b) =>
  SourceName ->
  TableName b ->
  Column b ->
  SchemaDependency
drUsingColumnDep :: forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> Column b -> SchemaDependency
drUsingColumnDep SourceName
source TableName b
qt Column b
col =
  SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
    ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
        (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
        (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
qt
        (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). Column b -> TableObjId b
TOCol @b Column b
col
    )
    DependencyReason
DRUsingColumn

--------------------------------------------------------------------------------
-- Drop local relationship

data DropRel b = DropRel
  { forall (b :: BackendType). DropRel b -> SourceName
_drSource :: SourceName,
    forall (b :: BackendType). DropRel b -> TableName b
_drTable :: TableName b,
    forall (b :: BackendType). DropRel b -> RelName
_drRelationship :: RelName,
    forall (b :: BackendType). DropRel b -> Bool
_drCascade :: Bool
  }

instance (Backend b) => FromJSON (DropRel b) where
  parseJSON :: Value -> Parser (DropRel b)
parseJSON = String
-> (Object -> Parser (DropRel b)) -> Value -> Parser (DropRel b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DropRel" ((Object -> Parser (DropRel b)) -> Value -> Parser (DropRel b))
-> (Object -> Parser (DropRel b)) -> Value -> Parser (DropRel b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName -> TableName b -> RelName -> Bool -> DropRel b
forall (b :: BackendType).
SourceName -> TableName b -> RelName -> Bool -> DropRel b
DropRel
      (SourceName -> TableName b -> RelName -> Bool -> DropRel b)
-> Parser SourceName
-> Parser (TableName b -> RelName -> Bool -> DropRel b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source"
      Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser (TableName b -> RelName -> Bool -> DropRel b)
-> Parser (TableName b) -> Parser (RelName -> Bool -> DropRel b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser (RelName -> Bool -> DropRel b)
-> Parser RelName -> Parser (Bool -> DropRel b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser RelName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"relationship"
      Parser (Bool -> DropRel b) -> Parser Bool -> Parser (DropRel b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cascade"
      Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

execDropRel ::
  forall b m.
  (MonadError QErr m, CacheRWM m, BackendMetadata b) =>
  DropRel b ->
  m MetadataModifier
execDropRel :: forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, BackendMetadata b) =>
DropRel b -> m MetadataModifier
execDropRel (DropRel SourceName
source TableName b
qt RelName
rn Bool
cascade) = do
  TableCoreInfo b
tableInfo <- forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableCoreInfo b)
askTableCoreInfo @b SourceName
source TableName b
qt

  RelInfo b
_ <- FieldInfoMap (FieldInfo b) -> RelName -> Text -> m (RelInfo b)
forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> RelName -> Text -> m (RelInfo backend)
askRelType (TableCoreInfo b -> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfo b
tableInfo) RelName
rn Text
""
  SchemaCache
schemaCache <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache

  let sourceObj :: SchemaObjId
      sourceObj :: SchemaObjId
sourceObj =
        SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
          (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
          (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
qt
          (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ RelName -> TableObjId b
forall (b :: BackendType). RelName -> TableObjId b
TORel RelName
rn

      depObjs :: [SchemaObjId]
      depObjs :: [SchemaObjId]
depObjs = SchemaCache -> SchemaObjId -> [SchemaObjId]
getDependentObjs SchemaCache
schemaCache SchemaObjId
sourceObj

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SchemaObjId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SchemaObjId]
depObjs Bool -> Bool -> Bool
|| Bool
cascade) do
    [SchemaObjId] -> m ()
forall (m :: * -> *). MonadError QErr m => [SchemaObjId] -> m ()
reportDependentObjectsExist [SchemaObjId]
depObjs

  [TableMetadata b -> TableMetadata b]
metadataModifiers <- (SchemaObjId -> m (TableMetadata b -> TableMetadata b))
-> [SchemaObjId] -> m [TableMetadata b -> TableMetadata b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse SchemaObjId -> m (TableMetadata b -> TableMetadata b)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
SchemaObjId -> m (TableMetadata b -> TableMetadata b)
purgeRelDep [SchemaObjId]
depObjs

  let modifier :: TableMetadata b -> TableMetadata b
      modifier :: TableMetadata b -> TableMetadata b
modifier = RelName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RelName -> TableMetadata b -> TableMetadata b
dropRelationshipInMetadata RelName
rn (TableMetadata b -> TableMetadata b)
-> (TableMetadata b -> TableMetadata b)
-> TableMetadata b
-> TableMetadata b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TableMetadata b -> TableMetadata b)
 -> (TableMetadata b -> TableMetadata b)
 -> TableMetadata b
 -> TableMetadata b)
-> (TableMetadata b -> TableMetadata b)
-> [TableMetadata b -> TableMetadata b]
-> TableMetadata b
-> TableMetadata b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (TableMetadata b -> TableMetadata b)
-> (TableMetadata b -> TableMetadata b)
-> TableMetadata b
-> TableMetadata b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) TableMetadata b -> TableMetadata b
forall a. a -> a
id [TableMetadata b -> TableMetadata b]
metadataModifiers

  MetadataModifier -> m MetadataModifier
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Metadata -> Metadata) -> MetadataModifier
MetadataModifier (forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
qt ASetter' Metadata (TableMetadata b)
-> (TableMetadata b -> TableMetadata b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TableMetadata b -> TableMetadata b
modifier))

runDropRel ::
  forall m b.
  (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  DropRel b ->
  m EncJSON
runDropRel :: forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
DropRel b -> m EncJSON
runDropRel DropRel b
dropRel = do
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck do
    MetadataModifier
metadataModifier <- DropRel b -> m MetadataModifier
forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, BackendMetadata b) =>
DropRel b -> m MetadataModifier
execDropRel DropRel b
dropRel
    MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache MetadataModifier
metadataModifier

  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

purgeRelDep ::
  forall b m.
  (QErrM m) =>
  (Backend b) =>
  SchemaObjId ->
  m (TableMetadata b -> TableMetadata b)
purgeRelDep :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
SchemaObjId -> m (TableMetadata b -> TableMetadata b)
purgeRelDep (SOSourceObj SourceName
_ AnyBackend SourceObjId
exists)
  | Just (SOITableObj TableName b
_ (TOPerm RoleName
rn PermType
pt)) <- forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend @b AnyBackend SourceObjId
exists =
      (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TableMetadata b -> TableMetadata b)
 -> m (TableMetadata b -> TableMetadata b))
-> (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$ RoleName -> PermType -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RoleName -> PermType -> TableMetadata b -> TableMetadata b
dropPermissionInMetadata RoleName
rn PermType
pt
purgeRelDep SchemaObjId
d =
  Text -> m (TableMetadata b -> TableMetadata b)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500
    (Text -> m (TableMetadata b -> TableMetadata b))
-> Text -> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$ Text
"unexpected dependency of relationship: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SchemaObjId -> Text
reportSchemaObj SchemaObjId
d

--------------------------------------------------------------------------------
-- Set local relationship comment

data SetRelComment b = SetRelComment
  { forall (b :: BackendType). SetRelComment b -> SourceName
arSource :: SourceName,
    forall (b :: BackendType). SetRelComment b -> TableName b
arTable :: TableName b,
    forall (b :: BackendType). SetRelComment b -> RelName
arRelationship :: RelName,
    forall (b :: BackendType). SetRelComment b -> Maybe Text
arComment :: Maybe Text
  }
  deriving ((forall x. SetRelComment b -> Rep (SetRelComment b) x)
-> (forall x. Rep (SetRelComment b) x -> SetRelComment b)
-> Generic (SetRelComment b)
forall x. Rep (SetRelComment b) x -> SetRelComment b
forall x. SetRelComment b -> Rep (SetRelComment b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (SetRelComment b) x -> SetRelComment b
forall (b :: BackendType) x.
SetRelComment b -> Rep (SetRelComment b) x
$cfrom :: forall (b :: BackendType) x.
SetRelComment b -> Rep (SetRelComment b) x
from :: forall x. SetRelComment b -> Rep (SetRelComment b) x
$cto :: forall (b :: BackendType) x.
Rep (SetRelComment b) x -> SetRelComment b
to :: forall x. Rep (SetRelComment b) x -> SetRelComment b
Generic)

deriving instance (Backend b) => Show (SetRelComment b)

deriving instance (Backend b) => Eq (SetRelComment b)

instance (Backend b) => FromJSON (SetRelComment b) where
  parseJSON :: Value -> Parser (SetRelComment b)
parseJSON = String
-> (Object -> Parser (SetRelComment b))
-> Value
-> Parser (SetRelComment b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SetRelComment" ((Object -> Parser (SetRelComment b))
 -> Value -> Parser (SetRelComment b))
-> (Object -> Parser (SetRelComment b))
-> Value
-> Parser (SetRelComment b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName
-> TableName b -> RelName -> Maybe Text -> SetRelComment b
forall (b :: BackendType).
SourceName
-> TableName b -> RelName -> Maybe Text -> SetRelComment b
SetRelComment
      (SourceName
 -> TableName b -> RelName -> Maybe Text -> SetRelComment b)
-> Parser SourceName
-> Parser (TableName b -> RelName -> Maybe Text -> SetRelComment b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source"
      Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser (TableName b -> RelName -> Maybe Text -> SetRelComment b)
-> Parser (TableName b)
-> Parser (RelName -> Maybe Text -> SetRelComment b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser (RelName -> Maybe Text -> SetRelComment b)
-> Parser RelName -> Parser (Maybe Text -> SetRelComment b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser RelName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"relationship"
      Parser (Maybe Text -> SetRelComment b)
-> Parser (Maybe Text) -> Parser (SetRelComment b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment"

runSetRelComment ::
  forall m b.
  (CacheRWM m, MonadError QErr m, MetadataM m, BackendMetadata b) =>
  SetRelComment b ->
  m EncJSON
runSetRelComment :: forall (m :: * -> *) (b :: BackendType).
(CacheRWM m, MonadError QErr m, MetadataM m, BackendMetadata b) =>
SetRelComment b -> m EncJSON
runSetRelComment SetRelComment b
defn = do
  TableCoreInfo b
tabInfo <- forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableCoreInfo b)
askTableCoreInfo @b SourceName
source TableName b
qt
  RelType
relType <- RelInfo b -> RelType
forall (b :: BackendType). RelInfo b -> RelType
riType (RelInfo b -> RelType) -> m (RelInfo b) -> m RelType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldInfoMap (FieldInfo b) -> RelName -> Text -> m (RelInfo b)
forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> RelName -> Text -> m (RelInfo backend)
askRelType (TableCoreInfo b -> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfo b
tabInfo) RelName
rn Text
""
  let metadataObj :: MetadataObjId
metadataObj =
        SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source
          (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
          (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
qt
          (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$ RelName -> RelType -> TableMetadataObjId
MTORel RelName
rn RelType
relType
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
metadataObj
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
qt
    ASetter' Metadata (TableMetadata b)
-> (TableMetadata b -> TableMetadata b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case RelType
relType of
      RelType
ObjRel -> (Relationships (ObjRelDef b)
 -> Identity (Relationships (ObjRelDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Relationships (ObjRelDef b) -> f (Relationships (ObjRelDef b)))
-> TableMetadata b -> f (TableMetadata b)
tmObjectRelationships ((Relationships (ObjRelDef b)
  -> Identity (Relationships (ObjRelDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> ((Maybe Text -> Identity (Maybe Text))
    -> Relationships (ObjRelDef b)
    -> Identity (Relationships (ObjRelDef b)))
-> (Maybe Text -> Identity (Maybe Text))
-> TableMetadata b
-> Identity (TableMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Relationships (ObjRelDef b))
-> Traversal'
     (Relationships (ObjRelDef b))
     (IxValue (Relationships (ObjRelDef b)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Relationships (ObjRelDef b))
RelName
rn ((ObjRelDef b -> Identity (ObjRelDef b))
 -> Relationships (ObjRelDef b)
 -> Identity (Relationships (ObjRelDef b)))
-> ((Maybe Text -> Identity (Maybe Text))
    -> ObjRelDef b -> Identity (ObjRelDef b))
-> (Maybe Text -> Identity (Maybe Text))
-> Relationships (ObjRelDef b)
-> Identity (Relationships (ObjRelDef b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> ObjRelDef b -> Identity (ObjRelDef b)
forall a (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text)) -> RelDef a -> f (RelDef a)
rdComment ((Maybe Text -> Identity (Maybe Text))
 -> TableMetadata b -> Identity (TableMetadata b))
-> Maybe Text -> TableMetadata b -> TableMetadata b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
comment
      RelType
ArrRel -> (Relationships (ArrRelDef b)
 -> Identity (Relationships (ArrRelDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Relationships (ArrRelDef b) -> f (Relationships (ArrRelDef b)))
-> TableMetadata b -> f (TableMetadata b)
tmArrayRelationships ((Relationships (ArrRelDef b)
  -> Identity (Relationships (ArrRelDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> ((Maybe Text -> Identity (Maybe Text))
    -> Relationships (ArrRelDef b)
    -> Identity (Relationships (ArrRelDef b)))
-> (Maybe Text -> Identity (Maybe Text))
-> TableMetadata b
-> Identity (TableMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Relationships (ArrRelDef b))
-> Traversal'
     (Relationships (ArrRelDef b))
     (IxValue (Relationships (ArrRelDef b)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Relationships (ArrRelDef b))
RelName
rn ((ArrRelDef b -> Identity (ArrRelDef b))
 -> Relationships (ArrRelDef b)
 -> Identity (Relationships (ArrRelDef b)))
-> ((Maybe Text -> Identity (Maybe Text))
    -> ArrRelDef b -> Identity (ArrRelDef b))
-> (Maybe Text -> Identity (Maybe Text))
-> Relationships (ArrRelDef b)
-> Identity (Relationships (ArrRelDef b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> ArrRelDef b -> Identity (ArrRelDef b)
forall a (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text)) -> RelDef a -> f (RelDef a)
rdComment ((Maybe Text -> Identity (Maybe Text))
 -> TableMetadata b -> Identity (TableMetadata b))
-> Maybe Text -> TableMetadata b -> TableMetadata b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
comment
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg
  where
    SetRelComment SourceName
source TableName b
qt RelName
rn Maybe Text
comment = SetRelComment b
defn