{-# LANGUAGE Arrows #-}

module Hasura.RQL.DDL.Schema.Cache.Fields (addNonColumnFields) where

import Control.Arrow.Extended
import Control.Arrow.Interpret
import Control.Lens ((^.), _3, _4)
import Data.Aeson
import Data.Align (align)
import Data.HashMap.Strict.Extended qualified as M
import Data.HashSet qualified as HS
import Data.Sequence qualified as Seq
import Data.Text.Extended
import Data.These (These (..))
import Hasura.Base.Error
import Hasura.Incremental qualified as Inc
import Hasura.Prelude
import Hasura.RQL.DDL.ComputedField
import Hasura.RQL.DDL.Relationship
import Hasura.RQL.DDL.RemoteRelationship
import Hasura.RQL.DDL.Schema.Cache.Common
import Hasura.RQL.DDL.Schema.Function
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.Function
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.Relationships.Remote
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as AB
import Language.GraphQL.Draft.Syntax qualified as G

addNonColumnFields ::
  forall b arr m.
  ( ArrowChoice arr,
    Inc.ArrowDistribute arr,
    ArrowWriter (Seq CollectedInfo) arr,
    ArrowKleisli m arr,
    MonadError QErr m,
    BackendMetadata b
  ) =>
  ( HashMap SourceName (AB.AnyBackend PartiallyResolvedSource),
    SourceName,
    HashMap (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)),
    FieldInfoMap (ColumnInfo b),
    RemoteSchemaMap,
    DBFunctionsMetadata b,
    NonColumnTableInputs b
  )
    `arr` FieldInfoMap (FieldInfo b)
addNonColumnFields :: arr
  (HashMap SourceName (AnyBackend PartiallyResolvedSource),
   SourceName,
   HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)),
   FieldInfoMap (ColumnInfo b), RemoteSchemaMap,
   DBFunctionsMetadata b, NonColumnTableInputs b)
  (FieldInfoMap (FieldInfo b))
addNonColumnFields =
  proc
    ( HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources,
      SourceName
source,
      HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
rawTableInfo,
      FieldInfoMap (ColumnInfo b)
columns,
      RemoteSchemaMap
remoteSchemaMap,
      DBFunctionsMetadata b
pgFunctions,
      NonColumnTableInputs {[ObjRelDef b]
[ArrRelDef b]
[RemoteRelationship]
[ComputedFieldMetadata b]
TableName b
_nctiRemoteRelationships :: forall (b :: BackendType).
NonColumnTableInputs b -> [RemoteRelationship]
_nctiComputedFields :: forall (b :: BackendType).
NonColumnTableInputs b -> [ComputedFieldMetadata b]
_nctiArrayRelationships :: forall (b :: BackendType). NonColumnTableInputs b -> [ArrRelDef b]
_nctiObjectRelationships :: forall (b :: BackendType). NonColumnTableInputs b -> [ObjRelDef b]
_nctiTable :: forall (b :: BackendType). NonColumnTableInputs b -> TableName b
_nctiRemoteRelationships :: [RemoteRelationship]
_nctiComputedFields :: [ComputedFieldMetadata b]
_nctiArrayRelationships :: [ArrRelDef b]
_nctiObjectRelationships :: [ObjRelDef b]
_nctiTable :: TableName b
..}
      )
  -> do
    HashMap RelName (RelInfo b, MetadataObject)
objectRelationshipInfos <-
      ((SourceName, TableName b, ObjRelDef b) -> RelName)
-> ((SourceName, TableName b, ObjRelDef b) -> MetadataObject)
-> arr
     (HashMap (TableName b) (HashSet (ForeignKey b)),
      (SourceName, TableName b, ObjRelDef b))
     (Maybe (RelInfo b))
-> arr
     (HashMap (TableName b) (HashSet (ForeignKey b)),
      [(SourceName, TableName b, ObjRelDef b)])
     (HashMap RelName (RelInfo b, MetadataObject))
forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, Eq k, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k (b, MetadataObject))
buildInfoMapPreservingMetadata
        (ObjRelDef b -> RelName
forall a. RelDef a -> RelName
_rdName (ObjRelDef b -> RelName)
-> ((SourceName, TableName b, ObjRelDef b) -> ObjRelDef b)
-> (SourceName, TableName b, ObjRelDef b)
-> RelName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SourceName, TableName b, ObjRelDef b)
-> Getting
     (ObjRelDef b) (SourceName, TableName b, ObjRelDef b) (ObjRelDef b)
-> ObjRelDef b
forall s a. s -> Getting a s a -> a
^. Getting
  (ObjRelDef b) (SourceName, TableName b, ObjRelDef b) (ObjRelDef b)
forall s t a b. Field3 s t a b => Lens s t a b
_3))
        (\(SourceName
s, TableName b
t, ObjRelDef b
c) -> RelType -> (SourceName, TableName b, ObjRelDef b) -> MetadataObject
forall (b :: BackendType) a.
(ToJSON a, Backend b) =>
RelType -> (SourceName, TableName b, RelDef a) -> MetadataObject
mkRelationshipMetadataObject @b RelType
ObjRel (SourceName
s, TableName b
t, ObjRelDef b
c))
        arr
  (HashMap (TableName b) (HashSet (ForeignKey b)),
   (SourceName, TableName b, ObjRelDef b))
  (Maybe (RelInfo b))
forall (arr :: * -> * -> *) (b :: BackendType).
(ArrowChoice arr, ArrowWriter (Seq CollectedInfo) arr,
 Backend b) =>
arr
  (HashMap (TableName b) (HashSet (ForeignKey b)),
   (SourceName, TableName b, ObjRelDef b))
  (Maybe (RelInfo b))
buildObjectRelationship
        -<
          (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
-> HashSet (ForeignKey b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> HashSet (ForeignKey b)
_tciForeignKeys (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
 -> HashSet (ForeignKey b))
-> HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> HashMap (TableName b) (HashSet (ForeignKey b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
rawTableInfo, (ObjRelDef b -> (SourceName, TableName b, ObjRelDef b))
-> [ObjRelDef b] -> [(SourceName, TableName b, ObjRelDef b)]
forall a b. (a -> b) -> [a] -> [b]
map (SourceName
source,TableName b
_nctiTable,) [ObjRelDef b]
_nctiObjectRelationships)

    HashMap RelName (RelInfo b, MetadataObject)
arrayRelationshipInfos <-
      ((SourceName, TableName b, ArrRelDef b) -> RelName)
-> ((SourceName, TableName b, ArrRelDef b) -> MetadataObject)
-> arr
     (HashMap (TableName b) (HashSet (ForeignKey b)),
      (SourceName, TableName b, ArrRelDef b))
     (Maybe (RelInfo b))
-> arr
     (HashMap (TableName b) (HashSet (ForeignKey b)),
      [(SourceName, TableName b, ArrRelDef b)])
     (HashMap RelName (RelInfo b, MetadataObject))
forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, Eq k, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k (b, MetadataObject))
buildInfoMapPreservingMetadata
        (ArrRelDef b -> RelName
forall a. RelDef a -> RelName
_rdName (ArrRelDef b -> RelName)
-> ((SourceName, TableName b, ArrRelDef b) -> ArrRelDef b)
-> (SourceName, TableName b, ArrRelDef b)
-> RelName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SourceName, TableName b, ArrRelDef b)
-> Getting
     (ArrRelDef b) (SourceName, TableName b, ArrRelDef b) (ArrRelDef b)
-> ArrRelDef b
forall s a. s -> Getting a s a -> a
^. Getting
  (ArrRelDef b) (SourceName, TableName b, ArrRelDef b) (ArrRelDef b)
forall s t a b. Field3 s t a b => Lens s t a b
_3))
        (RelType -> (SourceName, TableName b, ArrRelDef b) -> MetadataObject
forall (b :: BackendType) a.
(ToJSON a, Backend b) =>
RelType -> (SourceName, TableName b, RelDef a) -> MetadataObject
mkRelationshipMetadataObject @b RelType
ArrRel)
        arr
  (HashMap (TableName b) (HashSet (ForeignKey b)),
   (SourceName, TableName b, ArrRelDef b))
  (Maybe (RelInfo b))
forall (arr :: * -> * -> *) (b :: BackendType).
(ArrowChoice arr, ArrowWriter (Seq CollectedInfo) arr,
 Backend b) =>
arr
  (HashMap (TableName b) (HashSet (ForeignKey b)),
   (SourceName, TableName b, ArrRelDef b))
  (Maybe (RelInfo b))
