{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasura.RQL.Types.SchemaCacheTypes
  ( BoolExpM (..),
    GetAggregationPredicatesDeps (..),
    BoolExpCtx (..),
    DependencyReason (..),
    SchemaDependency (..),
    SchemaObjId (..),
    SourceObjId (..),
    TableObjId (..),
    purgeDependentObject,
    purgeSourceAndSchemaDependencies,
    reasonToTxt,
    reportDependentObjectsExist,
    reportSchemaObj,
    reportSchemaObjs,
    runBoolExpM,
  )
where

import Data.Aeson
import Data.Aeson.TH
import Data.Aeson.Types
import Data.Functor.Const
import Data.Text qualified as T
import Data.Text.Extended
import Data.Text.NonEmpty
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp (PartialSQLExp)
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Instances ()
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.RemoteSchema
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
import Hasura.Session
import Language.GraphQL.Draft.Syntax qualified as G

data TableObjId (b :: BackendType)
  = TOCol (Column b)
  | TORel RelName
  | TOComputedField ComputedFieldName
  | TORemoteRel RelName
  | TOForeignKey (ConstraintName b)
  | TOPerm RoleName PermType
  | TOTrigger TriggerName
  deriving ((forall x. TableObjId b -> Rep (TableObjId b) x)
-> (forall x. Rep (TableObjId b) x -> TableObjId b)
-> Generic (TableObjId b)
forall x. Rep (TableObjId b) x -> TableObjId b
forall x. TableObjId b -> Rep (TableObjId b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (TableObjId b) x -> TableObjId b
forall (b :: BackendType) x. TableObjId b -> Rep (TableObjId b) x
$cto :: forall (b :: BackendType) x. Rep (TableObjId b) x -> TableObjId b
$cfrom :: forall (b :: BackendType) x. TableObjId b -> Rep (TableObjId b) x
Generic)

deriving instance Backend b => Eq (TableObjId b)

instance (Backend b) => Hashable (TableObjId b)

data SourceObjId (b :: BackendType)
  = SOITable (TableName b)
  | SOITableObj (TableName b) (TableObjId b)
  | SOIFunction (FunctionName b)
  deriving (SourceObjId b -> SourceObjId b -> Bool
(SourceObjId b -> SourceObjId b -> Bool)
-> (SourceObjId b -> SourceObjId b -> Bool) -> Eq (SourceObjId b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
SourceObjId b -> SourceObjId b -> Bool
/= :: SourceObjId b -> SourceObjId b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
SourceObjId b -> SourceObjId b -> Bool
== :: SourceObjId b -> SourceObjId b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
SourceObjId b -> SourceObjId b -> Bool
Eq, (forall x. SourceObjId b -> Rep (SourceObjId b) x)
-> (forall x. Rep (SourceObjId b) x -> SourceObjId b)
-> Generic (SourceObjId b)
forall x. Rep (SourceObjId b) x -> SourceObjId b
forall x. SourceObjId b -> Rep (SourceObjId b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (SourceObjId b) x -> SourceObjId b
forall (b :: BackendType) x. SourceObjId b -> Rep (SourceObjId b) x
$cto :: forall (b :: BackendType) x. Rep (SourceObjId b) x -> SourceObjId b
$cfrom :: forall (b :: BackendType) x. SourceObjId b -> Rep (SourceObjId b) x
Generic)

instance (Backend b) => Hashable (SourceObjId b)

data SchemaObjId
  = SOSource SourceName
  | SOSourceObj SourceName (AB.AnyBackend SourceObjId)
  | SORemoteSchema RemoteSchemaName
  | SORemoteSchemaPermission RemoteSchemaName RoleName
  | -- | A remote relationship on a remote schema type, identified by
    -- 1. remote schema name
    -- 2. remote schema type on which the relationship is defined
    -- 3. name of the relationship
    SORemoteSchemaRemoteRelationship RemoteSchemaName G.Name RelName
  | SORole RoleName
  deriving (SchemaObjId -> SchemaObjId -> Bool
(SchemaObjId -> SchemaObjId -> Bool)
-> (SchemaObjId -> SchemaObjId -> Bool) -> Eq SchemaObjId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemaObjId -> SchemaObjId -> Bool
$c/= :: SchemaObjId -> SchemaObjId -> Bool
== :: SchemaObjId -> SchemaObjId -> Bool
$c== :: SchemaObjId -> SchemaObjId -> Bool
Eq, (forall x. SchemaObjId -> Rep SchemaObjId x)
-> (forall x. Rep SchemaObjId x -> SchemaObjId)
-> Generic SchemaObjId
forall x. Rep SchemaObjId x -> SchemaObjId
forall x. SchemaObjId -> Rep SchemaObjId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SchemaObjId x -> SchemaObjId
$cfrom :: forall x. SchemaObjId -> Rep SchemaObjId x
Generic)

instance Hashable SchemaObjId

reportSchemaObj :: SchemaObjId -> T.Text
reportSchemaObj :: SchemaObjId -> Text
reportSchemaObj = \case
  SOSource SourceName
source -> Text
"source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
sourceNameToText SourceName
source
  SOSourceObj SourceName
source AnyBackend SourceObjId
exists -> SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
inSource SourceName
source (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
    AnyBackend SourceObjId
-> (forall (b :: BackendType). Backend b => SourceObjId b -> Text)
-> Text
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend
      AnyBackend SourceObjId
exists
      \case
        SOITable TableName b
tn -> Text
"table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn
        SOIFunction FunctionName b
fn -> Text
"function " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FunctionName b -> Text
forall a. ToTxt a => a -> Text
toTxt FunctionName b
fn
        SOITableObj TableName b
tn (TOCol Column b
cn) ->
          Text
"column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Column b -> Text
forall a. ToTxt a => a -> Text
toTxt Column b
cn
        SOITableObj TableName b
tn (TORel RelName
cn) ->
          Text
"relationship " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName -> Text
forall a. ToTxt a => a -> Text
toTxt RelName
cn
        SOITableObj TableName b
tn (TOForeignKey ConstraintName b
cn) ->
          Text
"constraint " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConstraintName b -> Text
forall a. ToTxt a => a -> Text
toTxt ConstraintName b
cn
        SOITableObj TableName b
tn (TOPerm RoleName
rn PermType
pt) ->
          Text
"permission " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName -> Text
roleNameToTxt RoleName
rn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PermType -> Text
permTypeToCode PermType
pt
        SOITableObj TableName b
tn (TOTrigger TriggerName
trn) ->
          Text
"event-trigger " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TriggerName -> Text
triggerNameToTxt TriggerName
trn
        SOITableObj TableName b
tn (TOComputedField ComputedFieldName
ccn) ->
          Text
"computed field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ComputedFieldName -> Text
computedFieldNameToText ComputedFieldName
ccn
        SOITableObj TableName b
tn (TORemoteRel RelName
rn) ->
          Text
"remote relationship " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName -> Text
relNameToTxt RelName
rn
  SORemoteSchema RemoteSchemaName
remoteSchemaName ->
    Text
"remote schema " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmptyText -> Text
unNonEmptyText (RemoteSchemaName -> NonEmptyText
unRemoteSchemaName RemoteSchemaName
remoteSchemaName)
  SORemoteSchemaPermission RemoteSchemaName
remoteSchemaName RoleName
roleName ->
    Text
"remote schema permission "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmptyText -> Text
unNonEmptyText (RemoteSchemaName -> NonEmptyText
unRemoteSchemaName RemoteSchemaName
remoteSchemaName)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> RoleName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RoleName
roleName
  SORemoteSchemaRemoteRelationship RemoteSchemaName
remoteSchemaName Name
typeName RelName
relationshipName ->
    Text
"remote_relationship " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName -> Text
forall a. ToTxt a => a -> Text
toTxt RelName
relationshipName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" on type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
typeName
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in remote schema "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoteSchemaName -> Text
forall a. ToTxt a => a -> Text
toTxt RemoteSchemaName
remoteSchemaName
  SORole RoleName
roleName -> Text
"role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName -> Text
roleNameToTxt RoleName
roleName
  where
    inSource :: t -> Text -> Text
inSource t
s Text
t = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in source " Text -> t -> Text
forall t. ToTxt t => Text -> t -> Text
<>> t
s

reportSchemaObjs :: [SchemaObjId] -> Text
reportSchemaObjs :: [SchemaObjId] -> Text
reportSchemaObjs = [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated ([Text] -> Text)
-> ([SchemaObjId] -> [Text]) -> [SchemaObjId] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text])
-> ([SchemaObjId] -> [Text]) -> [SchemaObjId] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SchemaObjId -> Text) -> [SchemaObjId] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map SchemaObjId -> Text
reportSchemaObj

instance Show SchemaObjId where
  show :: SchemaObjId -> String
show SchemaObjId
soi = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ SchemaObjId -> Text
reportSchemaObj SchemaObjId
soi

instance ToJSON SchemaObjId where
  toJSON :: SchemaObjId -> Value
toJSON = Text -> Value
String (Text -> Value) -> (SchemaObjId -> Text) -> SchemaObjId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaObjId -> Text
reportSchemaObj

instance ToJSONKey SchemaObjId where
  toJSONKey :: ToJSONKeyFunction SchemaObjId
toJSONKey = (SchemaObjId -> Text) -> ToJSONKeyFunction SchemaObjId
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText SchemaObjId -> Text
reportSchemaObj

data DependencyReason
  = DRTable
  | DRColumn
  | DRRemoteTable
  | DRLeftColumn
  | DRRightColumn
  | DRUsingColumn
  | DRFkey
  | DRRemoteFkey
  | DRUntyped
  | DROnType
  | DRSessionVariable
  | DRPayload
  | DRParent
  | DRRemoteSchema
  | DRRemoteRelationship
  | DRParentRole
  deriving (Int -> DependencyReason -> ShowS
[DependencyReason] -> ShowS
DependencyReason -> String
(Int -> DependencyReason -> ShowS)
-> (DependencyReason -> String)
-> ([DependencyReason] -> ShowS)
-> Show DependencyReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DependencyReason] -> ShowS
$cshowList :: [DependencyReason] -> ShowS
show :: DependencyReason -> String
$cshow :: DependencyReason -> String
showsPrec :: Int -> DependencyReason -> ShowS
$cshowsPrec :: Int -> DependencyReason -> ShowS
Show, DependencyReason -> DependencyReason -> Bool
(DependencyReason -> DependencyReason -> Bool)
-> (DependencyReason -> DependencyReason -> Bool)
-> Eq DependencyReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DependencyReason -> DependencyReason -> Bool
$c/= :: DependencyReason -> DependencyReason -> Bool
== :: DependencyReason -> DependencyReason -> Bool
$c== :: DependencyReason -> DependencyReason -> Bool
Eq, (forall x. DependencyReason -> Rep DependencyReason x)
-> (forall x. Rep DependencyReason x -> DependencyReason)
-> Generic DependencyReason
forall x. Rep DependencyReason x -> DependencyReason
forall x. DependencyReason -> Rep DependencyReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DependencyReason x -> DependencyReason
$cfrom :: forall x. DependencyReason -> Rep DependencyReason x
Generic)

instance Hashable DependencyReason

reasonToTxt :: DependencyReason -> Text
reasonToTxt :: DependencyReason -> Text
reasonToTxt = \case
  DependencyReason
DRTable -> Text
"table"
  DependencyReason
DRColumn -> Text
"column"
  DependencyReason
DRRemoteTable -> Text
"remote_table"
  DependencyReason
DRLeftColumn -> Text
"left_column"
  DependencyReason
DRRightColumn -> Text
"right_column"
  DependencyReason
DRUsingColumn -> Text
"using_column"
  DependencyReason
DRFkey -> Text
"fkey"
  DependencyReason
DRRemoteFkey -> Text
"remote_fkey"
  DependencyReason
DRUntyped -> Text
"untyped"
  DependencyReason
DROnType -> Text
"on_type"
  DependencyReason
DRSessionVariable -> Text
"session_variable"
  DependencyReason
DRPayload -> Text
"payload"
  DependencyReason
DRParent -> Text
"parent"
  DependencyReason
DRRemoteSchema -> Text
"remote_schema"
  DependencyReason
DRRemoteRelationship -> Text
"remote_relationship"
  DependencyReason
DRParentRole -> Text
"parent_role"

instance ToJSON DependencyReason where
  toJSON :: DependencyReason -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (DependencyReason -> Text) -> DependencyReason -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DependencyReason -> Text
reasonToTxt

data SchemaDependency = SchemaDependency
  { SchemaDependency -> SchemaObjId
sdObjId :: SchemaObjId,
    SchemaDependency -> DependencyReason
sdReason :: DependencyReason
  }
  deriving (Int -> SchemaDependency -> ShowS
[SchemaDependency] -> ShowS
SchemaDependency -> String
(Int -> SchemaDependency -> ShowS)
-> (SchemaDependency -> String)
-> ([SchemaDependency] -> ShowS)
-> Show SchemaDependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaDependency] -> ShowS
$cshowList :: [SchemaDependency] -> ShowS
show :: SchemaDependency -> String
$cshow :: SchemaDependency -> String
showsPrec :: Int -> SchemaDependency -> ShowS
$cshowsPrec :: Int -> SchemaDependency -> ShowS
Show, SchemaDependency -> SchemaDependency -> Bool
(SchemaDependency -> SchemaDependency -> Bool)
-> (SchemaDependency -> SchemaDependency -> Bool)
-> Eq SchemaDependency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemaDependency -> SchemaDependency -> Bool
$c/= :: SchemaDependency -> SchemaDependency -> Bool
== :: SchemaDependency -> SchemaDependency -> Bool
$c== :: SchemaDependency -> SchemaDependency -> Bool
Eq, (forall x. SchemaDependency -> Rep SchemaDependency x)
-> (forall x. Rep SchemaDependency x -> SchemaDependency)
-> Generic SchemaDependency
forall x. Rep SchemaDependency x -> SchemaDependency
forall x. SchemaDependency -> Rep SchemaDependency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SchemaDependency x -> SchemaDependency
$cfrom :: forall x. SchemaDependency -> Rep SchemaDependency x
Generic)

$(deriveToJSON hasuraJSON ''SchemaDependency)

instance Hashable SchemaDependency

reportDependentObjectsExist :: (MonadError QErr m) => [SchemaObjId] -> m ()
reportDependentObjectsExist :: [SchemaObjId] -> m ()
reportDependentObjectsExist [SchemaObjId]
dependentObjects =
  Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
DependencyError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
    Text
"cannot drop due to the following dependent objects : "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [SchemaObjId] -> Text
reportSchemaObjs [SchemaObjId]
dependentObjects

purgeSourceAndSchemaDependencies ::
  MonadError QErr m =>
  SchemaObjId ->
  WriterT MetadataModifier m ()
purgeSourceAndSchemaDependencies :: SchemaObjId -> WriterT MetadataModifier m ()
purgeSourceAndSchemaDependencies = \case
  SOSourceObj SourceName
sourceName AnyBackend SourceObjId
objectID -> do
    AnyBackend SourceObjId
-> (forall (b :: BackendType).
    Backend b =>
    SourceObjId b -> WriterT MetadataModifier m ())
-> WriterT MetadataModifier m ()
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend SourceObjId
objectID ((forall (b :: BackendType).
  Backend b =>
  SourceObjId b -> WriterT MetadataModifier m ())
 -> WriterT MetadataModifier m ())
-> (forall (b :: BackendType).
    Backend b =>
    SourceObjId b -> WriterT MetadataModifier m ())
-> WriterT MetadataModifier m ()
forall a b. (a -> b) -> a -> b
$ SourceName
-> SourceObjId b -> WriterT MetadataModifier m MetadataModifier
forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, Backend b) =>
SourceName -> SourceObjId b -> m MetadataModifier
purgeDependentObject SourceName
sourceName (SourceObjId b -> WriterT MetadataModifier m MetadataModifier)
-> (MetadataModifier -> WriterT MetadataModifier m ())
-> SourceObjId b
-> WriterT MetadataModifier m ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MetadataModifier -> WriterT MetadataModifier m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  SORemoteSchemaRemoteRelationship RemoteSchemaName
remoteSchemaName Name
typeName RelName
relationshipName -> do
    MetadataModifier -> WriterT MetadataModifier m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (MetadataModifier -> WriterT MetadataModifier m ())
