{-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Types/functions shared between modules that implement "Hasura.RQL.DDL.Schema.Cache". Other
-- modules should not import this module directly.
module Hasura.RQL.DDL.Schema.Cache.Common
  ( ApolloFederationConfig (..),
    ApolloFederationVersion (..),
    BackendInvalidationKeysWrapper (..),
    BuildOutputs (..),
    CacheBuild,
    CacheBuildParams (CacheBuildParams),
    InvalidationKeys (..),
    ikMetadata,
    ikRemoteSchemas,
    ikSources,
    ikBackends,
    NonColumnTableInputs (..),
    RebuildableSchemaCache (RebuildableSchemaCache, lastBuiltSchemaCache),
    TableBuildInput (TableBuildInput, _tbiName),
    TablePermissionInputs (..),
    addTableContext,
    addLogicalModelContext,
    boActions,
    boCustomTypes,
    boBackendCache,
    boRemoteSchemas,
    boRoles,
    boSources,
    buildInfoMap,
    buildInfoMapM,
    buildInfoMapPreservingMetadata,
    buildInfoMapPreservingMetadataM,
    initialInvalidationKeys,
    invalidateKeys,
    mkTableInputs,
    runCacheBuild,
    runCacheBuildM,
    withRecordDependencies,
    SourcesIntrospectionStatus (..),
  )
where

import Control.Arrow.Extended
import Control.Arrow.Interpret
import Control.Lens hiding ((.=))
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.HashMap.Strict.Extended qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Sequence qualified as Seq
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.Incremental qualified as Inc
import Hasura.LogicalModel.Types (LogicalModelName)
import Hasura.Prelude
import Hasura.RQL.DDL.Schema.Cache.Config
import Hasura.RQL.DDL.SchemaRegistry (SchemaRegistryAction)
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Backend (BackendMetadata (..))
import Hasura.RQL.Types.Metadata.Instances ()
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.Roles
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.Source
import Hasura.RemoteSchema.Metadata
import Hasura.SQL.BackendMap (BackendMap)
import Hasura.SQL.BackendMap qualified as BackendMap
import Hasura.Services
import Hasura.Table.Metadata (TableMetadata (..))
import Network.HTTP.Client.Transformable qualified as HTTP

newtype BackendInvalidationKeysWrapper (b :: BackendType) = BackendInvalidationKeysWrapper
  { forall (b :: BackendType).
BackendInvalidationKeysWrapper b -> BackendInvalidationKeys b
unBackendInvalidationKeysWrapper :: BackendInvalidationKeys b
  }

deriving newtype instance (Eq (BackendInvalidationKeys b)) => Eq (BackendInvalidationKeysWrapper b)

deriving newtype instance (Ord (BackendInvalidationKeys b)) => Ord (BackendInvalidationKeysWrapper b)

deriving newtype instance (Show (BackendInvalidationKeys b)) => Show (BackendInvalidationKeysWrapper b)

deriving newtype instance (Semigroup (BackendInvalidationKeys b)) => Semigroup (BackendInvalidationKeysWrapper b)

deriving newtype instance (Monoid (BackendInvalidationKeys b)) => Monoid (BackendInvalidationKeysWrapper b)

instance Inc.Select (BackendInvalidationKeysWrapper b)

-- | 'InvalidationKeys' used to apply requested 'CacheInvalidations'.
data InvalidationKeys = InvalidationKeys
  { InvalidationKeys -> InvalidationKey
_ikMetadata :: Inc.InvalidationKey,
    InvalidationKeys -> HashMap RemoteSchemaName InvalidationKey
_ikRemoteSchemas :: HashMap RemoteSchemaName Inc.InvalidationKey,
    InvalidationKeys -> HashMap SourceName InvalidationKey
_ikSources :: HashMap SourceName Inc.InvalidationKey,
    InvalidationKeys -> BackendMap BackendInvalidationKeysWrapper
_ikBackends :: BackendMap BackendInvalidationKeysWrapper
  }
  deriving (Int -> InvalidationKeys -> ShowS
[InvalidationKeys] -> ShowS
InvalidationKeys -> String
(Int -> InvalidationKeys -> ShowS)
-> (InvalidationKeys -> String)
-> ([InvalidationKeys] -> ShowS)
-> Show InvalidationKeys
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidationKeys -> ShowS
showsPrec :: Int -> InvalidationKeys -> ShowS
$cshow :: InvalidationKeys -> String
show :: InvalidationKeys -> String
$cshowList :: [InvalidationKeys] -> ShowS
showList :: [InvalidationKeys] -> ShowS
Show, InvalidationKeys -> InvalidationKeys -> Bool
(InvalidationKeys -> InvalidationKeys -> Bool)
-> (InvalidationKeys -> InvalidationKeys -> Bool)
-> Eq InvalidationKeys
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidationKeys -> InvalidationKeys -> Bool
== :: InvalidationKeys -> InvalidationKeys -> Bool
$c/= :: InvalidationKeys -> InvalidationKeys -> Bool
/= :: InvalidationKeys -> InvalidationKeys -> Bool
Eq, (forall x. InvalidationKeys -> Rep InvalidationKeys x)
-> (forall x. Rep InvalidationKeys x -> InvalidationKeys)
-> Generic InvalidationKeys
forall x. Rep InvalidationKeys x -> InvalidationKeys
forall x. InvalidationKeys -> Rep InvalidationKeys x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InvalidationKeys -> Rep InvalidationKeys x
from :: forall x. InvalidationKeys -> Rep InvalidationKeys x
$cto :: forall x. Rep InvalidationKeys x -> InvalidationKeys
to :: forall x. Rep InvalidationKeys x -> InvalidationKeys
Generic)

instance Inc.Select InvalidationKeys

$(makeLenses ''InvalidationKeys)

initialInvalidationKeys :: InvalidationKeys
initialInvalidationKeys :: InvalidationKeys
initialInvalidationKeys = InvalidationKey
-> HashMap RemoteSchemaName InvalidationKey
-> HashMap SourceName InvalidationKey
-> BackendMap BackendInvalidationKeysWrapper
-> InvalidationKeys
InvalidationKeys InvalidationKey
Inc.initialInvalidationKey HashMap RemoteSchemaName InvalidationKey
forall a. Monoid a => a
mempty HashMap SourceName InvalidationKey
forall a. Monoid a => a
mempty BackendMap BackendInvalidationKeysWrapper
forall a. Monoid a => a
mempty

invalidateKeys :: CacheInvalidations -> InvalidationKeys -> InvalidationKeys
invalidateKeys :: CacheInvalidations -> InvalidationKeys -> InvalidationKeys
invalidateKeys CacheInvalidations {Bool
HashSet DataConnectorName
HashSet SourceName
HashSet RemoteSchemaName
ciMetadata :: Bool
ciRemoteSchemas :: HashSet RemoteSchemaName
ciSources :: HashSet SourceName
ciDataConnectors :: HashSet DataConnectorName
ciMetadata :: CacheInvalidations -> Bool
ciRemoteSchemas :: CacheInvalidations -> HashSet RemoteSchemaName
ciSources :: CacheInvalidations -> HashSet SourceName
ciDataConnectors :: CacheInvalidations -> HashSet DataConnectorName
..} InvalidationKeys {HashMap SourceName InvalidationKey
HashMap RemoteSchemaName InvalidationKey
InvalidationKey
BackendMap BackendInvalidationKeysWrapper
_ikMetadata :: InvalidationKeys -> InvalidationKey
_ikRemoteSchemas :: InvalidationKeys -> HashMap RemoteSchemaName InvalidationKey
_ikSources :: InvalidationKeys -> HashMap SourceName InvalidationKey
_ikBackends :: InvalidationKeys -> BackendMap BackendInvalidationKeysWrapper
_ikMetadata :: InvalidationKey
_ikRemoteSchemas :: HashMap RemoteSchemaName InvalidationKey
_ikSources :: HashMap SourceName InvalidationKey
_ikBackends :: BackendMap BackendInvalidationKeysWrapper
..} =
  InvalidationKeys
    { _ikMetadata :: InvalidationKey
_ikMetadata = if Bool
ciMetadata then InvalidationKey -> InvalidationKey
Inc.invalidate InvalidationKey
_ikMetadata else InvalidationKey
_ikMetadata,
      _ikRemoteSchemas :: HashMap RemoteSchemaName InvalidationKey
_ikRemoteSchemas = (HashMap RemoteSchemaName InvalidationKey
 -> RemoteSchemaName -> HashMap RemoteSchemaName InvalidationKey)
-> HashMap RemoteSchemaName InvalidationKey
-> HashSet RemoteSchemaName
-> HashMap RemoteSchemaName InvalidationKey
forall b a. (b -> a -> b) -> b -> HashSet a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((RemoteSchemaName
 -> HashMap RemoteSchemaName InvalidationKey
 -> HashMap RemoteSchemaName InvalidationKey)
-> HashMap RemoteSchemaName InvalidationKey
-> RemoteSchemaName
-> HashMap RemoteSchemaName InvalidationKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip RemoteSchemaName
-> HashMap RemoteSchemaName InvalidationKey
-> HashMap RemoteSchemaName InvalidationKey
forall a.
Hashable a =>
a -> HashMap a InvalidationKey -> HashMap a InvalidationKey
invalidate) HashMap RemoteSchemaName InvalidationKey
_ikRemoteSchemas HashSet RemoteSchemaName
ciRemoteSchemas,
      _ikSources :: HashMap SourceName InvalidationKey
_ikSources = (HashMap SourceName InvalidationKey
 -> SourceName -> HashMap SourceName InvalidationKey)
-> HashMap SourceName InvalidationKey
-> HashSet SourceName
-> HashMap SourceName InvalidationKey
forall b a. (b -> a -> b) -> b -> HashSet a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((SourceName
 -> HashMap SourceName InvalidationKey
 -> HashMap SourceName InvalidationKey)
-> HashMap SourceName InvalidationKey
-> SourceName
-> HashMap SourceName InvalidationKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip SourceName
-> HashMap SourceName InvalidationKey
-> HashMap SourceName InvalidationKey
forall a.
Hashable a =>
a -> HashMap a InvalidationKey -> HashMap a InvalidationKey
invalidate) HashMap SourceName InvalidationKey
_ikSources HashSet SourceName
ciSources,
      _ikBackends :: BackendMap BackendInvalidationKeysWrapper
_ikBackends = forall (b :: BackendType) (i :: BackendType -> *).
(HasTag b, Monoid (i b)) =>
(i b -> i b) -> BackendMap i -> BackendMap i
BackendMap.modify @'DataConnector BackendInvalidationKeysWrapper 'DataConnector
-> BackendInvalidationKeysWrapper 'DataConnector
invalidateDataConnectors BackendMap BackendInvalidationKeysWrapper
_ikBackends
    }
  where
    invalidate ::
      (Hashable a) =>
      a ->
      HashMap a Inc.InvalidationKey ->
      HashMap a Inc.InvalidationKey
    invalidate :: forall a.
Hashable a =>
a -> HashMap a InvalidationKey -> HashMap a InvalidationKey
invalidate = (Maybe InvalidationKey -> Maybe InvalidationKey)
-> a -> HashMap a InvalidationKey -> HashMap a InvalidationKey
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HashMap.alter ((Maybe InvalidationKey -> Maybe InvalidationKey)
 -> a -> HashMap a InvalidationKey -> HashMap a InvalidationKey)
-> (Maybe InvalidationKey -> Maybe InvalidationKey)
-> a
-> HashMap a InvalidationKey
-> HashMap a InvalidationKey
forall a b. (a -> b) -> a -> b
$ InvalidationKey -> Maybe InvalidationKey
forall a. a -> Maybe a
Just (InvalidationKey -> Maybe InvalidationKey)
-> (Maybe InvalidationKey -> InvalidationKey)
-> Maybe InvalidationKey
-> Maybe InvalidationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvalidationKey
-> (InvalidationKey -> InvalidationKey)
-> Maybe InvalidationKey
-> InvalidationKey
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InvalidationKey
Inc.initialInvalidationKey InvalidationKey -> InvalidationKey
Inc.invalidate

    invalidateDataConnectors :: BackendInvalidationKeysWrapper 'DataConnector -> BackendInvalidationKeysWrapper 'DataConnector
    invalidateDataConnectors :: BackendInvalidationKeysWrapper 'DataConnector
-> BackendInvalidationKeysWrapper 'DataConnector
invalidateDataConnectors (BackendInvalidationKeysWrapper BackendInvalidationKeys 'DataConnector
invalidationKeys) =
      BackendInvalidationKeys 'DataConnector
-> BackendInvalidationKeysWrapper 'DataConnector
forall (b :: BackendType).
BackendInvalidationKeys b -> BackendInvalidationKeysWrapper b
BackendInvalidationKeysWrapper (BackendInvalidationKeys 'DataConnector
 -> BackendInvalidationKeysWrapper 'DataConnector)
-> BackendInvalidationKeys 'DataConnector
-> BackendInvalidationKeysWrapper 'DataConnector
forall a b. (a -> b) -> a -> b
$ (HashMap DataConnectorName InvalidationKey
 -> DataConnectorName -> HashMap DataConnectorName InvalidationKey)
-> HashMap DataConnectorName InvalidationKey
-> HashSet DataConnectorName
-> HashMap DataConnectorName InvalidationKey
forall b a. (b -> a -> b) -> b -> HashSet a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((DataConnectorName
 -> HashMap DataConnectorName InvalidationKey
 -> HashMap DataConnectorName InvalidationKey)
-> HashMap DataConnectorName InvalidationKey
-> DataConnectorName
-> HashMap DataConnectorName InvalidationKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip DataConnectorName
-> HashMap DataConnectorName InvalidationKey
-> HashMap DataConnectorName InvalidationKey
forall a.
Hashable a =>
a -> HashMap a InvalidationKey -> HashMap a InvalidationKey
invalidate) HashMap DataConnectorName InvalidationKey
BackendInvalidationKeys 'DataConnector
invalidationKeys HashSet DataConnectorName
ciDataConnectors

data TableBuildInput b = TableBuildInput
  { forall (b :: BackendType). TableBuildInput b -> TableName b
_tbiName :: TableName b,
    forall (b :: BackendType). TableBuildInput b -> Bool
_tbiIsEnum :: Bool,
    forall (b :: BackendType). TableBuildInput b -> TableConfig b
_tbiConfiguration :: TableConfig b,
    forall (b :: BackendType).
TableBuildInput b -> Maybe ApolloFederationConfig
_tbiApolloFederationConfig :: Maybe ApolloFederationConfig,
    forall (b :: BackendType).
TableBuildInput b -> Maybe LogicalModelName
_tbiLogicalModel :: Maybe LogicalModelName
  }
  deriving (Int -> TableBuildInput b -> ShowS
[TableBuildInput b] -> ShowS
TableBuildInput b -> String
(Int -> TableBuildInput b -> ShowS)
-> (TableBuildInput b -> String)
-> ([TableBuildInput b] -> ShowS)
-> Show (TableBuildInput b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType).
Backend b =>
Int -> TableBuildInput b -> ShowS
forall (b :: BackendType).
Backend b =>
[TableBuildInput b] -> ShowS
forall (b :: BackendType). Backend b => TableBuildInput b -> String
$cshowsPrec :: forall (b :: BackendType).
Backend b =>
Int -> TableBuildInput b -> ShowS
showsPrec :: Int -> TableBuildInput b -> ShowS
$cshow :: forall (b :: BackendType). Backend b => TableBuildInput b -> String
show :: TableBuildInput b -> String
$cshowList :: forall (b :: BackendType).
Backend b =>
[TableBuildInput b] -> ShowS
showList :: [TableBuildInput b] -> ShowS
Show, TableBuildInput b -> TableBuildInput b -> Bool
(TableBuildInput b -> TableBuildInput b -> Bool)
-> (TableBuildInput b -> TableBuildInput b -> Bool)
-> Eq (TableBuildInput b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
TableBuildInput b -> TableBuildInput b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
TableBuildInput b -> TableBuildInput b -> Bool
== :: TableBuildInput b -> TableBuildInput b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
TableBuildInput b -> TableBuildInput b -> Bool
/= :: TableBuildInput b -> TableBuildInput b -> Bool
Eq, (forall x. TableBuildInput b -> Rep (TableBuildInput b) x)
-> (forall x. Rep (TableBuildInput b) x -> TableBuildInput b)
-> Generic (TableBuildInput b)
forall x. Rep (TableBuildInput b) x -> TableBuildInput b
forall x. TableBuildInput b -> Rep (TableBuildInput b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (TableBuildInput b) x -> TableBuildInput b
forall (b :: BackendType) x.
TableBuildInput b -> Rep (TableBuildInput b) x
$cfrom :: forall (b :: BackendType) x.
TableBuildInput b -> Rep (TableBuildInput b) x
from :: forall x. TableBuildInput b -> Rep (TableBuildInput b) x
$cto :: forall (b :: BackendType) x.
Rep (TableBuildInput b) x -> TableBuildInput b
to :: forall x. Rep (TableBuildInput b) x -> TableBuildInput b
Generic)

instance (Backend b) => NFData (TableBuildInput b)

data NonColumnTableInputs b = NonColumnTableInputs
  { forall (b :: BackendType). NonColumnTableInputs b -> TableName b
_nctiTable :: TableName b,
    forall (b :: BackendType). NonColumnTableInputs b -> [ObjRelDef b]
_nctiObjectRelationships :: [ObjRelDef b],
    forall (b :: BackendType). NonColumnTableInputs b -> [ArrRelDef b]
_nctiArrayRelationships :: [ArrRelDef b],
    forall (b :: BackendType).
NonColumnTableInputs b -> [ComputedFieldMetadata b]
_nctiComputedFields :: [ComputedFieldMetadata b],
    forall (b :: BackendType).
NonColumnTableInputs b -> [RemoteRelationship]
_nctiRemoteRelationships :: [RemoteRelationship]
  }
  deriving (Int -> NonColumnTableInputs b -> ShowS
[NonColumnTableInputs b] -> ShowS
NonColumnTableInputs b -> String
(Int -> NonColumnTableInputs b -> ShowS)
-> (NonColumnTableInputs b -> String)
-> ([NonColumnTableInputs b] -> ShowS)
-> Show (NonColumnTableInputs b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType).
Backend b =>
Int -> NonColumnTableInputs b -> ShowS
forall (b :: BackendType).
Backend b =>
[NonColumnTableInputs b] -> ShowS
forall (b :: BackendType).
Backend b =>
NonColumnTableInputs b -> String
$cshowsPrec :: forall (b :: BackendType).
Backend b =>
Int -> NonColumnTableInputs b -> ShowS
showsPrec :: Int -> NonColumnTableInputs b -> ShowS
$cshow :: forall (b :: BackendType).
Backend b =>
NonColumnTableInputs b -> String
show :: NonColumnTableInputs b -> String
$cshowList :: forall (b :: BackendType).
Backend b =>
[NonColumnTableInputs b] -> ShowS
showList :: [NonColumnTableInputs b] -> ShowS
Show, NonColumnTableInputs b -> NonColumnTableInputs b -> Bool
(NonColumnTableInputs b -> NonColumnTableInputs b -> Bool)
-> (NonColumnTableInputs b -> NonColumnTableInputs b -> Bool)
-> Eq (NonColumnTableInputs b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
NonColumnTableInputs b -> NonColumnTableInputs b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
NonColumnTableInputs b -> NonColumnTableInputs b -> Bool
== :: NonColumnTableInputs b -> NonColumnTableInputs b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
NonColumnTableInputs b -> NonColumnTableInputs b -> Bool
/= :: NonColumnTableInputs b -> NonColumnTableInputs b -> Bool
Eq, (forall x.
 NonColumnTableInputs b -> Rep (NonColumnTableInputs b) x)
-> (forall x.
    Rep (NonColumnTableInputs b) x -> NonColumnTableInputs b)
-> Generic (NonColumnTableInputs b)
forall x. Rep (NonColumnTableInputs b) x -> NonColumnTableInputs b
forall x. NonColumnTableInputs b -> Rep (NonColumnTableInputs b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (NonColumnTableInputs b) x -> NonColumnTableInputs b
forall (b :: BackendType) x.
NonColumnTableInputs b -> Rep (NonColumnTableInputs b) x
$cfrom :: forall (b :: BackendType) x.
NonColumnTableInputs b -> Rep (NonColumnTableInputs b) x
from :: forall x. NonColumnTableInputs b -> Rep (NonColumnTableInputs b) x
$cto :: forall (b :: BackendType) x.
Rep (NonColumnTableInputs b) x -> NonColumnTableInputs b
to :: forall x. Rep (NonColumnTableInputs b) x -> NonColumnTableInputs b
Generic)

data TablePermissionInputs b = TablePermissionInputs
  { forall (b :: BackendType). TablePermissionInputs b -> TableName b
_tpiTable :: TableName b,
    forall (b :: BackendType).
TablePermissionInputs b -> [InsPermDef b]
_tpiInsert :: [InsPermDef b],
    forall (b :: BackendType).
TablePermissionInputs b -> [SelPermDef b]
_tpiSelect :: [SelPermDef b],
    forall (b :: BackendType).
TablePermissionInputs b -> [UpdPermDef b]
_tpiUpdate :: [UpdPermDef b],
    forall (b :: BackendType).
TablePermissionInputs b -> [DelPermDef b]
_tpiDelete :: [DelPermDef b]
  }
  deriving ((forall x.
 TablePermissionInputs b -> Rep (TablePermissionInputs b) x)
-> (forall x.
    Rep (TablePermissionInputs b) x -> TablePermissionInputs b)
-> Generic (TablePermissionInputs b)
forall x.
Rep (TablePermissionInputs b) x -> TablePermissionInputs b
forall x.
TablePermissionInputs b -> Rep (TablePermissionInputs b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (TablePermissionInputs b) x -> TablePermissionInputs b
forall (b :: BackendType) x.
TablePermissionInputs b -> Rep (TablePermissionInputs b) x
$cfrom :: forall (b :: BackendType) x.
TablePermissionInputs b -> Rep (TablePermissionInputs b) x
from :: forall x.
TablePermissionInputs b -> Rep (TablePermissionInputs b) x
$cto :: forall (b :: BackendType) x.
Rep (TablePermissionInputs b) x -> TablePermissionInputs b
to :: forall x.
Rep (TablePermissionInputs b) x -> TablePermissionInputs b
Generic)

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

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

mkTableInputs ::
  TableMetadata b -> (TableBuildInput b, NonColumnTableInputs b, TablePermissionInputs b)
mkTableInputs :: forall (b :: BackendType).
TableMetadata b
-> (TableBuildInput b, NonColumnTableInputs b,
    TablePermissionInputs b)
mkTableInputs TableMetadata {Bool
Maybe ApolloFederationConfig
Maybe LogicalModelName
Permissions (UpdPermDef b)
Permissions (DelPermDef b)
Permissions (SelPermDef b)
Permissions (InsPermDef b)
RemoteRelationships
Relationships (ObjRelDef b)
Relationships (ArrRelDef b)
ComputedFields b
EventTriggers b
TableName b
TableConfig b
_tmTable :: TableName b
_tmIsEnum :: Bool
_tmConfiguration :: TableConfig b
_tmObjectRelationships :: Relationships (ObjRelDef b)
_tmArrayRelationships :: Relationships (ArrRelDef b)
_tmComputedFields :: ComputedFields b
_tmRemoteRelationships :: RemoteRelationships
_tmInsertPermissions :: Permissions (InsPermDef b)
_tmSelectPermissions :: Permissions (SelPermDef b)
_tmUpdatePermissions :: Permissions (UpdPermDef b)
_tmDeletePermissions :: Permissions (DelPermDef b)
_tmEventTriggers :: EventTriggers b
_tmApolloFederationConfig :: Maybe ApolloFederationConfig
_tmLogicalModel :: Maybe LogicalModelName
_tmTable :: forall (b :: BackendType). TableMetadata b -> TableName b
_tmIsEnum :: forall (b :: BackendType). TableMetadata b -> Bool
_tmConfiguration :: forall (b :: BackendType). TableMetadata b -> TableConfig b
_tmObjectRelationships :: forall (b :: BackendType).
TableMetadata b -> Relationships (ObjRelDef b)
_tmArrayRelationships :: forall (b :: BackendType).
TableMetadata b -> Relationships (ArrRelDef b)
_tmComputedFields :: forall (b :: BackendType). TableMetadata b -> ComputedFields b
_tmRemoteRelationships :: forall (b :: BackendType). TableMetadata b -> RemoteRelationships
_tmInsertPermissions :: forall (b :: BackendType).
TableMetadata b -> Permissions (InsPermDef b)
_tmSelectPermissions :: forall (b :: BackendType).
TableMetadata b -> Permissions (SelPermDef b)
_tmUpdatePermissions :: forall (b :: BackendType).
TableMetadata b -> Permissions (UpdPermDef b)
_tmDeletePermissions :: forall (b :: BackendType).
TableMetadata b -> Permissions (DelPermDef b)
_tmEventTriggers :: forall (b :: BackendType). TableMetadata b -> EventTriggers b
_tmApolloFederationConfig :: forall (b :: BackendType).
TableMetadata b -> Maybe ApolloFederationConfig
_tmLogicalModel :: forall (b :: BackendType).
TableMetadata b -> Maybe LogicalModelName
..} =
  (TableBuildInput b
buildInput, NonColumnTableInputs b
nonColumns, TablePermissionInputs b
permissions)
  where
    buildInput :: TableBuildInput b
buildInput = TableName b
-> Bool
-> TableConfig b
-> Maybe ApolloFederationConfig
-> Maybe LogicalModelName
-> TableBuildInput b
forall (b :: BackendType).
TableName b
-> Bool
-> TableConfig b
-> Maybe ApolloFederationConfig
-> Maybe LogicalModelName
-> TableBuildInput b
TableBuildInput TableName b
_tmTable Bool
_tmIsEnum TableConfig b
_tmConfiguration Maybe ApolloFederationConfig
_tmApolloFederationConfig Maybe LogicalModelName
_tmLogicalModel
    nonColumns :: NonColumnTableInputs b
nonColumns =
      TableName b
-> [ObjRelDef b]
-> [ArrRelDef b]
-> [ComputedFieldMetadata b]
-> [RemoteRelationship]
-> NonColumnTableInputs b
forall (b :: BackendType).
TableName b
-> [ObjRelDef b]
-> [ArrRelDef b]
-> [ComputedFieldMetadata b]
-> [RemoteRelationship]
-> NonColumnTableInputs b
NonColumnTableInputs
        TableName b
_tmTable
        (Relationships (ObjRelDef b) -> [ObjRelDef b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems Relationships (ObjRelDef b)
_tmObjectRelationships)
        (Relationships (ArrRelDef b) -> [ArrRelDef b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems Relationships (ArrRelDef b)
_tmArrayRelationships)
        (ComputedFields b -> [ComputedFieldMetadata b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems ComputedFields b
_tmComputedFields)
        (RemoteRelationships -> [RemoteRelationship]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems RemoteRelationships
_tmRemoteRelationships)
    permissions :: TablePermissionInputs b
permissions =
      TableName b
-> [InsPermDef b]
-> [SelPermDef b]
-> [UpdPermDef b]
-> [DelPermDef b]
-> TablePermissionInputs b
forall (b :: BackendType).
TableName b
-> [InsPermDef b]
-> [SelPermDef b]
-> [UpdPermDef b]
-> [DelPermDef b]
-> TablePermissionInputs b
TablePermissionInputs
        TableName b
_tmTable
        (Permissions (InsPermDef b) -> [InsPermDef b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems Permissions (InsPermDef b)
_tmInsertPermissions)
        (Permissions (SelPermDef b) -> [SelPermDef b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems Permissions (SelPermDef b)
_tmSelectPermissions)
        (Permissions (UpdPermDef b) -> [UpdPermDef b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems Permissions (UpdPermDef b)
_tmUpdatePermissions)
        (Permissions (DelPermDef b) -> [DelPermDef b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems Permissions (DelPermDef b)
_tmDeletePermissions)

-- | The direct output of 'buildSchemaCacheRule'. Contains most of the things necessary to build a
-- schema cache, but dependencies and inconsistent metadata objects are collected via a separate
-- 'MonadWriter' side channel.
--
-- See also Note [Avoiding GraphQL schema rebuilds when changing irrelevant Metadata]
data BuildOutputs = BuildOutputs
  { BuildOutputs -> SourceCache
_boSources :: SourceCache,
    BuildOutputs -> ActionCache
_boActions :: ActionCache,
    -- | We preserve the 'MetadataObject' from the original catalog metadata in the output so we can
    -- reuse it later if we need to mark the remote schema inconsistent during GraphQL schema
    -- generation (because of field conflicts).
    BuildOutputs
-> HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
_boRemoteSchemas :: HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject),
    BuildOutputs -> AnnotatedCustomTypes
_boCustomTypes :: AnnotatedCustomTypes,
    BuildOutputs -> HashMap RoleName Role
_boRoles :: HashMap RoleName Role,
    BuildOutputs -> BackendCache
_boBackendCache :: BackendCache
  }

$(makeLenses ''BuildOutputs)

-- | Parameters required for schema cache build
data CacheBuildParams = CacheBuildParams
  { CacheBuildParams -> Manager
_cbpManager :: HTTP.Manager,
    CacheBuildParams -> SourceResolver ('Postgres 'Vanilla)
_cbpPGSourceResolver :: SourceResolver ('Postgres 'Vanilla),
    CacheBuildParams -> SourceResolver 'MSSQL
_cbpMSSQLSourceResolver :: SourceResolver 'MSSQL,
    CacheBuildParams -> CacheStaticConfig
_cbpStaticConfig :: CacheStaticConfig
  }

-- | The monad in which @'RebuildableSchemaCache' is being run
newtype CacheBuild a = CacheBuild (ReaderT CacheBuildParams (ExceptT QErr IO) a)
  deriving newtype
    ( (forall a b. (a -> b) -> CacheBuild a -> CacheBuild b)
-> (forall a b. a -> CacheBuild b -> CacheBuild a)
-> Functor CacheBuild
forall a b. a -> CacheBuild b -> CacheBuild a
forall a b. (a -> b) -> CacheBuild a -> CacheBuild b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CacheBuild a -> CacheBuild b
fmap :: forall a b. (a -> b) -> CacheBuild a -> CacheBuild b
$c<$ :: forall a b. a -> CacheBuild b -> CacheBuild a
<$ :: forall a b. a -> CacheBuild b -> CacheBuild a
Functor,
      Functor CacheBuild
Functor CacheBuild
-> (forall a. a -> CacheBuild a)
-> (forall a b.
    CacheBuild (a -> b) -> CacheBuild a -> CacheBuild b)
-> (forall a b c.
    (a -> b -> c) -> CacheBuild a -> CacheBuild b -> CacheBuild c)
-> (forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b)
-> (forall a b. CacheBuild a -> CacheBuild b -> CacheBuild a)
-> Applicative CacheBuild
forall a. a -> CacheBuild a
forall a b. CacheBuild a -> CacheBuild b -> CacheBuild a
forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b
forall a b. CacheBuild (a -> b) -> CacheBuild a -> CacheBuild b
forall a b c.
(a -> b -> c) -> CacheBuild a -> CacheBuild b -> CacheBuild 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
$cpure :: forall a. a -> CacheBuild a
pure :: forall a. a -> CacheBuild a
$c<*> :: forall a b. CacheBuild (a -> b) -> CacheBuild a -> CacheBuild b
<*> :: forall a b. CacheBuild (a -> b) -> CacheBuild a -> CacheBuild b
$cliftA2 :: forall a b c.
(a -> b -> c) -> CacheBuild a -> CacheBuild b -> CacheBuild c
liftA2 :: forall a b c.
(a -> b -> c) -> CacheBuild a -> CacheBuild b -> CacheBuild c
$c*> :: forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b
*> :: forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b
$c<* :: forall a b. CacheBuild a -> CacheBuild b -> CacheBuild a
<* :: forall a b. CacheBuild a -> CacheBuild b -> CacheBuild a
Applicative,
      Applicative CacheBuild
Applicative CacheBuild
-> (forall a b.
    CacheBuild a -> (a -> CacheBuild b) -> CacheBuild b)
-> (forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b)
-> (forall a. a -> CacheBuild a)
-> Monad CacheBuild
forall a. a -> CacheBuild a
forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b
forall a b. CacheBuild a -> (a -> CacheBuild b) -> CacheBuild 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
$c>>= :: forall a b. CacheBuild a -> (a -> CacheBuild b) -> CacheBuild b
>>= :: forall a b. CacheBuild a -> (a -> CacheBuild b) -> CacheBuild b
$c>> :: forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b
>> :: forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b
$creturn :: forall a. a -> CacheBuild a
return :: forall a. a -> CacheBuild a
Monad,
      MonadError QErr,
      MonadReader CacheBuildParams,
      Monad CacheBuild
Monad CacheBuild
-> (forall a. IO a -> CacheBuild a) -> MonadIO CacheBuild
forall a. IO a -> CacheBuild a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> CacheBuild a
liftIO :: forall a. IO a -> CacheBuild a
MonadIO,
      MonadBase IO,
      MonadBaseControl IO
    )

instance HasCacheStaticConfig CacheBuild where
  askCacheStaticConfig :: CacheBuild CacheStaticConfig
askCacheStaticConfig = (CacheBuildParams -> CacheStaticConfig)
-> CacheBuild CacheStaticConfig
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheBuildParams -> CacheStaticConfig
_cbpStaticConfig

instance ProvidesNetwork CacheBuild where
  askHTTPManager :: CacheBuild Manager
askHTTPManager = (CacheBuildParams -> Manager) -> CacheBuild Manager
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheBuildParams -> Manager
_cbpManager

instance MonadResolveSource CacheBuild where
  getPGSourceResolver :: CacheBuild (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver = (CacheBuildParams
 -> Environment
 -> SourceName
 -> PostgresConnConfiguration
 -> IO (Either QErr PGSourceConfig))
-> CacheBuild
     (Environment
      -> SourceName
      -> PostgresConnConfiguration
      -> IO (Either QErr PGSourceConfig))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheBuildParams -> SourceResolver ('Postgres 'Vanilla)
CacheBuildParams
-> Environment
-> SourceName
-> PostgresConnConfiguration
-> IO (Either QErr PGSourceConfig)
_cbpPGSourceResolver
  getMSSQLSourceResolver :: CacheBuild (SourceResolver 'MSSQL)
getMSSQLSourceResolver = (CacheBuildParams
 -> Environment
 -> SourceName
 -> MSSQLConnConfiguration
 -> IO (Either QErr MSSQLSourceConfig))
-> CacheBuild
     (Environment
      -> SourceName
      -> MSSQLConnConfiguration
      -> IO (Either QErr MSSQLSourceConfig))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheBuildParams
-> Environment
-> SourceName
-> MSSQLConnConfiguration
-> IO (Either QErr MSSQLSourceConfig)
CacheBuildParams -> SourceResolver 'MSSQL
_cbpMSSQLSourceResolver

runCacheBuild ::
  ( MonadIO m,
    MonadError QErr m
  ) =>
  CacheBuildParams ->
  CacheBuild a ->
  m a
runCacheBuild :: forall (m :: * -> *) a.
(MonadIO m, MonadError QErr m) =>
CacheBuildParams -> CacheBuild a -> m a
runCacheBuild CacheBuildParams
params (CacheBuild ReaderT CacheBuildParams (ExceptT QErr IO) a
m) = do
  m (Either QErr a) -> m a
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr a) -> m a) -> m (Either QErr a) -> m a
forall a b. (a -> b) -> a -> b
$ IO (Either QErr a) -> m (Either QErr a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either QErr a) -> m (Either QErr a))
-> IO (Either QErr a) -> m (Either QErr a)
forall a b. (a -> b) -> a -> b
$ ExceptT QErr IO a -> IO (Either QErr a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReaderT CacheBuildParams (ExceptT QErr IO) a
-> CacheBuildParams -> ExceptT QErr IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT CacheBuildParams (ExceptT QErr IO) a
m CacheBuildParams
params)

runCacheBuildM ::
  ( MonadIO m,
    MonadError QErr m,
    MonadResolveSource m,
    ProvidesNetwork m,
    HasCacheStaticConfig m
  ) =>
  CacheBuild a ->
  m a
runCacheBuildM :: forall (m :: * -> *) a.
(MonadIO m, MonadError QErr m, MonadResolveSource m,
 ProvidesNetwork m, HasCacheStaticConfig m) =>
CacheBuild a -> m a
runCacheBuildM CacheBuild a
m = do
  CacheBuildParams
params <-
    Manager
-> SourceResolver ('Postgres 'Vanilla)
-> SourceResolver 'MSSQL
-> CacheStaticConfig
-> CacheBuildParams
Manager
-> (Environment
    -> SourceName
    -> PostgresConnConfiguration
    -> IO (Either QErr PGSourceConfig))
-> (Environment
    -> SourceName
    -> MSSQLConnConfiguration
    -> IO (Either QErr MSSQLSourceConfig))
-> CacheStaticConfig
-> CacheBuildParams
CacheBuildParams
      (Manager
 -> (Environment
     -> SourceName
     -> PostgresConnConfiguration
     -> IO (Either QErr PGSourceConfig))
 -> (Environment
     -> SourceName
     -> MSSQLConnConfiguration
     -> IO (Either QErr MSSQLSourceConfig))
 -> CacheStaticConfig
 -> CacheBuildParams)
-> m Manager
-> m ((Environment
       -> SourceName
       -> PostgresConnConfiguration
       -> IO (Either QErr PGSourceConfig))
      -> (Environment
          -> SourceName
          -> MSSQLConnConfiguration
          -> IO (Either QErr MSSQLSourceConfig))
      -> CacheStaticConfig
      -> CacheBuildParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Manager
forall (m :: * -> *). ProvidesNetwork m => m Manager
askHTTPManager
      m ((Environment
    -> SourceName
    -> PostgresConnConfiguration
    -> IO (Either QErr PGSourceConfig))
   -> (Environment
       -> SourceName
       -> MSSQLConnConfiguration
       -> IO (Either QErr MSSQLSourceConfig))
   -> CacheStaticConfig
   -> CacheBuildParams)
-> m (Environment
      -> SourceName
      -> PostgresConnConfiguration
      -> IO (Either QErr PGSourceConfig))
-> m ((Environment
       -> SourceName
       -> MSSQLConnConfiguration
       -> IO (Either QErr MSSQLSourceConfig))
      -> CacheStaticConfig -> CacheBuildParams)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (SourceResolver ('Postgres 'Vanilla))
m (Environment
   -> SourceName
   -> PostgresConnConfiguration
   -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver
      m ((Environment
    -> SourceName
    -> MSSQLConnConfiguration
    -> IO (Either QErr MSSQLSourceConfig))
   -> CacheStaticConfig -> CacheBuildParams)
-> m (Environment
      -> SourceName
      -> MSSQLConnConfiguration
      -> IO (Either QErr MSSQLSourceConfig))
-> m (CacheStaticConfig -> CacheBuildParams)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Environment
   -> SourceName
   -> MSSQLConnConfiguration
   -> IO (Either QErr MSSQLSourceConfig))
m (SourceResolver 'MSSQL)
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver 'MSSQL)
getMSSQLSourceResolver
      m (CacheStaticConfig -> CacheBuildParams)
-> m CacheStaticConfig -> m CacheBuildParams
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m CacheStaticConfig
forall (m :: * -> *). HasCacheStaticConfig m => m CacheStaticConfig
askCacheStaticConfig
  CacheBuildParams -> CacheBuild a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadError QErr m) =>
CacheBuildParams -> CacheBuild a -> m a
runCacheBuild CacheBuildParams
params CacheBuild a
m

-- | The status of collection of stored introspections of remote schemas and data sources.
data SourcesIntrospectionStatus
  = -- | A full introspection collection of all available remote schemas and data sources.
    SourcesIntrospectionChangedFull StoredIntrospection
  | -- | A partial introspection collection. Does not include all configured remote schemas and data sources, because they were not available.
    SourcesIntrospectionChangedPartial StoredIntrospection
  | -- | None of remote schemas or data sources introspection is refetched.
    SourcesIntrospectionUnchanged

data RebuildableSchemaCache = RebuildableSchemaCache
  { RebuildableSchemaCache -> SchemaCache
lastBuiltSchemaCache :: SchemaCache,
    RebuildableSchemaCache -> InvalidationKeys
_rscInvalidationMap :: InvalidationKeys,
    RebuildableSchemaCache
-> Rule
     (ReaderT BuildReason CacheBuild)
     (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
      Maybe StoredIntrospection)
     (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
_rscRebuild :: Inc.Rule (ReaderT BuildReason CacheBuild) (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys, Maybe StoredIntrospection) (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
  }

withRecordDependencies ::
  (ArrowWriter (Seq CollectItem) arr) =>
  WriterA (Seq SchemaDependency) arr (e, s) a ->
  arr (e, (MetadataObject, (SchemaObjId, s))) a
withRecordDependencies :: forall (arr :: * -> * -> *) e s a.
ArrowWriter (Seq CollectItem) arr =>
WriterA (Seq SchemaDependency) arr (e, s) a
-> arr (e, (MetadataObject, (SchemaObjId, s))) a
withRecordDependencies WriterA (Seq SchemaDependency) arr (e, s) a
f = proc (e
e, (MetadataObject
metadataObject, (SchemaObjId
schemaObjectId, s
s))) -> do
  (a
result, Seq SchemaDependency
dependencies) <- WriterA (Seq SchemaDependency) arr (e, s) a
-> arr (e, s) (a, Seq SchemaDependency)
forall w (arr :: * -> * -> *) a b.
(Monoid w, Arrow arr) =>
WriterA w arr a b -> arr a (b, w)
runWriterA WriterA (Seq SchemaDependency) arr (e, s) a
f -< (e
e, s
s)
  arr (MetadataObject, SchemaObjId, Seq SchemaDependency) ()
forall (arr :: * -> * -> *).
ArrowWriter (Seq CollectItem) arr =>
arr (MetadataObject, SchemaObjId, Seq SchemaDependency) ()
recordDependencies -< (MetadataObject
metadataObject, SchemaObjId
schemaObjectId, Seq SchemaDependency
dependencies)
  arr a a
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a
result
{-# INLINEABLE withRecordDependencies #-}

noDuplicates ::
  (MonadWriter (Seq CollectItem) m) =>
  (a -> MetadataObject) ->
  [a] ->
  m (Maybe a)
noDuplicates :: forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
(a -> MetadataObject) -> [a] -> m (Maybe a)
noDuplicates a -> MetadataObject
mkMetadataObject = \case
  [] -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  [a
value] -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
value
  values :: [a]
values@(a
value : [a]
_) -> do
    let objectId :: MetadataObjId
objectId = MetadataObject -> MetadataObjId
_moId (MetadataObject -> MetadataObjId)
-> MetadataObject -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ a -> MetadataObject
mkMetadataObject a
value
        definitions :: [Value]
definitions = (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (MetadataObject -> Value
_moDefinition (MetadataObject -> Value) -> (a -> MetadataObject) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MetadataObject
mkMetadataObject) [a]
values
    Seq CollectItem -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Seq CollectItem -> m ()) -> Seq CollectItem -> m ()
forall a b. (a -> b) -> a -> b
$ CollectItem -> Seq CollectItem
forall a. a -> Seq a
Seq.singleton (CollectItem -> Seq CollectItem) -> CollectItem -> Seq CollectItem
forall a b. (a -> b) -> a -> b
$ InconsistentMetadata -> CollectItem
CollectInconsistentMetadata (MetadataObjId -> [Value] -> InconsistentMetadata
DuplicateObjects MetadataObjId
objectId [Value]
definitions)
    Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- | Processes a list of catalog metadata into a map of processed information, marking any duplicate
-- entries inconsistent.
buildInfoMap ::
  ( ArrowChoice arr,
    Inc.ArrowDistribute arr,
    ArrowWriter (Seq CollectItem) arr,
    Hashable k
  ) =>
  (a -> k) ->
  (a -> MetadataObject) ->
  (e, a) `arr` Maybe b ->
  (e, [a]) `arr` HashMap k b
buildInfoMap :: forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectItem) arr, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k b)
buildInfoMap a -> k
extractKey a -> MetadataObject
mkMetadataObject arr (e, a) (Maybe b)
buildInfo = proc (e
e, [a]
infos) -> do
  let groupedInfos :: HashMap k [a]
groupedInfos = (a -> k) -> [a] -> HashMap k [a]
forall k (t :: * -> *) v.
(Hashable k, Foldable t) =>
(v -> k) -> t v -> HashMap k [v]
HashMap.groupOn a -> k
extractKey [a]
infos
  HashMap k (Maybe b)
infoMapMaybes <-
    (|
      arr (a, (k, ([a], ()))) (Maybe b)
-> arr (a, (HashMap k [a], ())) (HashMap k (Maybe b))
forall {a}.
arr (a, (k, ([a], ()))) (Maybe b)
-> arr (a, (HashMap k [a], ())) (HashMap k (Maybe b))
forall k e a s b.
Hashable k =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
        ( \k
_ [a]
duplicateInfos -> do
            Maybe a
infoMaybe <- arr (Writer (Seq CollectItem) (Maybe a)) (Maybe a)
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter -< (a -> MetadataObject) -> [a] -> Writer (Seq CollectItem) (Maybe a)
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
(a -> MetadataObject) -> [a] -> m (Maybe a)
noDuplicates a -> MetadataObject
mkMetadataObject [a]
duplicateInfos
            case Maybe a
infoMaybe of
              Maybe a
Nothing -> arr (Maybe b) (Maybe b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Maybe b
forall a. Maybe a
Nothing
              Just a
info -> arr (e, a) (Maybe b)
buildInfo -< (e
e, a
info)
        )
      |)
      HashMap k [a]
groupedInfos
  arr (HashMap k b) (HashMap k b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< HashMap k (Maybe b) -> HashMap k b
forall a. HashMap k (Maybe a) -> HashMap k a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap k (Maybe b)
infoMapMaybes
{-# INLINEABLE buildInfoMap #-}

buildInfoMapM ::
  ( MonadWriter (Seq CollectItem) m,
    Hashable k
  ) =>
  (a -> k) ->
  (a -> MetadataObject) ->
  (a -> m (Maybe b)) ->
  [a] ->
  m (HashMap k b)
buildInfoMapM :: forall (m :: * -> *) k a b.
(MonadWriter (Seq CollectItem) m, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> (a -> m (Maybe b))
-> [a]
-> m (HashMap k b)
buildInfoMapM a -> k
extractKey a -> MetadataObject
mkMetadataObject a -> m (Maybe b)
buildInfo [a]
infos = do
  let groupedInfos :: HashMap k [a]
groupedInfos = (a -> k) -> [a] -> HashMap k [a]
forall k (t :: * -> *) v.
(Hashable k, Foldable t) =>
(v -> k) -> t v -> HashMap k [v]
HashMap.groupOn a -> k
extractKey [a]
infos
  HashMap k (Maybe b)
infoMapMaybes <- HashMap k [a] -> ([a] -> m (Maybe b)) -> m (HashMap k (Maybe b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for HashMap k [a]
groupedInfos \[a]
duplicateInfos -> do
    Maybe a
infoMaybe <- (a -> MetadataObject) -> [a] -> m (Maybe a)
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
(a -> MetadataObject) -> [a] -> m (Maybe a)
noDuplicates a -> MetadataObject
mkMetadataObject [a]
duplicateInfos
    case Maybe a
infoMaybe of
      Maybe a
Nothing -> Maybe b -> m (Maybe b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
      Just a
info -> do
        a -> m (Maybe b)
buildInfo a
info
  HashMap k b -> m (HashMap k b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap k b -> m (HashMap k b)) -> HashMap k b -> m (HashMap k b)
forall a b. (a -> b) -> a -> b
$ HashMap k (Maybe b) -> HashMap k b
forall a. HashMap k (Maybe a) -> HashMap k a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap k (Maybe b)
infoMapMaybes

-- | Like 'buildInfoMap', but includes each processed info’s associated 'MetadataObject' in the result.
-- This is useful if the results will be further processed, and the 'MetadataObject' is still needed
-- to mark the object inconsistent.
buildInfoMapPreservingMetadata ::
  ( ArrowChoice arr,
    Inc.ArrowDistribute arr,
    ArrowWriter (Seq CollectItem) arr,
    Hashable k
  ) =>
  (a -> k) ->
  (a -> MetadataObject) ->
  (e, a) `arr` Maybe b ->
  (e, [a]) `arr` HashMap k (b, MetadataObject)
buildInfoMapPreservingMetadata :: forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectItem) arr, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k (b, MetadataObject))
buildInfoMapPreservingMetadata a -> k
extractKey a -> MetadataObject
mkMetadataObject arr (e, a) (Maybe b)
buildInfo =
  (a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe (b, MetadataObject))
-> arr (e, [a]) (HashMap k (b, MetadataObject))
forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectItem) arr, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k b)
buildInfoMap a -> k
extractKey a -> MetadataObject
mkMetadataObject arr (e, a) (Maybe (b, MetadataObject))
buildInfoPreserving
  where
    buildInfoPreserving :: arr (e, a) (Maybe (b, MetadataObject))
buildInfoPreserving = proc (e
e, a
info) -> do
      Maybe b
result <- arr (e, a) (Maybe b)
buildInfo -< (e
e, a
info)
      arr (Maybe (b, MetadataObject)) (Maybe (b, MetadataObject))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Maybe b
result Maybe b -> (b -> (b, MetadataObject)) -> Maybe (b, MetadataObject)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,a -> MetadataObject
mkMetadataObject a
info)
{-# INLINEABLE buildInfoMapPreservingMetadata #-}

buildInfoMapPreservingMetadataM ::
  ( MonadWriter (Seq CollectItem) m,
    Hashable k
  ) =>
  (a -> k) ->
  (a -> MetadataObject) ->
  (a -> m (Maybe b)) ->
  [a] ->
  m (HashMap k (b, MetadataObject))
buildInfoMapPreservingMetadataM :: forall (m :: * -> *) k a b.
(MonadWriter (Seq CollectItem) m, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> (a -> m (Maybe b))
-> [a]
-> m (HashMap k (b, MetadataObject))
buildInfoMapPreservingMetadataM a -> k
extractKey a -> MetadataObject
mkMetadataObject a -> m (Maybe b)
buildInfo =
  (a -> k)
-> (a -> MetadataObject)
-> (a -> m (Maybe (b, MetadataObject)))
-> [a]
-> m (HashMap k (b, MetadataObject))
forall (m :: * -> *) k a b.
(MonadWriter (Seq CollectItem) m, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> (a -> m (Maybe b))
-> [a]
-> m (HashMap k b)
buildInfoMapM a -> k
extractKey a -> MetadataObject
mkMetadataObject a -> m (Maybe (b, MetadataObject))
buildInfoPreserving
  where
    buildInfoPreserving :: a -> m (Maybe (b, MetadataObject))
buildInfoPreserving a
info = do
      Maybe b
result <- a -> m (Maybe b)
buildInfo a
info
      Maybe (b, MetadataObject) -> m (Maybe (b, MetadataObject))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (b, MetadataObject) -> m (Maybe (b, MetadataObject)))
-> Maybe (b, MetadataObject) -> m (Maybe (b, MetadataObject))
forall a b. (a -> b) -> a -> b
$ Maybe b
result Maybe b -> (b -> (b, MetadataObject)) -> Maybe (b, MetadataObject)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,a -> MetadataObject
mkMetadataObject a
info)

addTableContext :: (Backend b) => TableName b -> Text -> Text
addTableContext :: forall (b :: BackendType). Backend b => TableName b -> Text -> Text
addTableContext TableName b
tableName Text
e = Text
"in table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
tableName TableName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e

addLogicalModelContext :: LogicalModelName -> Text -> Text
addLogicalModelContext :: LogicalModelName -> Text -> Text
addLogicalModelContext LogicalModelName
logicalModelName Text
e = Text
"in logical model " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogicalModelName
logicalModelName LogicalModelName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e