buildArrayRelationship
        -<
          (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
-> HashSet (ForeignKey b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> HashSet (ForeignKey b)
_tciForeignKeys (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
 -> HashSet (ForeignKey b))
-> HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> HashMap (TableName b) (HashSet (ForeignKey b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
rawTableInfo, (ArrRelDef b -> (SourceName, TableName b, ArrRelDef b))
-> [ArrRelDef b] -> [(SourceName, TableName b, ArrRelDef b)]
forall a b. (a -> b) -> [a] -> [b]
map (SourceName
source,TableName b
_nctiTable,) [ArrRelDef b]
_nctiArrayRelationships)

    let relationshipInfos :: HashMap RelName (RelInfo b, MetadataObject)
relationshipInfos = HashMap RelName (RelInfo b, MetadataObject)
objectRelationshipInfos HashMap RelName (RelInfo b, MetadataObject)
-> HashMap RelName (RelInfo b, MetadataObject)
-> HashMap RelName (RelInfo b, MetadataObject)
forall a. Semigroup a => a -> a -> a
<> HashMap RelName (RelInfo b, MetadataObject)
arrayRelationshipInfos

    HashMap ComputedFieldName (ComputedFieldInfo b, MetadataObject)
computedFieldInfos <-
      ((SourceName, DBFunctionsMetadata b, TableName b,
  ComputedFieldMetadata b)
 -> ComputedFieldName)
-> ((SourceName, DBFunctionsMetadata b, TableName b,
     ComputedFieldMetadata b)
    -> MetadataObject)
-> arr
     ((HashSet (TableName b), HashSet (Column b)),
      (SourceName, DBFunctionsMetadata b, TableName b,
       ComputedFieldMetadata b))
     (Maybe (ComputedFieldInfo b))
-> arr
     ((HashSet (TableName b), HashSet (Column b)),
      [(SourceName, DBFunctionsMetadata b, TableName b,
        ComputedFieldMetadata b)])
     (HashMap ComputedFieldName (ComputedFieldInfo b, MetadataObject))
forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, Eq k, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k (b, MetadataObject))
buildInfoMapPreservingMetadata
        (ComputedFieldMetadata b -> ComputedFieldName
forall (b :: BackendType).
ComputedFieldMetadata b -> ComputedFieldName
_cfmName (ComputedFieldMetadata b -> ComputedFieldName)
-> ((SourceName, DBFunctionsMetadata b, TableName b,
     ComputedFieldMetadata b)
    -> ComputedFieldMetadata b)
-> (SourceName, DBFunctionsMetadata b, TableName b,
    ComputedFieldMetadata b)
-> ComputedFieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SourceName, DBFunctionsMetadata b, TableName b,
 ComputedFieldMetadata b)
-> Getting
     (ComputedFieldMetadata b)
     (SourceName, DBFunctionsMetadata b, TableName b,
      ComputedFieldMetadata b)
     (ComputedFieldMetadata b)
-> ComputedFieldMetadata b
forall s a. s -> Getting a s a -> a
^. Getting
  (ComputedFieldMetadata b)
  (SourceName, DBFunctionsMetadata b, TableName b,
   ComputedFieldMetadata b)
  (ComputedFieldMetadata b)
forall s t a b. Field4 s t a b => Lens s t a b
_4))
        (\(SourceName
s, DBFunctionsMetadata b
_, TableName b
t, ComputedFieldMetadata b
c) -> (SourceName, TableName b, ComputedFieldMetadata b)
-> MetadataObject
forall (b :: BackendType).
Backend b =>
(SourceName, TableName b, ComputedFieldMetadata b)
-> MetadataObject
mkComputedFieldMetadataObject (SourceName
s, TableName b
t, ComputedFieldMetadata b
c))
        ( proc ((HashSet (TableName b)
a, HashSet (Column b)
b), (SourceName
c, DBFunctionsMetadata b
d, TableName b
e, ComputedFieldMetadata b
f)) -> do
            Either QErr (Maybe (ComputedFieldInfo b))
o <- arr
  (Writer
     (Seq CollectedInfo) (Either QErr (Maybe (ComputedFieldInfo b))))
  (Either QErr (Maybe (ComputedFieldInfo b)))
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter -< HashSet (TableName b)
-> HashSet (Column b)
-> SourceName
-> DBFunctionsMetadata b
-> TableName b
-> ComputedFieldMetadata b
-> Writer
     (Seq CollectedInfo) (Either QErr (Maybe (ComputedFieldInfo b)))
forall (b :: BackendType) (m :: * -> *).
(MonadWriter (Seq CollectedInfo) m, BackendMetadata b) =>
HashSet (TableName b)
-> HashSet (Column b)
-> SourceName
-> DBFunctionsMetadata b
-> TableName b
-> ComputedFieldMetadata b
-> m (Either QErr (Maybe (ComputedFieldInfo b)))
buildComputedField HashSet (TableName b)
a HashSet (Column b)
b SourceName
c DBFunctionsMetadata b
d TableName b
e ComputedFieldMetadata b
f
            (Either QErr (Maybe (ComputedFieldInfo b))
 -> m (Maybe (ComputedFieldInfo b)))
-> arr
     (Either QErr (Maybe (ComputedFieldInfo b)))
     (Maybe (ComputedFieldInfo b))
forall (m :: * -> *) (arr :: * -> * -> *) a b.
ArrowKleisli m arr =>
(a -> m b) -> arr a b
arrM Either QErr (Maybe (ComputedFieldInfo b))
-> m (Maybe (ComputedFieldInfo b))
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither -< Either QErr (Maybe (ComputedFieldInfo b))
o
        )
        -<
          ( ( [TableName b] -> HashSet (TableName b)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([TableName b] -> HashSet (TableName b))
-> [TableName b] -> HashSet (TableName b)
forall a b. (a -> b) -> a -> b
$ HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> [TableName b]
forall k v. HashMap k v -> [k]
M.keys HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
rawTableInfo,
              [Column b] -> HashSet (Column b)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([Column b] -> HashSet (Column b))
-> [Column b] -> HashSet (Column b)
forall a b. (a -> b) -> a -> b
$ (ColumnInfo b -> Column b) -> [ColumnInfo b] -> [Column b]
forall a b. (a -> b) -> [a] -> [b]
map ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ([ColumnInfo b] -> [Column b]) -> [ColumnInfo b] -> [Column b]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (ColumnInfo b) -> [ColumnInfo b]
forall k v. HashMap k v -> [v]
M.elems FieldInfoMap (ColumnInfo b)
columns
            ),
            (ComputedFieldMetadata b
 -> (SourceName, DBFunctionsMetadata b, TableName b,
     ComputedFieldMetadata b))
-> [ComputedFieldMetadata b]
-> [(SourceName, DBFunctionsMetadata b, TableName b,
     ComputedFieldMetadata b)]
forall a b. (a -> b) -> [a] -> [b]
map (SourceName
source,DBFunctionsMetadata b
pgFunctions,TableName b
_nctiTable,) [ComputedFieldMetadata b]
_nctiComputedFields
          )
    -- the fields that can be used for defining join conditions to other sources/remote schemas:
    -- 1. all columns
    -- 2. computed fields which don't expect arguments other than the table row and user session
    let lhsJoinFields :: HashMap FieldName (DBJoinField b)
lhsJoinFields =
          let columnFields :: HashMap FieldName (DBJoinField b)
columnFields = FieldInfoMap (ColumnInfo b)
columns FieldInfoMap (ColumnInfo b)
-> (ColumnInfo b -> DBJoinField b)
-> HashMap FieldName (DBJoinField b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ColumnInfo b
columnInfo -> Column b -> ColumnType b -> DBJoinField b
forall (b :: BackendType).
Column b -> ColumnType b -> DBJoinField b
JoinColumn (ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo b
columnInfo) (ColumnInfo b -> ColumnType b
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo b
columnInfo)
              computedFields :: HashMap FieldName (DBJoinField b)
computedFields = [(FieldName, DBJoinField b)] -> HashMap FieldName (DBJoinField b)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(FieldName, DBJoinField b)] -> HashMap FieldName (DBJoinField b))
-> [(FieldName, DBJoinField b)]
-> HashMap FieldName (DBJoinField b)
forall a b. (a -> b) -> a -> b
$
                (((ComputedFieldName, (ComputedFieldInfo b, MetadataObject))
  -> Maybe (FieldName, DBJoinField b))
 -> [(ComputedFieldName, (ComputedFieldInfo b, MetadataObject))]
 -> [(FieldName, DBJoinField b)])
-> [(ComputedFieldName, (ComputedFieldInfo b, MetadataObject))]
-> ((ComputedFieldName, (ComputedFieldInfo b, MetadataObject))
    -> Maybe (FieldName, DBJoinField b))
-> [(FieldName, DBJoinField b)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ComputedFieldName, (ComputedFieldInfo b, MetadataObject))
 -> Maybe (FieldName, DBJoinField b))
-> [(ComputedFieldName, (ComputedFieldInfo b, MetadataObject))]
-> [(FieldName, DBJoinField b)]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (HashMap ComputedFieldName (ComputedFieldInfo b, MetadataObject)
-> [(ComputedFieldName, (ComputedFieldInfo b, MetadataObject))]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap ComputedFieldName (ComputedFieldInfo b, MetadataObject)
computedFieldInfos) (((ComputedFieldName, (ComputedFieldInfo b, MetadataObject))
  -> Maybe (FieldName, DBJoinField b))
 -> [(FieldName, DBJoinField b)])
-> ((ComputedFieldName, (ComputedFieldInfo b, MetadataObject))
    -> Maybe (FieldName, DBJoinField b))