-> MetadataModifier -> WriterT MetadataModifier m ()
forall a b. (a -> b) -> a -> b
$ RemoteSchemaName -> Name -> RelName -> MetadataModifier
dropRemoteSchemaRemoteRelationshipInMetadata RemoteSchemaName
remoteSchemaName Name
typeName RelName
relationshipName
  SchemaObjId
_ ->
    () -> WriterT MetadataModifier m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

purgeDependentObject ::
  forall b m.
  (MonadError QErr m, Backend b) =>
  SourceName ->
  SourceObjId b ->
  m MetadataModifier
purgeDependentObject :: SourceName -> SourceObjId b -> m MetadataModifier
purgeDependentObject SourceName
source SourceObjId b
sourceObjId = case SourceObjId b
sourceObjId of
  SOITableObj TableName b
tn TableObjId b
tableObj ->
    MetadataModifier -> m MetadataModifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataModifier -> m MetadataModifier)
-> MetadataModifier -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$
      (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$
        SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
tn 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 TableObjId b
tableObj of
          TOPerm RoleName
rn PermType
pt -> RoleName -> PermType -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RoleName -> PermType -> TableMetadata b -> TableMetadata b
dropPermissionInMetadata RoleName
rn PermType
pt
          TORel RelName
rn -> RelName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RelName -> TableMetadata b -> TableMetadata b
dropRelationshipInMetadata RelName
rn
          TOTrigger TriggerName
trn -> TriggerName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
TriggerName -> TableMetadata b -> TableMetadata b
dropEventTriggerInMetadata TriggerName
trn
          TOComputedField ComputedFieldName
ccn -> ComputedFieldName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
ComputedFieldName -> TableMetadata b -> TableMetadata b
dropComputedFieldInMetadata ComputedFieldName
ccn
          TORemoteRel RelName
rrn -> RelName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RelName -> TableMetadata b -> TableMetadata b
dropRemoteRelationshipInMetadata RelName
rrn
          TableObjId b
_ -> TableMetadata b -> TableMetadata b
forall a. a -> a
id
  SOIFunction FunctionName b
qf -> MetadataModifier -> m MetadataModifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataModifier -> m MetadataModifier)
-> MetadataModifier -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ SourceName -> FunctionName b -> MetadataModifier
forall (b :: BackendType).
Backend b =>
SourceName -> FunctionName b -> MetadataModifier
dropFunctionInMetadata @b SourceName
source FunctionName b
qf
  SourceObjId b