-> [(FieldName, DBJoinField b)]
forall a b. (a -> b) -> a -> b
$
                  \(ComputedFieldName
cfName, (ComputedFieldInfo {Maybe Text
ComputedFieldReturn b
XComputedField b
ComputedFieldFunction b
ComputedFieldName
_cfiDescription :: forall (b :: BackendType). ComputedFieldInfo b -> Maybe Text
_cfiReturnType :: forall (b :: BackendType).
ComputedFieldInfo b -> ComputedFieldReturn b
_cfiFunction :: forall (b :: BackendType).
ComputedFieldInfo b -> ComputedFieldFunction b
_cfiName :: forall (b :: BackendType). ComputedFieldInfo b -> ComputedFieldName
_cfiXComputedFieldInfo :: forall (b :: BackendType). ComputedFieldInfo b -> XComputedField b
_cfiDescription :: Maybe Text
_cfiReturnType :: ComputedFieldReturn b
_cfiFunction :: ComputedFieldFunction b
_cfiName :: ComputedFieldName
_cfiXComputedFieldInfo :: XComputedField b
..}, MetadataObject
_)) -> do
                    ScalarType b
scalarType <- case ComputedFieldReturn b -> ComputedFieldReturnType b
forall (b :: BackendType).
Backend b =>
ComputedFieldReturn b -> ComputedFieldReturnType b
computedFieldReturnType @b ComputedFieldReturn b
_cfiReturnType of
                      ReturnsScalar ScalarType b
ty -> ScalarType b -> Maybe (ScalarType b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType b
ty
                      ReturnsTable {} -> Maybe (ScalarType b)
forall a. Maybe a
Nothing
                      ReturnsOthers {} -> Maybe (ScalarType b)
forall a. Maybe a
Nothing
                    let ComputedFieldFunction {Maybe PGDescription
Seq (FunctionArgument b)
FunctionName b
ComputedFieldImplicitArguments b
_cffDescription :: forall (b :: BackendType).
ComputedFieldFunction b -> Maybe PGDescription
_cffComputedFieldImplicitArgs :: forall (b :: BackendType).
ComputedFieldFunction b -> ComputedFieldImplicitArguments b
_cffInputArgs :: forall (b :: BackendType).
ComputedFieldFunction b -> Seq (FunctionArgument b)
_cffName :: forall (b :: BackendType).
ComputedFieldFunction b -> FunctionName b
_cffDescription :: Maybe PGDescription
_cffComputedFieldImplicitArgs :: ComputedFieldImplicitArguments b
_cffInputArgs :: Seq (FunctionArgument b)
_cffName :: FunctionName b
..} = ComputedFieldFunction b
_cfiFunction
                    case Seq (FunctionArgument b) -> [FunctionArgument b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (FunctionArgument b)
_cffInputArgs of
                      [] ->
                        (FieldName, DBJoinField b) -> Maybe (FieldName, DBJoinField b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FieldName, DBJoinField b) -> Maybe (FieldName, DBJoinField b))
-> (FieldName, DBJoinField b) -> Maybe (FieldName, DBJoinField b)
forall a b. (a -> b) -> a -> b
$
                          (ComputedFieldName -> FieldName
fromComputedField ComputedFieldName
cfName,) (DBJoinField b -> (FieldName, DBJoinField b))
-> DBJoinField b -> (FieldName, DBJoinField b)
forall a b. (a -> b) -> a -> b
$
                            ScalarComputedField b -> DBJoinField b
forall (b :: BackendType). ScalarComputedField b -> DBJoinField b
JoinComputedField (ScalarComputedField b -> DBJoinField b)
-> ScalarComputedField b -> DBJoinField b
forall a b. (a -> b) -> a -> b
$
                              XComputedField b
-> ComputedFieldName
-> FunctionName b
-> ComputedFieldImplicitArguments b
-> ScalarType b
-> ScalarComputedField b
forall (b :: BackendType).
XComputedField b
-> ComputedFieldName
-> FunctionName b
-> ComputedFieldImplicitArguments b
-> ScalarType b
-> ScalarComputedField b
ScalarComputedField
                                XComputedField b
_cfiXComputedFieldInfo
                                ComputedFieldName
_cfiName
                                FunctionName b
_cffName
                                ComputedFieldImplicitArguments b
_cffComputedFieldImplicitArgs
                                ScalarType b
scalarType
                      [FunctionArgument b]
_ -> Maybe (FieldName, DBJoinField b)
forall a. Maybe a
Nothing
           in HashMap FieldName (DBJoinField b)
-> HashMap FieldName (DBJoinField b)
-> HashMap FieldName (DBJoinField b)
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
M.union HashMap FieldName (DBJoinField b)
columnFields HashMap FieldName (DBJoinField b)
computedFields

    HashMap RelName (RemoteFieldInfo (DBJoinField b), MetadataObject)
rawRemoteRelationshipInfos <-
      ((SourceName, TableName b, RemoteRelationship) -> RelName)
-> ((SourceName, TableName b, RemoteRelationship)
    -> MetadataObject)
-> arr
     ((HashMap SourceName (AnyBackend PartiallyResolvedSource),
       HashMap FieldName (DBJoinField b), RemoteSchemaMap),
      (SourceName, TableName b, RemoteRelationship))
     (Maybe (RemoteFieldInfo (DBJoinField b)))
-> arr
     ((HashMap SourceName (AnyBackend PartiallyResolvedSource),
       HashMap FieldName (DBJoinField b), RemoteSchemaMap),
      [(SourceName, TableName b, RemoteRelationship)])
     (HashMap RelName (RemoteFieldInfo (DBJoinField b), MetadataObject))
forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, Eq k, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k (b, MetadataObject))
buildInfoMapPreservingMetadata
        (RemoteRelationship -> RelName
_rrName (RemoteRelationship -> RelName)
-> ((SourceName, TableName b, RemoteRelationship)
    -> RemoteRelationship)
-> (SourceName, TableName b, RemoteRelationship)
-> RelName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SourceName, TableName b, RemoteRelationship)
-> Getting
     RemoteRelationship
     (SourceName, TableName b, RemoteRelationship)
     RemoteRelationship
-> RemoteRelationship
forall s a. s -> Getting a s a -> a
^. Getting
  RemoteRelationship
  (SourceName, TableName b, RemoteRelationship)
  RemoteRelationship
forall s t a b. Field3 s t a b => Lens s t a b
_3))
        (Backend b =>
(SourceName, TableName b, RemoteRelationship) -> MetadataObject
forall (b :: BackendType).
Backend b =>
(SourceName, TableName b, RemoteRelationship) -> MetadataObject
mkRemoteRelationshipMetadataObject @b)
        ( proc ((HashMap SourceName (AnyBackend PartiallyResolvedSource)
a, HashMap FieldName (DBJoinField b)
b, RemoteSchemaMap
c), (SourceName, TableName b, RemoteRelationship)
d) -> do
            Either QErr (Maybe (RemoteFieldInfo (DBJoinField b)))
o <- arr
  (Writer
     (Seq CollectedInfo)
     (Either QErr (Maybe (RemoteFieldInfo (DBJoinField b)))))
  (Either QErr (Maybe (RemoteFieldInfo (DBJoinField b))))
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter -< HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> HashMap FieldName (DBJoinField b)
-> RemoteSchemaMap
-> (SourceName, TableName b, RemoteRelationship)
-> Writer
     (Seq CollectedInfo)
     (Either QErr (Maybe (RemoteFieldInfo (DBJoinField b))))
forall (b :: BackendType) (m :: * -> *).
(MonadWriter (Seq CollectedInfo) m, BackendMetadata b) =>
HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> HashMap FieldName (DBJoinField b)
-> RemoteSchemaMap
-> (SourceName, TableName b, RemoteRelationship)
-> m (Either QErr (Maybe (RemoteFieldInfo (DBJoinField b))))
buildRemoteRelationship HashMap SourceName (AnyBackend PartiallyResolvedSource)
a HashMap FieldName (DBJoinField b)
b RemoteSchemaMap
c (SourceName, TableName b, RemoteRelationship)
d
            (Either QErr (Maybe (RemoteFieldInfo (DBJoinField b)))
 -> m (Maybe (RemoteFieldInfo (DBJoinField b))))
-> arr
     (Either QErr (Maybe (RemoteFieldInfo (DBJoinField b))))
     (Maybe (RemoteFieldInfo (DBJoinField b)))
forall (m :: * -> *) (arr :: * -> * -> *) a b.
ArrowKleisli m arr =>
(a -> m b) -> arr a b
arrM Either QErr (Maybe (RemoteFieldInfo (DBJoinField b)))
-> m (Maybe (RemoteFieldInfo (DBJoinField b)))
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither -< Either QErr (Maybe (RemoteFieldInfo (DBJoinField b)))
o
        )
        -<
          ((HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources, HashMap FieldName (DBJoinField b)
lhsJoinFields, RemoteSchemaMap
remoteSchemaMap), (RemoteRelationship
 -> (SourceName, TableName b, RemoteRelationship))
-> [RemoteRelationship]
-> [(SourceName, TableName b, RemoteRelationship)]
forall a b. (a -> b) -> [a] -> [b]
map (SourceName
source,TableName b
_nctiTable,) [RemoteRelationship]
_nctiRemoteRelationships)

    let relationshipFields :: HashMap FieldName (RelInfo b, MetadataObject)
relationshipFields = (RelName -> FieldName)
-> HashMap RelName (RelInfo b, MetadataObject)
-> HashMap FieldName (RelInfo b, MetadataObject)
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys RelName -> FieldName
fromRel HashMap RelName (RelInfo b, MetadataObject)
relationshipInfos
        computedFieldFields :: HashMap FieldName (ComputedFieldInfo b, MetadataObject)