_ ->
    Text -> m MetadataModifier
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m MetadataModifier) -> Text -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$
      Text
"unexpected dependent object: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SchemaObjId -> Text
reportSchemaObj (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
sourceObjId)

-- | Type class to collect schema dependencies from backend-specific aggregation predicates.
class Backend b => GetAggregationPredicatesDeps b where
  getAggregationPredicateDeps ::
    AggregationPredicates b (PartialSQLExp b) ->
    BoolExpM b [SchemaDependency]
  default getAggregationPredicateDeps ::
    (AggregationPredicates b ~ Const Void) =>
    AggregationPredicates b (PartialSQLExp b) ->
    BoolExpM b [SchemaDependency]
  getAggregationPredicateDeps = Void -> BoolExpM b [SchemaDependency]
forall a. Void -> a
absurd (Void -> BoolExpM b [SchemaDependency])
-> (Const Void (PartialSQLExp b) -> Void)
-> Const Void (PartialSQLExp b)
-> BoolExpM b [SchemaDependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const Void (PartialSQLExp b) -> Void
forall a k (b :: k). Const a b -> a
getConst

-- | The monad for doing schema dependency discovery for boolean expressions.
-- maintains the table context of the expressions being translated.
newtype BoolExpM b a = BoolExpM {BoolExpM b a -> Reader (BoolExpCtx b) a
unBoolExpM :: Reader (BoolExpCtx b) a}
  deriving (a -> BoolExpM b b -> BoolExpM b a
(a -> b) -> BoolExpM b a -> BoolExpM b b
(forall a b. (a -> b) -> BoolExpM b a -> BoolExpM b b)
-> (forall a b. a -> BoolExpM b b -> BoolExpM b a)
-> Functor (BoolExpM b)
forall a b. a -> BoolExpM b b -> BoolExpM b a
forall a b. (a -> b) -> BoolExpM b a -> BoolExpM b b
forall (b :: BackendType) a b. a -> BoolExpM b b -> BoolExpM b a
forall (b :: BackendType) a b.
(a -> b) -> BoolExpM b a -> BoolExpM b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BoolExpM b b -> BoolExpM b a
$c<$ :: forall (b :: BackendType) a b. a -> BoolExpM b b -> BoolExpM b a
fmap :: (a -> b) -> BoolExpM b a -> BoolExpM b b
$cfmap :: forall (b :: BackendType) a b.
(a -> b) -> BoolExpM b a -> BoolExpM b b
Functor, Functor (BoolExpM b)
a -> BoolExpM b a
Functor (BoolExpM b)
-> (forall a. a -> BoolExpM b a)
-> (forall a b.
    BoolExpM b (a -> b) -> BoolExpM b a -> BoolExpM b b)
-> (forall a b c.
    (a -> b -> c) -> BoolExpM b a -> BoolExpM b b -> BoolExpM b c)
-> (forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b b)
-> (forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b a)
-> Applicative (BoolExpM b)
BoolExpM b a -> BoolExpM b b -> BoolExpM b b
BoolExpM b a -> BoolExpM b b -> BoolExpM b a
BoolExpM b (a -> b) -> BoolExpM b a -> BoolExpM b b
(a -> b -> c) -> BoolExpM b a -> BoolExpM b b -> BoolExpM b c
forall a. a -> BoolExpM b a
forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b a
forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b b
forall a b. BoolExpM b (a -> b) -> BoolExpM b a -> BoolExpM b b
forall a b c.
(a -> b -> c) -> BoolExpM b a -> BoolExpM b b -> BoolExpM b c
forall (b :: BackendType). Functor (BoolExpM b)
forall (b :: BackendType) a. a -> BoolExpM b a
forall (b :: BackendType) a b.
BoolExpM b a -> BoolExpM b b -> BoolExpM b a
forall (b :: BackendType) a b.
BoolExpM b a -> BoolExpM b b -> BoolExpM b b
forall (b :: BackendType) a b.
BoolExpM b (a -> b) -> BoolExpM b a -> BoolExpM b b
forall (b :: BackendType) a b c.
(a -> b -> c) -> BoolExpM b a -> BoolExpM b b -> BoolExpM b c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: BoolExpM b a -> BoolExpM b b -> BoolExpM b a
$c<* :: forall (b :: BackendType) a b.
BoolExpM b a -> BoolExpM b b -> BoolExpM b a
*> :: BoolExpM b a -> BoolExpM b b -> BoolExpM b b
$c*> :: forall (b :: BackendType) a b.
BoolExpM b a -> BoolExpM b b -> BoolExpM b b
liftA2 :: (a -> b -> c) -> BoolExpM b a -> BoolExpM b b -> BoolExpM b c
$cliftA2 :: forall (b :: BackendType) a b c.
(a -> b -> c) -> BoolExpM b a -> BoolExpM b b -> BoolExpM b c
<*> :: BoolExpM b (a -> b) -> BoolExpM b a -> BoolExpM b b
$c<*> :: forall (b :: BackendType) a b.
BoolExpM b (a -> b) -> BoolExpM b a -> BoolExpM b b
pure :: a -> BoolExpM b a
$cpure :: forall (b :: BackendType) a. a -> BoolExpM b a
$cp1Applicative :: forall (b :: BackendType). Functor (BoolExpM b)
Applicative, Applicative (BoolExpM b)
a -> BoolExpM b a
Applicative (BoolExpM b)
-> (forall a b.
    BoolExpM b a -> (a -> BoolExpM b b) -> BoolExpM b b)
-> (forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b b)
-> (forall a. a -> BoolExpM b a)
-> Monad (BoolExpM b)
BoolExpM b a -> (a -> BoolExpM b b) -> BoolExpM b b
BoolExpM b a -> BoolExpM b b -> BoolExpM b b
forall a. a -> BoolExpM b a
forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b b
forall a b. BoolExpM b a -> (a -> BoolExpM b b) -> BoolExpM b b
forall (b :: BackendType). Applicative (BoolExpM b)
forall (b :: BackendType) a. a -> BoolExpM b a
forall (b :: BackendType) a b.
BoolExpM b a -> BoolExpM b b -> BoolExpM b b
forall (b :: BackendType) a b.
BoolExpM b a -> (a -> BoolExpM b b) -> BoolExpM b b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> BoolExpM b a
$creturn :: forall (b :: BackendType) a. a -> BoolExpM b a
>> :: BoolExpM b a -> BoolExpM b b -> BoolExpM b b
$c>> :: forall (b :: BackendType) a b.
BoolExpM b a -> BoolExpM b b -> BoolExpM b b
>>= :: BoolExpM b a -> (a -> BoolExpM b b) -> BoolExpM b b
$c>>= :: forall (b :: BackendType) a b.
BoolExpM b a -> (a -> BoolExpM b b) -> BoolExpM b b
$cp1Monad :: forall (b :: BackendType). Applicative (BoolExpM b)
Monad, MonadReader (BoolExpCtx b))

-- | The table type context of schema dependency discovery. Boolean expressions
-- may refer to a so-called 'root table' (identified by a '$'-sign in the
-- expression input syntax) or the 'current' table.
data BoolExpCtx b = BoolExpCtx
  { BoolExpCtx b -> SourceName
source :: SourceName,
    -- | Reference to the 'current' table type.
    BoolExpCtx b -> TableName b
currTable :: TableName b,
    -- | Reference to the 'root' table type.
    BoolExpCtx b -> TableName b
rootTable :: TableName b
  }

runBoolExpM :: BoolExpCtx b -> BoolExpM b a -> a
runBoolExpM :: BoolExpCtx b -> BoolExpM b a -> a
runBoolExpM BoolExpCtx b
ctx = (Reader (BoolExpCtx b) a -> BoolExpCtx b -> a)
-> BoolExpCtx b -> Reader (BoolExpCtx b) a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reader (BoolExpCtx b) a -> BoolExpCtx b -> a
forall r a. Reader r a -> r -> a
runReader BoolExpCtx b
ctx (Reader (BoolExpCtx b) a -> a)
-> (BoolExpM b a -> Reader (BoolExpCtx b) a) -> BoolExpM b a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolExpM b a -> Reader (BoolExpCtx b) a
forall (b :: BackendType) a.
BoolExpM b a -> Reader (BoolExpCtx b) a
unBoolExpM