computedFieldFields = (ComputedFieldName -> FieldName)
-> HashMap ComputedFieldName (ComputedFieldInfo b, MetadataObject)
-> HashMap FieldName (ComputedFieldInfo b, MetadataObject)
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys ComputedFieldName -> FieldName
fromComputedField HashMap ComputedFieldName (ComputedFieldInfo b, MetadataObject)
computedFieldInfos
        remoteRelationshipFields :: HashMap FieldName (RemoteFieldInfo (DBJoinField b), MetadataObject)
remoteRelationshipFields = (RelName -> FieldName)
-> HashMap
     RelName (RemoteFieldInfo (DBJoinField b), MetadataObject)
-> HashMap
     FieldName (RemoteFieldInfo (DBJoinField b), MetadataObject)
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys RelName -> FieldName
fromRemoteRelationship HashMap RelName (RemoteFieldInfo (DBJoinField b), MetadataObject)
rawRemoteRelationshipInfos

    -- First, check for conflicts between non-column fields, since we can raise a better error
    -- message in terms of the two metadata objects that define them.
    (HashMap FieldName (RelInfo b, MetadataObject)
-> HashMap FieldName (ComputedFieldInfo b, MetadataObject)
-> HashMap
     FieldName
     (These
        (RelInfo b, MetadataObject) (ComputedFieldInfo b, MetadataObject))
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align HashMap FieldName (RelInfo b, MetadataObject)
relationshipFields HashMap FieldName (ComputedFieldInfo b, MetadataObject)
computedFieldFields >- arr
  (HashMap
     FieldName
     (These
        (RelInfo b, MetadataObject) (ComputedFieldInfo b, MetadataObject)))
  (HashMap
     FieldName
     (These
        (RelInfo b, MetadataObject) (ComputedFieldInfo b, MetadataObject)))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA)
      forall a.
arr
  (a, ())
  (HashMap
     FieldName
     (These
        (RelInfo b, MetadataObject) (ComputedFieldInfo b, MetadataObject)))
-> arr
     (a,
      (HashMap
         FieldName
         (These
            (RelInfo b, MetadataObject) (ComputedFieldInfo b, MetadataObject)),
       ()))
     (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
-> arr
     (a, ()) (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> (| forall a.
arr
  (a,
   (FieldName,
    (These
       (RelInfo b, MetadataObject) (ComputedFieldInfo b, MetadataObject),
     ())))
  (Maybe (FieldInfo b, MetadataObject))
-> arr
     (a,
      (HashMap
         FieldName
         (These
            (RelInfo b, MetadataObject) (ComputedFieldInfo b, MetadataObject)),
       ()))
     (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed (\FieldName
fieldName These
  (RelInfo b, MetadataObject) (ComputedFieldInfo b, MetadataObject)
fields -> (FieldName
fieldName, These
  (RelInfo b, MetadataObject) (ComputedFieldInfo b, MetadataObject)
fields) >- (RelInfo b -> FieldInfo b)
-> (ComputedFieldInfo b -> FieldInfo b)
-> arr
     (FieldName,
      These
        (RelInfo b, MetadataObject) (ComputedFieldInfo b, MetadataObject))
     (Maybe (FieldInfo b, MetadataObject))
forall (t :: * -> * -> *) t t a t.
(ArrowWriter (Seq CollectedInfo) t, ToTxt t, ArrowChoice t) =>
(t -> a)
-> (t -> a)
-> t (t, These (t, MetadataObject) (t, MetadataObject))
     (Maybe (a, MetadataObject))
noFieldConflicts RelInfo b -> FieldInfo b
forall (b :: BackendType). RelInfo b -> FieldInfo b
FIRelationship ComputedFieldInfo b -> FieldInfo b
forall (b :: BackendType). ComputedFieldInfo b -> FieldInfo b
FIComputedField) |)
      -- Second, align with remote relationship fields
      forall a.
arr
  (a, ()) (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
-> arr
     (a, (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)), ()))
     (HashMap
        FieldName
        (These
           (FieldInfo b, MetadataObject)
           (RemoteFieldInfo (DBJoinField b), MetadataObject)))
-> arr
     (a, ())
     (HashMap
        FieldName
        (These
           (FieldInfo b, MetadataObject)
           (RemoteFieldInfo (DBJoinField b), MetadataObject)))
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> (\HashMap FieldName (Maybe (FieldInfo b, MetadataObject))
fields -> HashMap FieldName (FieldInfo b, MetadataObject)
-> HashMap
     FieldName (RemoteFieldInfo (DBJoinField b), MetadataObject)
-> HashMap
     FieldName
     (These
        (FieldInfo b, MetadataObject)
        (RemoteFieldInfo (DBJoinField b), MetadataObject))
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align (HashMap FieldName (Maybe (FieldInfo b, MetadataObject))
-> HashMap FieldName (FieldInfo b, MetadataObject)
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap FieldName (Maybe (FieldInfo b, MetadataObject))
fields) HashMap FieldName (RemoteFieldInfo (DBJoinField b), MetadataObject)
remoteRelationshipFields >- arr
  (HashMap
     FieldName
     (These
        (FieldInfo b, MetadataObject)
        (RemoteFieldInfo (DBJoinField b), MetadataObject)))
  (HashMap
     FieldName
     (These
        (FieldInfo b, MetadataObject)
        (RemoteFieldInfo (DBJoinField b), MetadataObject)))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA)
      forall a.
arr
  (a, ())
  (HashMap
     FieldName
     (These
        (FieldInfo b, MetadataObject)
        (RemoteFieldInfo (DBJoinField b), MetadataObject)))
-> arr
     (a,
      (HashMap
         FieldName
         (These
            (FieldInfo b, MetadataObject)
            (RemoteFieldInfo (DBJoinField b), MetadataObject)),
       ()))
     (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
-> arr
     (a, ()) (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> (| forall a.
arr
  (a,
   (FieldName,
    (These
       (FieldInfo b, MetadataObject)
       (RemoteFieldInfo (DBJoinField b), MetadataObject),
     ())))
  (Maybe (FieldInfo b, MetadataObject))
-> arr
     (a,
      (HashMap
         FieldName
         (These
            (FieldInfo b, MetadataObject)
            (RemoteFieldInfo (DBJoinField b), MetadataObject)),
       ()))
     (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed (\FieldName
fieldName These
  (FieldInfo b, MetadataObject)
  (RemoteFieldInfo (DBJoinField b), MetadataObject)
fields -> (FieldName
fieldName, These
  (FieldInfo b, MetadataObject)
  (RemoteFieldInfo (DBJoinField b), MetadataObject)
fields) >- (FieldInfo b -> FieldInfo b)
-> (RemoteFieldInfo (DBJoinField b) -> FieldInfo b)
-> arr
     (FieldName,
      These
        (FieldInfo b, MetadataObject)
        (RemoteFieldInfo (DBJoinField b), MetadataObject))
     (Maybe (FieldInfo b, MetadataObject))
forall (t :: * -> * -> *) t t a t.
(ArrowWriter (Seq CollectedInfo) t, ToTxt t, ArrowChoice t) =>
(t -> a)
-> (t -> a)
-> t (t, These (t, MetadataObject) (t, MetadataObject))
     (Maybe (a, MetadataObject))
noFieldConflicts FieldInfo b -> FieldInfo b
forall a. a -> a
id RemoteFieldInfo (DBJoinField b) -> FieldInfo b
forall (b :: BackendType).
RemoteFieldInfo (DBJoinField b) -> FieldInfo b
FIRemoteRelationship) |)
      -- Next, check for conflicts with custom field names. This is easiest to do before merging with
      -- the column info itself because we have access to the information separately, and custom field
      -- names are not currently stored as a separate map (but maybe should be!).
      forall a.
arr
  (a, ()) (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
-> arr
     (a, (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)), ()))
     (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
-> arr
     (a, ()) (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> (\HashMap FieldName (Maybe (FieldInfo b, MetadataObject))
fields -> (FieldInfoMap (ColumnInfo b)
columns, HashMap FieldName (Maybe (FieldInfo b, MetadataObject))
-> HashMap FieldName (FieldInfo b, MetadataObject)
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap FieldName (Maybe (FieldInfo b, MetadataObject))
fields) >- arr
  (FieldInfoMap (ColumnInfo b),
   HashMap FieldName (FieldInfo b, MetadataObject))
  (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
forall k (b :: BackendType).
arr
  (HashMap k (ColumnInfo b),
   HashMap FieldName (FieldInfo b, MetadataObject))
  (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
noCustomFieldConflicts)
      -- Finally, check for conflicts with the columns themselves.
      forall a.
arr
  (a, ()) (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
-> arr
     (a, (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)), ()))
     (HashMap
        FieldName (These (ColumnInfo b) (FieldInfo b, MetadataObject)))
-> arr
     (a, ())
     (HashMap
        FieldName (These (ColumnInfo b) (FieldInfo b, MetadataObject)))
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> (\HashMap FieldName (Maybe (FieldInfo b, MetadataObject))
fields -> FieldInfoMap (ColumnInfo b)
-> HashMap FieldName (FieldInfo b, MetadataObject)
-> HashMap
     FieldName (These (ColumnInfo b) (FieldInfo b, MetadataObject))
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align FieldInfoMap (ColumnInfo b)
columns (HashMap FieldName (Maybe (FieldInfo b, MetadataObject))
-> HashMap FieldName (FieldInfo b, MetadataObject)
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap FieldName (Maybe (FieldInfo b, MetadataObject))
fields) >- arr
  (HashMap
     FieldName (These (ColumnInfo b) (FieldInfo b, MetadataObject)))
  (HashMap
     FieldName (These (ColumnInfo b) (FieldInfo b, MetadataObject)))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA)
      forall a.
arr
  (a, ())
  (HashMap
     FieldName (These (ColumnInfo b) (FieldInfo b, MetadataObject)))
-> arr
     (a,
      (HashMap
         FieldName (These (ColumnInfo b) (FieldInfo b, MetadataObject)),
       ()))
     (FieldInfoMap (FieldInfo b))
-> arr (a, ()) (FieldInfoMap (FieldInfo b))
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> (| forall a.
arr
  (a,
   (FieldName,
    (These (ColumnInfo b) (FieldInfo b, MetadataObject), ())))
  (FieldInfo b)
-> arr
     (a,
      (HashMap
         FieldName (These (ColumnInfo b) (FieldInfo b, MetadataObject)),
       ()))
     (FieldInfoMap (FieldInfo b))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed (\FieldName
_ These (ColumnInfo b) (FieldInfo b, MetadataObject)
fields -> These (ColumnInfo b) (FieldInfo b, MetadataObject)
fields >- arr
  (These (ColumnInfo b) (FieldInfo b, MetadataObject)) (FieldInfo b)
forall (b :: BackendType).
arr
  (These (ColumnInfo b) (FieldInfo b, MetadataObject)) (FieldInfo b)
noColumnConflicts) |)
  where
    noFieldConflicts :: (t -> a)
-> (t -> a)
-> t (t, These (t, MetadataObject) (t, MetadataObject))
     (Maybe (a, MetadataObject))
noFieldConflicts t -> a
this t -> a
that = proc (t
fieldName, These (t, MetadataObject) (t, MetadataObject)
fields) -> case These (t, MetadataObject) (t, MetadataObject)
fields of
      This (t
thisField, MetadataObject
metadata) -> t (Maybe (a, MetadataObject)) (Maybe (a, MetadataObject))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a, MetadataObject) -> Maybe (a, MetadataObject)
forall a. a -> Maybe a
Just (t -> a
this t
thisField, MetadataObject
metadata)
      That (t
thatField, MetadataObject
metadata) -> t (Maybe (a, MetadataObject)) (Maybe (a, MetadataObject))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a, MetadataObject) -> Maybe (a, MetadataObject)
forall a. a -> Maybe a
Just (t -> a
that t
thatField, MetadataObject
metadata)
      These (t
_, MetadataObject
thisMetadata) (t
_, MetadataObject
thatMetadata) -> do
        t (Seq CollectedInfo) ()
forall w (arr :: * -> * -> *). ArrowWriter w arr => arr w ()
tellA
          -<
            CollectedInfo -> Seq CollectedInfo
forall a. a -> Seq a
Seq.singleton (CollectedInfo -> Seq CollectedInfo)
-> CollectedInfo -> Seq CollectedInfo
forall a b. (a -> b) -> a -> b
$
              InconsistentMetadata -> CollectedInfo
CIInconsistency (InconsistentMetadata -> CollectedInfo)
-> InconsistentMetadata -> CollectedInfo
forall a b. (a -> b) -> a -> b
$
                Text -> [MetadataObject] -> InconsistentMetadata
ConflictingObjects
                  (Text
"conflicting definitions for field " Text -> t -> Text
forall t. ToTxt t => Text -> t -> Text
<>> t
fieldName)
                  [MetadataObject
thisMetadata, MetadataObject
thatMetadata]
        t (Maybe (a, MetadataObject)) (Maybe (a, MetadataObject))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Maybe (a, MetadataObject)
forall a. Maybe a
Nothing

    noCustomFieldConflicts :: arr
  (HashMap k (ColumnInfo b),
   HashMap FieldName (FieldInfo b, MetadataObject))
  (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
noCustomFieldConflicts = proc (HashMap k (ColumnInfo b)
columns, HashMap FieldName (FieldInfo b, MetadataObject)
nonColumnFields) -> do
      let columnsByGQLName :: HashMap Name (ColumnInfo b)
columnsByGQLName = (ColumnInfo b -> Name)
-> [ColumnInfo b] -> HashMap Name (ColumnInfo b)
forall k a. (Eq k, Hashable k) => (a -> k) -> [a] -> HashMap k a
mapFromL ColumnInfo b -> Name
forall (b :: BackendType). ColumnInfo b -> Name
ciName ([ColumnInfo b] -> HashMap Name (ColumnInfo b))
-> [ColumnInfo b] -> HashMap Name (ColumnInfo b)
forall a b. (a -> b) -> a -> b
$ HashMap k (ColumnInfo b) -> [ColumnInfo b]
forall k v. HashMap k v -> [v]
M.elems HashMap k (ColumnInfo b)
columns
      (|
        forall a.
arr
  (a, (FieldName, ((FieldInfo b, MetadataObject), ())))
  (Maybe (FieldInfo b, MetadataObject))
-> arr
     (a, (HashMap FieldName (FieldInfo b, MetadataObject), ()))
     (HashMap FieldName (Maybe (FieldInfo b, MetadataObject)))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
          ( \FieldName
_ (FieldInfo b
fieldInfo, MetadataObject
metadata) ->
              (|
                forall a.
ErrorA QErr arr (a, ()) (FieldInfo b, MetadataObject)
-> arr
     (a, (MetadataObject, ())) (Maybe (FieldInfo b, MetadataObject))
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
                  ( do
                      (|
                        forall a.
ErrorA QErr arr (a, (Name, ())) ()
-> ErrorA QErr arr (a, ([Name], ())) ()
forall (arr :: * -> * -> *) (t :: * -> *) e a s b.
(ArrowChoice arr, Foldable t) =>
arr (e, (a, s)) b -> arr (e, (t a, s)) ()
traverseA_
                          ( \Name
fieldGQLName -> case Name -> HashMap Name (ColumnInfo b) -> Maybe (ColumnInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Name
fieldGQLName HashMap Name (ColumnInfo b)
columnsByGQLName of
                              -- Only raise an error if the GQL name isn’t the same as the Postgres column name.
                              -- If they are the same, `noColumnConflicts` will catch it, and it will produce a
                              -- more useful error message.
                              Just ColumnInfo b
columnInfo
                                | Column b -> Text
forall a. ToTxt a => a -> Text
toTxt (ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo b
columnInfo) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Name -> Text
G.unName Name
fieldGQLName ->
                                  ErrorA QErr arr QErr ()
forall e (arr :: * -> * -> *) a. ArrowError e arr => arr e a
throwA
                                    -<
                                      Code -> Text -> QErr
err400 Code
AlreadyExists (Text -> QErr) -> Text -> QErr
forall a b. (a -> b) -> a -> b
$
                                        Text
"field definition conflicts with custom field name for postgres column "
                                          Text -> Column b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo b
columnInfo
                              Maybe (ColumnInfo b)
_ -> ErrorA QErr arr () ()
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ()
                          )
                        |) (FieldInfo b -> [Name]
forall (b :: BackendType). FieldInfo b -> [Name]
fieldInfoGraphQLNames FieldInfo b
fieldInfo)
                      ErrorA
  QErr
  arr
  (FieldInfo b, MetadataObject)
  (FieldInfo b, MetadataObject)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (FieldInfo b
fieldInfo, MetadataObject
metadata)
                  )
              |) MetadataObject
metadata
          )
        |) HashMap FieldName (FieldInfo b, MetadataObject)
nonColumnFields

    noColumnConflicts :: arr
  (These (ColumnInfo b) (FieldInfo b, MetadataObject)) (FieldInfo b)
noColumnConflicts = proc These (ColumnInfo b) (FieldInfo b, MetadataObject)
fields -> case These (ColumnInfo b) (FieldInfo b, MetadataObject)
fields of
      This ColumnInfo b
columnInfo -> arr (FieldInfo b) (FieldInfo b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ColumnInfo b -> FieldInfo b
forall (b :: BackendType). ColumnInfo b -> FieldInfo b
FIColumn ColumnInfo b
columnInfo
      That (FieldInfo b
fieldInfo, MetadataObject
_) -> arr (FieldInfo b) (FieldInfo b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< FieldInfo b
fieldInfo
      These ColumnInfo b
columnInfo (FieldInfo b
_, MetadataObject
fieldMetadata) -> do
        arr ((Maybe Value, MetadataObject), Text) ()
forall w (arr :: * -> * -> *).
(ArrowWriter (Seq w) arr, AsInconsistentMetadata w) =>
arr ((Maybe Value, MetadataObject), Text) ()
recordInconsistency -< ((Maybe Value
forall a. Maybe a
Nothing, MetadataObject
fieldMetadata), Text
"field definition conflicts with postgres column")
        arr (FieldInfo b) (FieldInfo b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ColumnInfo b -> FieldInfo b
forall (b :: BackendType). ColumnInfo b -> FieldInfo b
FIColumn ColumnInfo b
columnInfo

mkRelationshipMetadataObject ::
  forall b a.
  (ToJSON a, Backend b) =>
  RelType ->
  (SourceName, TableName b, RelDef a) ->
  MetadataObject
mkRelationshipMetadataObject :: RelType -> (SourceName, TableName b, RelDef a) -> MetadataObject
mkRelationshipMetadataObject RelType
relType (SourceName
source, TableName b
table, RelDef a
relDef) =
  let objectId :: MetadataObjId
objectId =
        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
$
            TableName b -> TableMetadataObjId -> SourceMetadataObjId b
forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
table (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$
              RelName -> RelType -> TableMetadataObjId
MTORel (RelDef a -> RelName
forall a. RelDef a -> RelName
_rdName RelDef a
relDef) RelType
relType
   in MetadataObjId -> Value -> MetadataObject
MetadataObject MetadataObjId
objectId (Value -> MetadataObject) -> Value -> MetadataObject
forall a b. (a -> b) -> a -> b
$ WithTable b (RelDef a) -> Value
forall a. ToJSON a => a -> Value
toJSON (WithTable b (RelDef a) -> Value)
-> WithTable b (RelDef a) -> Value
forall a b. (a -> b) -> a -> b
$ SourceName -> TableName b -> RelDef a -> WithTable b (RelDef a)
forall (b :: BackendType) a.
SourceName -> TableName b -> a -> WithTable b a
WithTable @b SourceName
source TableName b
table RelDef a
relDef

buildObjectRelationship ::
  ( ArrowChoice arr,
    ArrowWriter (Seq CollectedInfo) arr,
    Backend b
  ) =>
  ( HashMap (TableName b) (HashSet (ForeignKey b)),
    ( SourceName,
      TableName b,
      ObjRelDef b
    )
  )
    `arr` Maybe (RelInfo b)
buildObjectRelationship :: arr
  (HashMap (TableName b) (HashSet (ForeignKey b)),
   (SourceName, TableName b, ObjRelDef b))
  (Maybe (RelInfo b))
buildObjectRelationship = proc (HashMap (TableName b) (HashSet (ForeignKey b))
fkeysMap, (SourceName
source, TableName b
table, ObjRelDef b
relDef)) -> do
  let buildRelInfo :: ObjRelDef b -> Either QErr (RelInfo b, [SchemaDependency])
buildRelInfo ObjRelDef b
def = SourceName
-> TableName b
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> ObjRelDef b
-> Either QErr (RelInfo b, [SchemaDependency])
forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
SourceName
-> TableName b
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> RelDef (ObjRelUsing b)
-> m (RelInfo b, [SchemaDependency])
objRelP2Setup SourceName
source TableName b
table HashMap (TableName b) (HashSet (ForeignKey b))
fkeysMap ObjRelDef b
def
  arr
  (Writer (Seq CollectedInfo) (Maybe (RelInfo b)))
  (Maybe (RelInfo b))
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter -< SourceName
-> TableName b
-> (ObjRelDef b -> Either QErr (RelInfo b, [SchemaDependency]))
-> RelType
-> ObjRelDef b
-> Writer (Seq CollectedInfo) (Maybe (RelInfo b))
forall (m :: * -> *) (b :: BackendType) a.
(MonadWriter (Seq CollectedInfo) m, ToJSON a, Backend b) =>
SourceName
-> TableName b
-> (RelDef a -> Either QErr (RelInfo b, [SchemaDependency]))
-> RelType
-> RelDef a
-> m (Maybe (RelInfo b))
buildRelationship SourceName
source TableName b
table ObjRelDef b -> Either QErr (RelInfo b, [SchemaDependency])
buildRelInfo RelType
ObjRel ObjRelDef b
relDef

buildArrayRelationship ::
  ( ArrowChoice arr,
    ArrowWriter (Seq CollectedInfo) arr,
    Backend b
  ) =>
  ( HashMap (TableName b) (HashSet (ForeignKey b)),
    ( SourceName,
      TableName b,
      ArrRelDef b
    )
  )
    `arr` Maybe (RelInfo b)
buildArrayRelationship :: arr
  (HashMap (TableName b) (HashSet (ForeignKey b)),
   (SourceName, TableName b, ArrRelDef b))
  (Maybe (RelInfo b))
buildArrayRelationship = proc (HashMap (TableName b) (HashSet (ForeignKey b))
fkeysMap, (SourceName
source, TableName b
table, ArrRelDef b
relDef)) -> do
  let buildRelInfo :: ArrRelDef b -> Either QErr (RelInfo b, [SchemaDependency])
buildRelInfo ArrRelDef b
def = HashMap (TableName b) (HashSet (ForeignKey b))
-> SourceName
-> TableName b
-> ArrRelDef b
-> Either QErr (RelInfo b, [SchemaDependency])
forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
HashMap (TableName b) (HashSet (ForeignKey b))
-> SourceName
-> TableName b
-> ArrRelDef b
-> m (RelInfo b, [SchemaDependency])
arrRelP2Setup HashMap (TableName b) (HashSet (ForeignKey b))
fkeysMap SourceName
source TableName b
table ArrRelDef b
def
  arr
  (Writer (Seq CollectedInfo) (Maybe (RelInfo b)))
  (Maybe (RelInfo b))
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter -< SourceName
-> TableName b
-> (ArrRelDef b -> Either QErr (RelInfo b, [SchemaDependency]))
-> RelType
-> ArrRelDef b
-> Writer (Seq CollectedInfo) (Maybe (RelInfo b))
forall (m :: * -> *) (b :: BackendType) a.
(MonadWriter (Seq CollectedInfo) m, ToJSON a, Backend b) =>
SourceName
-> TableName b
-> (RelDef a -> Either QErr (RelInfo b, [SchemaDependency]))
-> RelType
-> RelDef a
-> m (Maybe (RelInfo b))
buildRelationship SourceName
source TableName b
table ArrRelDef b -> Either QErr (RelInfo b, [SchemaDependency])
buildRelInfo RelType
ArrRel ArrRelDef b
relDef

buildRelationship ::
  forall m b a.
  ( MonadWriter (Seq CollectedInfo) m,
    ToJSON a,
    Backend b
  ) =>
  SourceName ->
  TableName b ->
  (RelDef a -> Either QErr (RelInfo b, [SchemaDependency])) ->
  RelType ->
  RelDef a ->
  m (Maybe (RelInfo b))
buildRelationship :: SourceName
-> TableName b
-> (RelDef a -> Either QErr (RelInfo b, [SchemaDependency]))
-> RelType
-> RelDef a
-> m (Maybe (RelInfo b))
buildRelationship SourceName
source TableName b
table RelDef a -> Either QErr (RelInfo b, [SchemaDependency])
buildRelInfo RelType
relType RelDef a
relDef = do
  let relName :: RelName
relName = RelDef a -> RelName
forall a. RelDef a -> RelName
_rdName RelDef a
relDef
      metadataObject :: MetadataObject
metadataObject = RelType -> (SourceName, TableName b, RelDef a) -> MetadataObject
forall (b :: BackendType) a.
(ToJSON a, Backend b) =>
RelType -> (SourceName, TableName b, RelDef a) -> MetadataObject
mkRelationshipMetadataObject @b RelType
relType (SourceName
source, TableName b
table, RelDef a
relDef)
      schemaObject :: SchemaObjId
schemaObject =
        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
$
            TableName b -> TableObjId b -> SourceObjId b
forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
table (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
relName
      addRelationshipContext :: Text -> Text
addRelationshipContext Text
e = Text
"in relationship " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName
relName RelName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
  MetadataObject
-> ExceptT QErr m (RelInfo b) -> m (Maybe (RelInfo b))
forall w (m :: * -> *) a.
(MonadWriter (Seq w) m, AsInconsistentMetadata w) =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM MetadataObject
metadataObject (ExceptT QErr m (RelInfo b) -> m (Maybe (RelInfo b)))
-> ExceptT QErr m (RelInfo b) -> m (Maybe (RelInfo b))
forall a b. (a -> b) -> a -> b
$ do
    (Text -> Text)
-> ExceptT QErr m (RelInfo b) -> ExceptT QErr m (RelInfo b)
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr (TableName b -> Text -> Text
forall (b :: BackendType). Backend b => TableName b -> Text -> Text
addTableContext @b TableName b
table (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addRelationshipContext) (ExceptT QErr m (RelInfo b) -> ExceptT QErr m (RelInfo b))
-> ExceptT QErr m (RelInfo b) -> ExceptT QErr m (RelInfo b)
forall a b. (a -> b) -> a -> b
$ do
      (RelInfo b
info, [SchemaDependency]
dependencies) <- Either QErr (RelInfo b, [SchemaDependency])
-> ExceptT QErr m (RelInfo b, [SchemaDependency])
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either QErr (RelInfo b, [SchemaDependency])
 -> ExceptT QErr m (RelInfo b, [SchemaDependency]))
-> Either QErr (RelInfo b, [SchemaDependency])
-> ExceptT QErr m (RelInfo b, [SchemaDependency])
forall a b. (a -> b) -> a -> b
$ RelDef a -> Either QErr (RelInfo b, [SchemaDependency])
buildRelInfo RelDef a
relDef
      MetadataObject
-> SchemaObjId -> [SchemaDependency] -> ExceptT QErr m ()
forall (m :: * -> *).
MonadWriter (Seq CollectedInfo) m =>
MetadataObject -> SchemaObjId -> [SchemaDependency] -> m ()
recordDependenciesM MetadataObject
metadataObject SchemaObjId
schemaObject [SchemaDependency]
dependencies
      RelInfo b -> ExceptT QErr m (RelInfo b)
forall (m :: * -> *) a. Monad m => a -> m a
return RelInfo b
info

mkComputedFieldMetadataObject ::
  forall b.
  (Backend b) =>
  (SourceName, TableName b, ComputedFieldMetadata b) ->
  MetadataObject
mkComputedFieldMetadataObject :: (SourceName, TableName b, ComputedFieldMetadata b)
-> MetadataObject
mkComputedFieldMetadataObject (SourceName
source, TableName b
table, ComputedFieldMetadata {Comment
ComputedFieldDefinition b
ComputedFieldName
_cfmComment :: forall (b :: BackendType). ComputedFieldMetadata b -> Comment
_cfmDefinition :: forall (b :: BackendType).
ComputedFieldMetadata b -> ComputedFieldDefinition b
_cfmComment :: Comment
_cfmDefinition :: ComputedFieldDefinition b
_cfmName :: ComputedFieldName
_cfmName :: forall (b :: BackendType).
ComputedFieldMetadata b -> ComputedFieldName
..}) =
  let objectId :: MetadataObjId
objectId =
        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
$
            TableName b -> TableMetadataObjId -> SourceMetadataObjId b
forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
table (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$
              ComputedFieldName -> TableMetadataObjId
MTOComputedField ComputedFieldName
_cfmName
      definition :: AddComputedField b
definition = SourceName
-> TableName b
-> ComputedFieldName
-> ComputedFieldDefinition b
-> Comment
-> AddComputedField b
forall (b :: BackendType).
SourceName
-> TableName b
-> ComputedFieldName
-> ComputedFieldDefinition b
-> Comment
-> AddComputedField b
AddComputedField @b SourceName
source TableName b
table ComputedFieldName
_cfmName ComputedFieldDefinition b
_cfmDefinition Comment
_cfmComment
   in MetadataObjId -> Value -> MetadataObject
MetadataObject MetadataObjId
objectId (AddComputedField b -> Value
forall a. ToJSON a => a -> Value
toJSON AddComputedField b
definition)

buildComputedField ::
  forall b m.
  ( MonadWriter (Seq CollectedInfo) m,
    BackendMetadata b
  ) =>
  HashSet (TableName b) ->
  HashSet (Column b) ->
  SourceName ->
  DBFunctionsMetadata b ->
  TableName b ->
  ComputedFieldMetadata b ->
  m (Either QErr (Maybe (ComputedFieldInfo b)))
buildComputedField :: HashSet (TableName b)
-> HashSet (Column b)
-> SourceName
-> DBFunctionsMetadata b
-> TableName b
-> ComputedFieldMetadata b
-> m (Either QErr (Maybe (ComputedFieldInfo b)))
buildComputedField HashSet (TableName b)
trackedTableNames HashSet (Column b)
tableColumns SourceName
source DBFunctionsMetadata b
pgFunctions TableName b
table cf :: ComputedFieldMetadata b
cf@ComputedFieldMetadata {Comment
ComputedFieldDefinition b
ComputedFieldName
_cfmComment :: Comment
_cfmDefinition :: ComputedFieldDefinition b
_cfmName :: ComputedFieldName
_cfmComment :: forall (b :: BackendType). ComputedFieldMetadata b -> Comment
_cfmDefinition :: forall (b :: BackendType).
ComputedFieldMetadata b -> ComputedFieldDefinition b
_cfmName :: forall (b :: BackendType).
ComputedFieldMetadata b -> ComputedFieldName
..} = ExceptT QErr m (Maybe (ComputedFieldInfo b))
-> m (Either QErr (Maybe (ComputedFieldInfo b)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  let addComputedFieldContext :: Text -> Text
addComputedFieldContext Text
e = Text
"in computed field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ComputedFieldName
_cfmName ComputedFieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
      function :: FunctionName b
function = ComputedFieldDefinition b -> FunctionName b
forall (b :: BackendType).
Backend b =>
ComputedFieldDefinition b -> FunctionName b
computedFieldFunction @b ComputedFieldDefinition b
_cfmDefinition
      funcDefs :: [RawFunctionInfo b]
funcDefs = [RawFunctionInfo b]
-> Maybe [RawFunctionInfo b] -> [RawFunctionInfo b]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [RawFunctionInfo b] -> [RawFunctionInfo b])
-> Maybe [RawFunctionInfo b] -> [RawFunctionInfo b]
forall a b. (a -> b) -> a -> b
$ FunctionName b
-> DBFunctionsMetadata b -> Maybe [RawFunctionInfo b]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup FunctionName b
function DBFunctionsMetadata b
pgFunctions
  MetadataObject
-> ExceptT QErr (ExceptT QErr m) (ComputedFieldInfo b)
-> ExceptT QErr m (Maybe (ComputedFieldInfo b))
forall w (m :: * -> *) a.
(MonadWriter (Seq w) m, AsInconsistentMetadata w) =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM ((SourceName, TableName b, ComputedFieldMetadata b)
-> MetadataObject
forall (b :: BackendType).
Backend b =>
(SourceName, TableName b, ComputedFieldMetadata b)
-> MetadataObject
mkComputedFieldMetadataObject (SourceName
source, TableName b
table, ComputedFieldMetadata b
cf)) (ExceptT QErr (ExceptT QErr m) (ComputedFieldInfo b)
 -> ExceptT QErr m (Maybe (ComputedFieldInfo b)))
-> ExceptT QErr (ExceptT QErr m) (ComputedFieldInfo b)
-> ExceptT QErr m (Maybe (ComputedFieldInfo b))
forall a b. (a -> b) -> a -> b
$
    (Text -> Text)
-> ExceptT QErr (ExceptT QErr m) (ComputedFieldInfo b)
-> ExceptT QErr (ExceptT QErr m) (ComputedFieldInfo b)
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr (TableName b -> Text -> Text
forall (b :: BackendType). Backend b => TableName b -> Text -> Text
addTableContext @b TableName b
table (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addComputedFieldContext) (ExceptT QErr (ExceptT QErr m) (ComputedFieldInfo b)
 -> ExceptT QErr (ExceptT QErr m) (ComputedFieldInfo b))
-> ExceptT QErr (ExceptT QErr m) (ComputedFieldInfo b)
-> ExceptT QErr (ExceptT QErr m) (ComputedFieldInfo b)
forall a b. (a -> b) -> a -> b
$ do
      RawFunctionInfo b
rawfi <- FunctionName b
-> [RawFunctionInfo b]
-> ExceptT QErr (ExceptT QErr m) (RawFunctionInfo b)
forall (b :: BackendType) (m :: * -> *) a.
(QErrM m, Backend b) =>
FunctionName b -> [a] -> m a
handleMultipleFunctions @b (ComputedFieldDefinition b -> FunctionName b
forall (b :: BackendType).
Backend b =>
ComputedFieldDefinition b -> FunctionName b
computedFieldFunction @b ComputedFieldDefinition b
_cfmDefinition) [RawFunctionInfo b]
funcDefs
      HashSet (TableName b)
-> TableName b
-> HashSet (Column b)
-> ComputedFieldName
-> ComputedFieldDefinition b
-> RawFunctionInfo b
-> Comment
-> ExceptT QErr (ExceptT QErr m) (ComputedFieldInfo b)
forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m) =>
HashSet (TableName b)
-> TableName b
-> HashSet (Column b)
-> ComputedFieldName
-> ComputedFieldDefinition b
-> RawFunctionInfo b
-> Comment
-> m (ComputedFieldInfo b)
buildComputedFieldInfo HashSet (TableName b)
trackedTableNames TableName b
table HashSet (Column b)
tableColumns ComputedFieldName
_cfmName ComputedFieldDefinition b
_cfmDefinition RawFunctionInfo b
rawfi Comment
_cfmComment

mkRemoteRelationshipMetadataObject ::
  forall b.
  Backend b =>
  (SourceName, TableName b, RemoteRelationship) ->
  MetadataObject
mkRemoteRelationshipMetadataObject :: (SourceName, TableName b, RemoteRelationship) -> MetadataObject
mkRemoteRelationshipMetadataObject (SourceName
source, TableName b
table, RemoteRelationship {RelName
RemoteRelationshipDefinition
_rrDefinition :: RemoteRelationship -> RemoteRelationshipDefinition
_rrDefinition :: RemoteRelationshipDefinition
_rrName :: RelName
_rrName :: RemoteRelationship -> RelName
..}) =
  let objectId :: MetadataObjId
objectId =
        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
$
            TableName b -> TableMetadataObjId -> SourceMetadataObjId b
forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
table (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$
              RelName -> TableMetadataObjId
MTORemoteRelationship RelName
_rrName
   in MetadataObjId -> Value -> MetadataObject
MetadataObject MetadataObjId
objectId (Value -> MetadataObject) -> Value -> MetadataObject
forall a b. (a -> b) -> a -> b
$
        CreateFromSourceRelationship b -> Value
forall a. ToJSON a => a -> Value
toJSON (CreateFromSourceRelationship b -> Value)
-> CreateFromSourceRelationship b -> Value
forall a b. (a -> b) -> a -> b
$
          SourceName
-> TableName b
-> RelName
-> RemoteRelationshipDefinition
-> CreateFromSourceRelationship b
forall (b :: BackendType).
SourceName
-> TableName b
-> RelName
-> RemoteRelationshipDefinition
-> CreateFromSourceRelationship b
CreateFromSourceRelationship @b SourceName
source TableName b
table RelName
_rrName RemoteRelationshipDefinition
_rrDefinition

--  | This is a "thin" wrapper around 'buildRemoteFieldInfo', which only knows
-- how to construct dependencies on the RHS of the join condition, so the
-- dependencies on the remote relationship on the LHS entity are computed here
buildRemoteRelationship ::
  forall b m.
  ( MonadWriter (Seq CollectedInfo) m,
    BackendMetadata b
  ) =>
  HashMap SourceName (AB.AnyBackend PartiallyResolvedSource) ->
  M.HashMap FieldName (DBJoinField b) ->
  RemoteSchemaMap ->
  (SourceName, TableName b, RemoteRelationship) ->
  m (Either QErr (Maybe (RemoteFieldInfo (DBJoinField b))))
buildRemoteRelationship :: HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> HashMap FieldName (DBJoinField b)
-> RemoteSchemaMap
-> (SourceName, TableName b, RemoteRelationship)
-> m (Either QErr (Maybe (RemoteFieldInfo (DBJoinField b))))
buildRemoteRelationship HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources HashMap FieldName (DBJoinField b)
allColumns RemoteSchemaMap
remoteSchemaMap (SourceName
source, TableName b
table, rr :: RemoteRelationship
rr@RemoteRelationship {RelName
RemoteRelationshipDefinition
_rrDefinition :: RemoteRelationshipDefinition
_rrName :: RelName
_rrDefinition :: RemoteRelationship -> RemoteRelationshipDefinition
_rrName :: RemoteRelationship -> RelName
..}) = ExceptT QErr m (Maybe (RemoteFieldInfo (DBJoinField b)))
-> m (Either QErr (Maybe (RemoteFieldInfo (DBJoinField b))))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr m (Maybe (RemoteFieldInfo (DBJoinField b)))
 -> m (Either QErr (Maybe (RemoteFieldInfo (DBJoinField b)))))
-> ExceptT QErr m (Maybe (RemoteFieldInfo (DBJoinField b)))
-> m (Either QErr (Maybe (RemoteFieldInfo (DBJoinField b))))
forall a b. (a -> b) -> a -> b
$ do
  let metadataObject :: MetadataObject
metadataObject = (SourceName, TableName b, RemoteRelationship) -> MetadataObject
forall (b :: BackendType).
Backend b =>
(SourceName, TableName b, RemoteRelationship) -> MetadataObject
mkRemoteRelationshipMetadataObject @b (SourceName
source, TableName b
table, RemoteRelationship
rr)
      schemaObj :: SchemaObjId
schemaObj =
        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
$
            TableName b -> TableObjId b -> SourceObjId b
forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
table (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$
              RelName -> TableObjId b
forall (b :: BackendType). RelName -> TableObjId b
TORemoteRel RelName
_rrName
      addRemoteRelationshipContext :: Text -> Text
addRemoteRelationshipContext Text
e = Text
"in remote relationship" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName
_rrName RelName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
  MetadataObject
-> ExceptT QErr (ExceptT QErr m) (RemoteFieldInfo (DBJoinField b))
-> ExceptT QErr m (Maybe (RemoteFieldInfo (DBJoinField b)))
forall w (m :: * -> *) a.
(MonadWriter (Seq w) m, AsInconsistentMetadata w) =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM MetadataObject
metadataObject (ExceptT QErr (ExceptT QErr m) (RemoteFieldInfo (DBJoinField b))
 -> ExceptT QErr m (Maybe (RemoteFieldInfo (DBJoinField b))))
-> ExceptT QErr (ExceptT QErr m) (RemoteFieldInfo (DBJoinField b))
-> ExceptT QErr m (Maybe (RemoteFieldInfo (DBJoinField b)))
forall a b. (a -> b) -> a -> b
$
    (Text -> Text)
-> ExceptT QErr (ExceptT QErr m) (RemoteFieldInfo (DBJoinField b))
-> ExceptT QErr (ExceptT QErr m) (RemoteFieldInfo (DBJoinField b))
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr (TableName b -> Text -> Text
forall (b :: BackendType). Backend b => TableName b -> Text -> Text
addTableContext @b TableName b
table (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addRemoteRelationshipContext) (ExceptT QErr (ExceptT QErr m) (RemoteFieldInfo (DBJoinField b))
 -> ExceptT QErr (ExceptT QErr m) (RemoteFieldInfo (DBJoinField b)))
-> ExceptT QErr (ExceptT QErr m) (RemoteFieldInfo (DBJoinField b))
-> ExceptT QErr (ExceptT QErr m) (RemoteFieldInfo (DBJoinField b))
forall a b. (a -> b) -> a -> b
$ do
      (RemoteFieldInfo (DBJoinField b)
remoteField, [SchemaDependency]
rhsDependencies) <-
        LHSIdentifier
-> HashMap FieldName (DBJoinField b)
-> RemoteRelationship
-> HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> RemoteSchemaMap
-> ExceptT
     QErr
     (ExceptT QErr m)
     (RemoteFieldInfo (DBJoinField b), [SchemaDependency])
forall (m :: * -> *) lhsJoinField.
QErrM m =>
LHSIdentifier
-> HashMap FieldName lhsJoinField
-> RemoteRelationship
-> HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> RemoteSchemaMap
-> m (RemoteFieldInfo lhsJoinField, [SchemaDependency])
buildRemoteFieldInfo (TableName b -> LHSIdentifier
forall (b :: BackendType).
Backend b =>
TableName b -> LHSIdentifier
tableNameToLHSIdentifier @b TableName b
table) HashMap FieldName (DBJoinField b)
allColumns RemoteRelationship
rr HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources RemoteSchemaMap
remoteSchemaMap
      let lhsDependencies :: [SchemaDependency]
lhsDependencies =
            -- a direct dependency on the table on which this is defined
            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
$ TableName b -> SourceObjId b
forall (b :: BackendType). TableName b -> SourceObjId b
SOITable @b TableName b
table) DependencyReason
DRTable
            -- the relationship is also dependent on all the lhs
            -- columns that are used in the join condition
            SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
:
            ((DBJoinField b -> SchemaDependency)
 -> [DBJoinField b] -> [SchemaDependency])
-> [DBJoinField b]
-> (DBJoinField b -> SchemaDependency)
-> [SchemaDependency]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (DBJoinField b -> SchemaDependency)
-> [DBJoinField b] -> [SchemaDependency]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap FieldName (DBJoinField b) -> [DBJoinField b]
forall k v. HashMap k v -> [v]
M.elems (HashMap FieldName (DBJoinField b) -> [DBJoinField b])
-> HashMap FieldName (DBJoinField b) -> [DBJoinField b]
forall a b. (a -> b) -> a -> b
$ RemoteFieldInfo (DBJoinField b)
-> HashMap FieldName (DBJoinField b)
forall lhsJoinField.
RemoteFieldInfo lhsJoinField -> HashMap FieldName lhsJoinField
_rfiLHS RemoteFieldInfo (DBJoinField b)
remoteField) \case
              JoinColumn Column b
column ColumnType b
_ ->
                -- TODO: shouldn't this be DRColumn??
                DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
mkColDep @b DependencyReason
DRRemoteRelationship SourceName
source TableName b
table Column b
column
              JoinComputedField ScalarComputedField b
computedFieldInfo ->
                DependencyReason
-> SourceName
-> TableName b
-> ComputedFieldName
-> SchemaDependency
forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName
-> TableName b
-> ComputedFieldName
-> SchemaDependency
mkComputedFieldDep @b DependencyReason
DRRemoteRelationship SourceName
source TableName b
table (ComputedFieldName -> SchemaDependency)
-> ComputedFieldName -> SchemaDependency
forall a b. (a -> b) -> a -> b
$ ScalarComputedField b -> ComputedFieldName
forall (b :: BackendType).
ScalarComputedField b -> ComputedFieldName
_scfName ScalarComputedField b
computedFieldInfo
      -- Here is the essence of the function: construct dependencies on the RHS
      -- of the join condition.
      MetadataObject
-> SchemaObjId
-> [SchemaDependency]
-> ExceptT QErr (ExceptT QErr m) ()
forall (m :: * -> *).
MonadWriter (Seq CollectedInfo) m =>
MetadataObject -> SchemaObjId -> [SchemaDependency] -> m ()
recordDependenciesM MetadataObject
metadataObject SchemaObjId
schemaObj ([SchemaDependency]
lhsDependencies [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. Semigroup a => a -> a -> a
<> [SchemaDependency]
rhsDependencies)
      RemoteFieldInfo (DBJoinField b)
-> ExceptT QErr (ExceptT QErr m) (RemoteFieldInfo (DBJoinField b))
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteFieldInfo (DBJoinField b)
remoteField