-- | This module provides building blocks for the GraphQL Schema that the
-- GraphQL Engine presents.
--
-- The functions defined here are used to serve as default implementations for
-- their namesakes in the 'BackendSchema' type class.
--
-- When, for some backend, you want to implement a new feature that manifests
-- itself visibly in the schema (e.g., if you're developing support for update
-- mutations), this module is likely where your efforts should start.
--
-- Using these functions help us present a consistent GraphQL schema across
-- different backends.
--
-- There is a bit of tension however, as sometimes we intentionally do want the
-- GraphQL Schema relating to some backend to be different in some way.
--
-- It could be that a backend only has limited support for some common feature,
-- or, more interestingly, that some backend just does things differently (c.f.
-- MSSQL's @MERGE@ statement with PostgreSQL's @INSERT .. ON CONFLICT@, which
-- are similar enough that we want to use the same overall upsert schema but
-- different enough that we want to use different field names)
--
-- When you want to implement new schema for a backend, there is overall three
-- different ways do deal with this tension:
--
-- 1. You can duplicate existing code and implement the new behavior in the
--    duplicate.
-- 2. You can infuse the new behavior into existing code and switch dynamically
--    at runtime (or via type class instance dispatch, which is the same
--    for our purposes)
-- 3. You can refactor the existing building blocks and compose them differently
--    at use sites to get the desired behavior nuances.
--
-- Of these three, steps 1. and 2. are by far the easiest to execute, while 3.
-- requires some critical thought. However, both 1. and 2. produce legacy code
-- that is difficult to maintain and understand.
--
-- As a guideline, if you find yourself wanting add new behavior to some of
-- these functions it's very likely that you should consider refactoring them
-- instead, thus shifting the responsibility deciding on the correct behavior to
-- use sites.
--
-- It an ongoing effort to adapt and refactor these building blocks such that
-- they have the sizes and shapes that result in the most elegant uses of them
-- that we can manage.
module Hasura.GraphQL.Schema.Build
  ( buildTableDeleteMutationFields,
    buildTableInsertMutationFields,
    buildTableQueryAndSubscriptionFields,
    buildTableStreamingSubscriptionFields,
    buildTableUpdateMutationFields,
    setFieldNameCase,
    buildFieldDescription,
  )
where

import Data.Has (getter)
import Data.Text.Casing qualified as C
import Data.Text.Extended
import Hasura.GraphQL.ApolloFederation
import Hasura.GraphQL.Schema.Backend (BackendTableSelectSchema (..), MonadBuildSchema)
import Hasura.GraphQL.Schema.BoolExp (AggregationPredicatesSchema)
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Mutation
import Hasura.GraphQL.Schema.NamingCase
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.GraphQL.Schema.Parser hiding (EnumValueInfo, field)
import Hasura.GraphQL.Schema.Select
import Hasura.GraphQL.Schema.SubscriptionStream (selectStreamTable)
import Hasura.GraphQL.Schema.Table (getTableIdentifierName, tableSelectPermissions)
import Hasura.GraphQL.Schema.Typename (mkTypename)
import Hasura.GraphQL.Schema.Update (updateTable, updateTableByPk)
import Hasura.Prelude
import Hasura.RQL.IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization
import Hasura.RQL.Types.Table
import Language.GraphQL.Draft.Syntax qualified as G

-- | Builds field name with proper case. Please note that this is a pure
--   function as all the validation has already been done while preparing
--   @GQLNameIdentifier@.
setFieldNameCase ::
  NamingCase ->
  TableInfo b ->
  CustomRootField ->
  (C.GQLNameIdentifier -> C.GQLNameIdentifier) ->
  C.GQLNameIdentifier ->
  G.Name
setFieldNameCase :: NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
setFieldNameCase NamingCase
tCase TableInfo b
tInfo CustomRootField
crf GQLNameIdentifier -> GQLNameIdentifier
getFieldName GQLNameIdentifier
tableName =
  (NamingCase -> GQLNameIdentifier -> Name
applyFieldNameCaseIdentifier NamingCase
tCase GQLNameIdentifier
fieldIdentifier)
  where
    tccName :: Maybe GQLNameIdentifier
tccName = (Name -> GQLNameIdentifier)
-> Maybe Name -> Maybe GQLNameIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> GQLNameIdentifier
C.fromCustomName (Maybe Name -> Maybe GQLNameIdentifier)
-> (TableInfo b -> Maybe Name)
-> TableInfo b
-> Maybe GQLNameIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableConfig b -> Maybe Name
forall (b :: BackendType). TableConfig b -> Maybe Name
_tcCustomName (TableConfig b -> Maybe Name)
-> (TableInfo b -> TableConfig b) -> TableInfo b -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableConfig b
_tciCustomConfig (TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b)
-> (TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> TableInfo b
-> TableConfig b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo (TableInfo b -> Maybe GQLNameIdentifier)
-> TableInfo b -> Maybe GQLNameIdentifier
forall a b. (a -> b) -> a -> b
$ TableInfo b
tInfo
    crfName :: Maybe GQLNameIdentifier
crfName = (Name -> GQLNameIdentifier)
-> Maybe Name -> Maybe GQLNameIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> GQLNameIdentifier
C.fromCustomName (CustomRootField -> Maybe Name
_crfName CustomRootField
crf)
    fieldIdentifier :: GQLNameIdentifier
fieldIdentifier = GQLNameIdentifier -> Maybe GQLNameIdentifier -> GQLNameIdentifier
forall a. a -> Maybe a -> a
fromMaybe (GQLNameIdentifier -> GQLNameIdentifier
getFieldName (GQLNameIdentifier -> Maybe GQLNameIdentifier -> GQLNameIdentifier
forall a. a -> Maybe a -> a
fromMaybe GQLNameIdentifier
tableName Maybe GQLNameIdentifier
tccName)) Maybe GQLNameIdentifier
crfName

-- | buildTableQueryAndSubscriptionFields builds the field parsers of a table.
--   It returns a tuple with array of field parsers that correspond to the field
--   parsers of the query root and the field parsers of the subscription root
buildTableQueryAndSubscriptionFields ::
  forall b r m n.
  ( MonadBuildSchema b r m n,
    AggregationPredicatesSchema b,
    BackendTableSelectSchema b
  ) =>
  MkRootFieldName ->
  SourceInfo b ->
  TableName b ->
  TableInfo b ->
  C.GQLNameIdentifier ->
  m
    ( [FieldParser n (QueryDB b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      [FieldParser n (QueryDB b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      Maybe (G.Name, Parser 'Output n (ApolloFederationParserFunction n))
    )
buildTableQueryAndSubscriptionFields :: MkRootFieldName
-> SourceInfo b
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> m ([FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      [FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
buildTableQueryAndSubscriptionFields MkRootFieldName
mkRootFieldName SourceInfo b
sourceInfo TableName b
tableName TableInfo b
tableInfo GQLNameIdentifier
gqlName = do
  NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
  RoleName
roleName <- (SchemaContext -> RoleName) -> m RoleName
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RoleName
scRole
  let -- select table
      selectName :: Name
selectName = MkRootFieldName -> Name -> Name
runMkRootFieldName MkRootFieldName
mkRootFieldName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
forall (b :: BackendType).
NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
setFieldNameCase NamingCase
tCase TableInfo b
tableInfo CustomRootField
_tcrfSelect GQLNameIdentifier -> GQLNameIdentifier
mkSelectField GQLNameIdentifier
gqlName
      -- select table by pk
      selectPKName :: Name
selectPKName = MkRootFieldName -> Name -> Name
runMkRootFieldName MkRootFieldName
mkRootFieldName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
forall (b :: BackendType).
NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
setFieldNameCase NamingCase
tCase TableInfo b
tableInfo CustomRootField
_tcrfSelectByPk GQLNameIdentifier -> GQLNameIdentifier
mkSelectByPkField GQLNameIdentifier
gqlName
      -- select table aggregate
      selectAggName :: Name
selectAggName = MkRootFieldName -> Name -> Name
runMkRootFieldName MkRootFieldName
mkRootFieldName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
forall (b :: BackendType).
NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
setFieldNameCase NamingCase
tCase TableInfo b
tableInfo CustomRootField
_tcrfSelectAggregate GQLNameIdentifier -> GQLNameIdentifier
mkSelectAggregateField GQLNameIdentifier
gqlName

  Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
selectTableParser <- (AnnSimpleSelectG
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> m (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> m (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (n :: * -> *) (m :: * -> *) a b.
(Functor n, Functor m) =>
(a -> b)
-> m (Maybe (FieldParser n a)) -> m (Maybe (FieldParser n b))
optionalFieldParser AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnSimpleSelectG b r v -> QueryDB b r v
QDBMultipleRows (m (Maybe
      (FieldParser
         n
         (AnnSimpleSelectG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
 -> m (Maybe
         (FieldParser
            n
            (QueryDB
               b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))))
-> m (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> m (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall a b. (a -> b) -> a -> b
$ SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendTableSelectSchema b, MonadBuildSchemaBase r m n) =>
SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe (FieldParser n (SelectExp b)))
selectTable SourceInfo b
sourceInfo TableInfo b
tableInfo Name
selectName Maybe Description
selectDesc
  Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
selectTableByPkParser <- (AnnSimpleSelectG
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> m (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> m (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (n :: * -> *) (m :: * -> *) a b.
(Functor n, Functor m) =>
(a -> b)
-> m (Maybe (FieldParser n a)) -> m (Maybe (FieldParser n b))
optionalFieldParser AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnSimpleSelectG b r v -> QueryDB b r v
QDBSingleRow (m (Maybe
      (FieldParser
         n
         (AnnSimpleSelectG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
 -> m (Maybe
         (FieldParser
            n
            (QueryDB
               b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))))
-> m (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> m (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall a b. (a -> b) -> a -> b
$ SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendTableSelectSchema b) =>
SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe (FieldParser n (SelectExp b)))
selectTableByPk SourceInfo b
sourceInfo TableInfo b
tableInfo Name
selectPKName Maybe Description
selectPKDesc
  Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
selectTableAggregateParser <- (AnnAggregateSelectG
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> m (Maybe
        (FieldParser
           n
           (AnnAggregateSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> m (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (n :: * -> *) (m :: * -> *) a b.
(Functor n, Functor m) =>
(a -> b)
-> m (Maybe (FieldParser n a)) -> m (Maybe (FieldParser n b))
optionalFieldParser AnnAggregateSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnAggregateSelectG b r v -> QueryDB b r v
QDBAggregation (m (Maybe
      (FieldParser
         n
         (AnnAggregateSelectG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
 -> m (Maybe
         (FieldParser
            n
            (QueryDB
               b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))))
-> m (Maybe
        (FieldParser
           n
           (AnnAggregateSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> m (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall a b. (a -> b) -> a -> b
$ SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnAggregateSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendTableSelectSchema b, MonadBuildSchemaBase r m n) =>
SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe (FieldParser n (AggSelectExp b)))
selectTableAggregate SourceInfo b
sourceInfo TableInfo b
tableInfo Name
selectAggName Maybe Description
selectAggDesc

  case RoleName -> TableInfo b -> Maybe (SelPermInfo b)
forall (b :: BackendType).
RoleName -> TableInfo b -> Maybe (SelPermInfo b)
tableSelectPermissions RoleName
roleName TableInfo b
tableInfo of
    -- No select permission found for the current role, so
    -- no root fields will be accessible to the role
    Maybe (SelPermInfo b)
Nothing -> ([FieldParser
    n
    (QueryDB
       b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
 [FieldParser
    n
    (QueryDB
       b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
 Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
-> m ([FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      [FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldParser
   n
   (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall a. Monoid a => a
mempty, [FieldParser
   n
   (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall a. Monoid a => a
mempty, Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n))
forall a. Maybe a
Nothing)
    -- Filter the root fields which have been enabled
    Just SelPermInfo {Bool
Maybe Int
HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b))
HashMap
  ComputedFieldName (Maybe (AnnColumnCaseBoolExpPartialSQL b))
HashSet Text
AnnBoolExpPartialSQL b
AllowedRootFields SubscriptionRootFieldType
AllowedRootFields QueryRootFieldType
spiAllowedSubscriptionRootFields :: forall (b :: BackendType).
SelPermInfo b -> AllowedRootFields SubscriptionRootFieldType
spiAllowedQueryRootFields :: forall (b :: BackendType).
SelPermInfo b -> AllowedRootFields QueryRootFieldType
spiRequiredHeaders :: forall (b :: BackendType). SelPermInfo b -> HashSet Text
spiAllowAgg :: forall (b :: BackendType). SelPermInfo b -> Bool
spiLimit :: forall (b :: BackendType). SelPermInfo b -> Maybe Int
spiFilter :: forall (b :: BackendType). SelPermInfo b -> AnnBoolExpPartialSQL b
spiComputedFields :: forall (b :: BackendType).
SelPermInfo b
-> HashMap
     ComputedFieldName (Maybe (AnnColumnCaseBoolExpPartialSQL b))
spiCols :: forall (b :: BackendType).
SelPermInfo b
-> HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b))
spiAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
spiAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType
spiRequiredHeaders :: HashSet Text
spiAllowAgg :: Bool
spiLimit :: Maybe Int
spiFilter :: AnnBoolExpPartialSQL b
spiComputedFields :: HashMap
  ComputedFieldName (Maybe (AnnColumnCaseBoolExpPartialSQL b))
spiCols :: HashMap (Column b) (Maybe (AnnColumnCaseBoolExpPartialSQL b))
..} -> do
      [FieldParser
   n
   (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
selectStreamParser <-
        if (SubscriptionRootFieldType
-> AllowedRootFields SubscriptionRootFieldType -> Bool
forall rootField.
Eq rootField =>
rootField -> AllowedRootFields rootField -> Bool
isRootFieldAllowed SubscriptionRootFieldType
SRFTSelectStream AllowedRootFields SubscriptionRootFieldType
spiAllowedSubscriptionRootFields)
          then MkRootFieldName
-> SourceInfo b
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> m [FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
MkRootFieldName
-> SourceInfo b
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> m [FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
buildTableStreamingSubscriptionFields MkRootFieldName
mkRootFieldName SourceInfo b
sourceInfo TableName b
tableName TableInfo b
tableInfo GQLNameIdentifier
gqlName
          else [FieldParser
   n
   (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
-> m [FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FieldParser
   n
   (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall a. Monoid a => a
mempty

      let (Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
querySelectTableParser, Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
subscriptionSelectTableParser) =
            Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> Bool
-> Bool
-> (Maybe
      (FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))),
    Maybe
      (FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall a. Maybe a -> Bool -> Bool -> (Maybe a, Maybe a)
getQueryAndSubscriptionRootFields
              Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
selectTableParser
              (QueryRootFieldType -> AllowedRootFields QueryRootFieldType -> Bool
forall rootField.
Eq rootField =>
rootField -> AllowedRootFields rootField -> Bool
isRootFieldAllowed QueryRootFieldType
QRFTSelect AllowedRootFields QueryRootFieldType
spiAllowedQueryRootFields)
              (SubscriptionRootFieldType
-> AllowedRootFields SubscriptionRootFieldType -> Bool
forall rootField.
Eq rootField =>
rootField -> AllowedRootFields rootField -> Bool
isRootFieldAllowed SubscriptionRootFieldType
SRFTSelect AllowedRootFields SubscriptionRootFieldType
spiAllowedSubscriptionRootFields)

          (Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
querySelectTableByPkParser, Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
subscriptionSelectTableByPkParser) =
            Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> Bool
-> Bool
-> (Maybe
      (FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))),
    Maybe
      (FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall a. Maybe a -> Bool -> Bool -> (Maybe a, Maybe a)
getQueryAndSubscriptionRootFields
              Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
selectTableByPkParser
              (QueryRootFieldType -> AllowedRootFields QueryRootFieldType -> Bool
forall rootField.
Eq rootField =>
rootField -> AllowedRootFields rootField -> Bool
isRootFieldAllowed QueryRootFieldType
QRFTSelectByPk AllowedRootFields QueryRootFieldType
spiAllowedQueryRootFields)
              (SubscriptionRootFieldType
-> AllowedRootFields SubscriptionRootFieldType -> Bool
forall rootField.
Eq rootField =>
rootField -> AllowedRootFields rootField -> Bool
isRootFieldAllowed SubscriptionRootFieldType
SRFTSelectByPk AllowedRootFields SubscriptionRootFieldType
spiAllowedSubscriptionRootFields)

          (Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
querySelectTableAggParser, Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
subscriptionSelectTableAggParser) =
            Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> Bool
-> Bool
-> (Maybe
      (FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))),
    Maybe
      (FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall a. Maybe a -> Bool -> Bool -> (Maybe a, Maybe a)
getQueryAndSubscriptionRootFields
              Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
selectTableAggregateParser
              (QueryRootFieldType -> AllowedRootFields QueryRootFieldType -> Bool
forall rootField.
Eq rootField =>
rootField -> AllowedRootFields rootField -> Bool
isRootFieldAllowed QueryRootFieldType
QRFTSelectAggregate AllowedRootFields QueryRootFieldType
spiAllowedQueryRootFields)
              (SubscriptionRootFieldType
-> AllowedRootFields SubscriptionRootFieldType -> Bool
forall rootField.
Eq rootField =>
rootField -> AllowedRootFields rootField -> Bool
isRootFieldAllowed SubscriptionRootFieldType
SRFTSelectAggregate AllowedRootFields SubscriptionRootFieldType
spiAllowedSubscriptionRootFields)

          queryRootFields :: [FieldParser
   n
   (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
queryRootFields = [Maybe
   (FieldParser
      n
      (QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))]
-> [FieldParser
      n
      (QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
querySelectTableParser, Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
querySelectTableByPkParser, Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
querySelectTableAggParser]
          subscriptionRootFields :: [FieldParser
   n
   (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
subscriptionRootFields =
            [FieldParser
   n
   (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
selectStreamParser
              [FieldParser
   n
   (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
-> [FieldParser
      n
      (QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
-> [FieldParser
      n
      (QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall a. Semigroup a => a -> a -> a
<> [Maybe
   (FieldParser
      n
      (QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))]
-> [FieldParser
      n
      (QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
subscriptionSelectTableParser, Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
subscriptionSelectTableByPkParser, Maybe
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
subscriptionSelectTableAggParser]

      -- This parser is for generating apollo federation field _entities
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n))
apolloFedTableParser <- MaybeT
  m (Name, Parser 'Output n (ApolloFederationParserFunction n))
-> m (Maybe
        (Name, Parser 'Output n (ApolloFederationParserFunction n)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
        Bool -> MaybeT m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT m ()) -> Bool -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ Maybe ApolloFederationConfig -> Bool
isApolloFedV1enabled (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> Maybe ApolloFederationConfig
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe ApolloFederationConfig
_tciApolloFederationConfig (TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo b
tableInfo))
        Parser 'Output n (AnnotatedFields b)
tableSelSet <- m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT m (Parser 'Output n (AnnotatedFields b))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (Parser 'Output n (AnnotatedFields b)))
 -> MaybeT m (Parser 'Output n (AnnotatedFields b)))
-> m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT m (Parser 'Output n (AnnotatedFields b))
forall a b. (a -> b) -> a -> b
$ SourceInfo b
-> TableInfo b -> m (Maybe (Parser 'Output n (AnnotatedFields b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendTableSelectSchema b, MonadBuildSchemaBase r m n) =>
SourceInfo b
-> TableInfo b -> m (Maybe (Parser 'Output n (AnnotatedFields b)))
tableSelectionSet SourceInfo b
sourceInfo TableInfo b
tableInfo
        SelPermInfo b
selectPerm <- Maybe (SelPermInfo b) -> MaybeT m (SelPermInfo b)
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe (SelPermInfo b) -> MaybeT m (SelPermInfo b))
-> Maybe (SelPermInfo b) -> MaybeT m (SelPermInfo b)
forall a b. (a -> b) -> a -> b
$ RoleName -> TableInfo b -> Maybe (SelPermInfo b)
forall (b :: BackendType).
RoleName -> TableInfo b -> Maybe (SelPermInfo b)
tableSelectPermissions RoleName
roleName TableInfo b
tableInfo
        StringifyNumbers
stringifyNumbers <- (SchemaOptions -> StringifyNumbers) -> MaybeT m StringifyNumbers
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaOptions -> StringifyNumbers
Options.soStringifyNumbers
        NESeq (ColumnInfo b)
primaryKeys <- Maybe (NESeq (ColumnInfo b)) -> MaybeT m (NESeq (ColumnInfo b))
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe (NESeq (ColumnInfo b)) -> MaybeT m (NESeq (ColumnInfo b)))
-> Maybe (NESeq (ColumnInfo b)) -> MaybeT m (NESeq (ColumnInfo b))
forall a b. (a -> b) -> a -> b
$ (PrimaryKey b (ColumnInfo b) -> NESeq (ColumnInfo b))
-> Maybe (PrimaryKey b (ColumnInfo b))
-> Maybe (NESeq (ColumnInfo b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrimaryKey b (ColumnInfo b) -> NESeq (ColumnInfo b)
forall (b :: BackendType) a. PrimaryKey b a -> NESeq a
_pkColumns (Maybe (PrimaryKey b (ColumnInfo b))
 -> Maybe (NESeq (ColumnInfo b)))
-> (TableInfo b -> Maybe (PrimaryKey b (ColumnInfo b)))
-> TableInfo b
-> Maybe (NESeq (ColumnInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> Maybe (PrimaryKey b (ColumnInfo b))
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe (PrimaryKey b primaryKeyColumn)
_tciPrimaryKey (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
 -> Maybe (PrimaryKey b (ColumnInfo b)))
-> (TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> TableInfo b
-> Maybe (PrimaryKey b (ColumnInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo (TableInfo b -> Maybe (NESeq (ColumnInfo b)))
-> TableInfo b -> Maybe (NESeq (ColumnInfo b))
forall a b. (a -> b) -> a -> b
$ TableInfo b
tableInfo
        let tableSelPerm :: TablePerms b
tableSelPerm = SelPermInfo b -> TablePerms b
forall (b :: BackendType).
Backend b =>
SelPermInfo b -> TablePerms b
tablePermissionsInfo SelPermInfo b
selectPerm
        GQLNameIdentifier
tableGQLName <- TableInfo b -> MaybeT m GQLNameIdentifier
forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
TableInfo b -> m GQLNameIdentifier
getTableIdentifierName TableInfo b
tableInfo
        Name
objectTypename <- Name -> MaybeT m Name
forall r (m :: * -> *).
(MonadReader r m, Has MkTypename r) =>
Name -> m Name
mkTypename (Name -> MaybeT m Name) -> Name -> MaybeT m Name
forall a b. (a -> b) -> a -> b
$ NamingCase -> GQLNameIdentifier -> Name
applyTypeNameCaseIdentifier NamingCase
tCase (GQLNameIdentifier -> Name) -> GQLNameIdentifier -> Name
forall a b. (a -> b) -> a -> b
$ GQLNameIdentifier -> GQLNameIdentifier
mkTableTypeName (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier -> GQLNameIdentifier
forall a b. (a -> b) -> a -> b
$ GQLNameIdentifier
tableGQLName
        (Name, Parser 'Output n (ApolloFederationParserFunction n))
-> MaybeT
     m (Name, Parser 'Output n (ApolloFederationParserFunction n))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Name, Parser 'Output n (ApolloFederationParserFunction n))
 -> MaybeT
      m (Name, Parser 'Output n (ApolloFederationParserFunction n)))
-> (Name, Parser 'Output n (ApolloFederationParserFunction n))
-> MaybeT
     m (Name, Parser 'Output n (ApolloFederationParserFunction n))
forall a b. (a -> b) -> a -> b
$ (Name
objectTypename, SourceInfo b
-> TableInfo b
-> TablePerms b
-> StringifyNumbers
-> Maybe NamingCase
-> NESeq (ColumnInfo b)
-> Parser 'Output n (AnnotatedFields b)
-> Parser 'Output n (ApolloFederationParserFunction n)
forall (n :: * -> *) (b :: BackendType).
(Monad n, MonadParse n, Backend b) =>
SourceInfo b
-> TableInfo b
-> TablePermG b (UnpreparedValue b)
-> StringifyNumbers
-> Maybe NamingCase
-> NESeq (ColumnInfo b)
-> Parser 'Output n (AnnotatedFields b)
-> Parser 'Output n (ApolloFederationParserFunction n)
convertToApolloFedParserFunc SourceInfo b
sourceInfo TableInfo b
tableInfo TablePerms b
tableSelPerm StringifyNumbers
stringifyNumbers (NamingCase -> Maybe NamingCase
forall a. a -> Maybe a
Just NamingCase
tCase) NESeq (ColumnInfo b)
primaryKeys Parser 'Output n (AnnotatedFields b)
tableSelSet)

      ([FieldParser
    n
    (QueryDB
       b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
 [FieldParser
    n
    (QueryDB
       b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
 Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
-> m ([FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      [FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldParser
   n
   (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
queryRootFields, [FieldParser
   n
   (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
subscriptionRootFields, Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n))
apolloFedTableParser)
  where
    selectDesc :: Maybe Description
selectDesc = Text -> Comment -> Maybe Description
buildFieldDescription Text
defaultSelectDesc (Comment -> Maybe Description) -> Comment -> Maybe Description
forall a b. (a -> b) -> a -> b
$ CustomRootField -> Comment
_crfComment CustomRootField
_tcrfSelect
    selectPKDesc :: Maybe Description
selectPKDesc = Text -> Comment -> Maybe Description
buildFieldDescription Text
defaultSelectPKDesc (Comment -> Maybe Description) -> Comment -> Maybe Description
forall a b. (a -> b) -> a -> b
$ CustomRootField -> Comment
_crfComment CustomRootField
_tcrfSelectByPk
    selectAggDesc :: Maybe Description
selectAggDesc = Text -> Comment -> Maybe Description
buildFieldDescription Text
defaultSelectAggDesc (Comment -> Maybe Description) -> Comment -> Maybe Description
forall a b. (a -> b) -> a -> b
$ CustomRootField -> Comment
_crfComment CustomRootField
_tcrfSelectAggregate
    defaultSelectDesc :: Text
defaultSelectDesc = Text
"fetch data from the table: " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName
    defaultSelectPKDesc :: Text
defaultSelectPKDesc = Text
"fetch data from the 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
" using primary key columns"
    defaultSelectAggDesc :: Text
defaultSelectAggDesc = Text
"fetch aggregated fields from the table: " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName
    TableCustomRootFields {CustomRootField
_tcrfDeleteByPk :: TableCustomRootFields -> CustomRootField
_tcrfDelete :: TableCustomRootFields -> CustomRootField
_tcrfUpdateMany :: TableCustomRootFields -> CustomRootField
_tcrfUpdateByPk :: TableCustomRootFields -> CustomRootField
_tcrfUpdate :: TableCustomRootFields -> CustomRootField
_tcrfInsertOne :: TableCustomRootFields -> CustomRootField
_tcrfInsert :: TableCustomRootFields -> CustomRootField
_tcrfSelectStream :: TableCustomRootFields -> CustomRootField
_tcrfSelectAggregate :: TableCustomRootFields -> CustomRootField
_tcrfSelectByPk :: TableCustomRootFields -> CustomRootField
_tcrfSelect :: TableCustomRootFields -> CustomRootField
_tcrfDeleteByPk :: CustomRootField
_tcrfDelete :: CustomRootField
_tcrfUpdateMany :: CustomRootField
_tcrfUpdateByPk :: CustomRootField
_tcrfUpdate :: CustomRootField
_tcrfInsertOne :: CustomRootField
_tcrfInsert :: CustomRootField
_tcrfSelectStream :: CustomRootField
_tcrfSelectAggregate :: CustomRootField
_tcrfSelectByPk :: CustomRootField
_tcrfSelect :: CustomRootField
..} = TableConfig b -> TableCustomRootFields
forall (b :: BackendType). TableConfig b -> TableCustomRootFields
_tcCustomRootFields (TableConfig b -> TableCustomRootFields)
-> (TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b)
-> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> TableCustomRootFields
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableConfig b
_tciCustomConfig (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
 -> TableCustomRootFields)
-> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> TableCustomRootFields
forall a b. (a -> b) -> a -> b
$ TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo b
tableInfo

    -- This function checks if a root field is allowed to be exposed
    -- in the query root and a subscription root and when it is allowed,
    -- the parser will be returned.
    getQueryAndSubscriptionRootFields :: Maybe a -> Bool -> Bool -> (Maybe a, Maybe a)
getQueryAndSubscriptionRootFields Maybe a
parser Bool
allowedInQuery Bool
allowedInSubscription =
      case (Bool
allowedInQuery, Bool
allowedInSubscription) of
        (Bool
True, Bool
True) -> (Maybe a
parser, Maybe a
parser)
        (Bool
True, Bool
False) -> (Maybe a
parser, Maybe a
forall a. Maybe a
Nothing)
        (Bool
False, Bool
True) -> (Maybe a
forall a. Maybe a
Nothing, Maybe a
parser)
        (Bool
False, Bool
False) -> (Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)

buildTableStreamingSubscriptionFields ::
  forall b r m n.
  ( MonadBuildSchema b r m n,
    AggregationPredicatesSchema b,
    BackendTableSelectSchema b
  ) =>
  MkRootFieldName ->
  SourceInfo b ->
  TableName b ->
  TableInfo b ->
  C.GQLNameIdentifier ->
  m [FieldParser n (QueryDB b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
buildTableStreamingSubscriptionFields :: MkRootFieldName
-> SourceInfo b
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> m [FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
buildTableStreamingSubscriptionFields MkRootFieldName
mkRootFieldName SourceInfo b
sourceInfo TableName b
tableName TableInfo b
tableInfo GQLNameIdentifier
tableIdentifier = do
  NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
  let customRootFields :: TableCustomRootFields
customRootFields = TableConfig b -> TableCustomRootFields
forall (b :: BackendType). TableConfig b -> TableCustomRootFields
_tcCustomRootFields (TableConfig b -> TableCustomRootFields)
-> TableConfig b -> TableCustomRootFields
forall a b. (a -> b) -> a -> b
$ TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableConfig b
_tciCustomConfig (TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b)
-> TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b
forall a b. (a -> b) -> a -> b
$ TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo b
tableInfo
      selectDesc :: Maybe Description
selectDesc = Description -> Maybe Description
forall a. a -> Maybe a
Just (Description -> Maybe Description)
-> Description -> Maybe Description
forall a b. (a -> b) -> a -> b
$ Text -> Description
G.Description (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
"fetch data from the table in a streaming manner : " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName
      selectStreamName :: Name
selectStreamName =
        MkRootFieldName -> Name -> Name
runMkRootFieldName MkRootFieldName
mkRootFieldName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$
          NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
forall (b :: BackendType).
NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
setFieldNameCase NamingCase
tCase TableInfo b
tableInfo (TableCustomRootFields -> CustomRootField
_tcrfSelectStream TableCustomRootFields
customRootFields) GQLNameIdentifier -> GQLNameIdentifier
mkSelectStreamField GQLNameIdentifier
tableIdentifier
  [Maybe
   (FieldParser
      n
      (QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))]
-> [FieldParser
      n
      (QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
    ([Maybe
    (FieldParser
       n
       (QueryDB
          b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))]
 -> [FieldParser
       n
       (QueryDB
          b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))])
-> m [Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))]
-> m [FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m (Maybe
      (FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))]
-> m [Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
      [ (AnnSimpleStreamSelectG
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> m (Maybe
        (FieldParser
           n
           (AnnSimpleStreamSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> m (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (n :: * -> *) (m :: * -> *) a b.
(Functor n, Functor m) =>
(a -> b)
-> m (Maybe (FieldParser n a)) -> m (Maybe (FieldParser n b))
optionalFieldParser AnnSimpleStreamSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnSimpleStreamSelectG b r v -> QueryDB b r v
QDBStreamMultipleRows (m (Maybe
      (FieldParser
         n
         (AnnSimpleStreamSelectG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
 -> m (Maybe
         (FieldParser
            n
            (QueryDB
               b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))))
-> m (Maybe
        (FieldParser
           n
           (AnnSimpleStreamSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> m (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall a b. (a -> b) -> a -> b
$ SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnSimpleStreamSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe (FieldParser n (StreamSelectExp b)))
selectStreamTable SourceInfo b
sourceInfo TableInfo b
tableInfo Name
selectStreamName Maybe Description
selectDesc
      ]

buildTableInsertMutationFields ::
  forall b r m n.
  ( MonadBuildSchema b r m n,
    BackendTableSelectSchema b
  ) =>
  (SourceInfo b -> TableInfo b -> m (InputFieldsParser n (BackendInsert b (UnpreparedValue b)))) ->
  MkRootFieldName ->
  Scenario ->
  SourceInfo b ->
  TableName b ->
  TableInfo b ->
  C.GQLNameIdentifier ->
  m [FieldParser n (AnnotatedInsert b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
buildTableInsertMutationFields :: (SourceInfo b
 -> TableInfo b
 -> m (InputFieldsParser n (BackendInsert b (UnpreparedValue b))))
-> MkRootFieldName
-> Scenario
-> SourceInfo b
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> m [FieldParser
        n
        (AnnotatedInsert
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
buildTableInsertMutationFields SourceInfo b
-> TableInfo b
-> m (InputFieldsParser n (BackendInsert b (UnpreparedValue b)))
backendInsertAction MkRootFieldName
mkRootFieldName Scenario
scenario SourceInfo b
sourceInfo TableName b
tableName TableInfo b
tableInfo GQLNameIdentifier
gqlName = do
  NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
  let -- insert in table
      insertName :: Name
insertName = MkRootFieldName -> Name -> Name
runMkRootFieldName MkRootFieldName
mkRootFieldName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
forall (b :: BackendType).
NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
setFieldNameCase NamingCase
tCase TableInfo b
tableInfo CustomRootField
_tcrfInsert GQLNameIdentifier -> GQLNameIdentifier
mkInsertField GQLNameIdentifier
gqlName
      -- insert one in table
      insertOneName :: Name
insertOneName = MkRootFieldName -> Name -> Name
runMkRootFieldName MkRootFieldName
mkRootFieldName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
forall (b :: BackendType).
NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
setFieldNameCase NamingCase
tCase TableInfo b
tableInfo CustomRootField
_tcrfInsertOne GQLNameIdentifier -> GQLNameIdentifier
mkInsertOneField GQLNameIdentifier
gqlName

  Maybe
  (FieldParser
     n
     (AnnotatedInsert
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
insert <- (SourceInfo b
 -> TableInfo b
 -> m (InputFieldsParser n (BackendInsert b (UnpreparedValue b))))
-> Scenario
-> SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnotatedInsert
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendTableSelectSchema b) =>
(SourceInfo b
 -> TableInfo b
 -> m (InputFieldsParser n (BackendInsert b (UnpreparedValue b))))
-> Scenario
-> SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnotatedInsert
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
insertIntoTable SourceInfo b
-> TableInfo b
-> m (InputFieldsParser n (BackendInsert b (UnpreparedValue b)))
backendInsertAction Scenario
scenario SourceInfo b
sourceInfo TableInfo b
tableInfo Name
insertName Maybe Description
insertDesc
  -- Select permissions are required for insertOne: the selection set is the
  -- same as a select on that table, and it therefore can't be populated if the
  -- user doesn't have select permissions.
  Maybe
  (FieldParser
     n
     (AnnotatedInsert
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
insertOne <- (SourceInfo b
 -> TableInfo b
 -> m (InputFieldsParser n (BackendInsert b (UnpreparedValue b))))
-> Scenario
-> SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnotatedInsert
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendTableSelectSchema b) =>
(SourceInfo b
 -> TableInfo b
 -> m (InputFieldsParser n (BackendInsert b (UnpreparedValue b))))
-> Scenario
-> SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnotatedInsert
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
insertOneIntoTable SourceInfo b
-> TableInfo b
-> m (InputFieldsParser n (BackendInsert b (UnpreparedValue b)))
backendInsertAction Scenario
scenario SourceInfo b
sourceInfo TableInfo b
tableInfo Name
insertOneName Maybe Description
insertOneDesc
  [FieldParser
   n
   (AnnotatedInsert
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
-> m [FieldParser
        n
        (AnnotatedInsert
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldParser
    n
    (AnnotatedInsert
       b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
 -> m [FieldParser
         n
         (AnnotatedInsert
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))])
-> [FieldParser
      n
      (AnnotatedInsert
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
-> m [FieldParser
        n
        (AnnotatedInsert
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall a b. (a -> b) -> a -> b
$ [Maybe
   (FieldParser
      n
      (AnnotatedInsert
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))]
-> [FieldParser
      n
      (AnnotatedInsert
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe
  (FieldParser
     n
     (AnnotatedInsert
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
insert, Maybe
  (FieldParser
     n
     (AnnotatedInsert
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
insertOne]
  where
    insertDesc :: Maybe Description
insertDesc = Text -> Comment -> Maybe Description
buildFieldDescription Text
defaultInsertDesc (Comment -> Maybe Description) -> Comment -> Maybe Description
forall a b. (a -> b) -> a -> b
$ CustomRootField -> Comment
_crfComment CustomRootField
_tcrfInsert
    insertOneDesc :: Maybe Description
insertOneDesc = Text -> Comment -> Maybe Description
buildFieldDescription Text
defaultInsertOneDesc (Comment -> Maybe Description) -> Comment -> Maybe Description
forall a b. (a -> b) -> a -> b
$ CustomRootField -> Comment
_crfComment CustomRootField
_tcrfInsertOne
    defaultInsertDesc :: Text
defaultInsertDesc = Text
"insert data into the table: " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName
    defaultInsertOneDesc :: Text
defaultInsertOneDesc = Text
"insert a single row into the table: " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName
    TableCustomRootFields {CustomRootField
_tcrfDeleteByPk :: CustomRootField
_tcrfDelete :: CustomRootField
_tcrfUpdateMany :: CustomRootField
_tcrfUpdateByPk :: CustomRootField
_tcrfUpdate :: CustomRootField
_tcrfSelectStream :: CustomRootField
_tcrfSelectAggregate :: CustomRootField
_tcrfSelectByPk :: CustomRootField
_tcrfSelect :: CustomRootField
_tcrfInsertOne :: CustomRootField
_tcrfInsert :: CustomRootField
_tcrfDeleteByPk :: TableCustomRootFields -> CustomRootField
_tcrfDelete :: TableCustomRootFields -> CustomRootField
_tcrfUpdateMany :: TableCustomRootFields -> CustomRootField
_tcrfUpdateByPk :: TableCustomRootFields -> CustomRootField
_tcrfUpdate :: TableCustomRootFields -> CustomRootField
_tcrfInsertOne :: TableCustomRootFields -> CustomRootField
_tcrfInsert :: TableCustomRootFields -> CustomRootField
_tcrfSelectStream :: TableCustomRootFields -> CustomRootField
_tcrfSelectAggregate :: TableCustomRootFields -> CustomRootField
_tcrfSelectByPk :: TableCustomRootFields -> CustomRootField
_tcrfSelect :: TableCustomRootFields -> CustomRootField
..} = TableConfig b -> TableCustomRootFields
forall (b :: BackendType). TableConfig b -> TableCustomRootFields
_tcCustomRootFields (TableConfig b -> TableCustomRootFields)
-> (TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b)
-> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> TableCustomRootFields
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableConfig b
_tciCustomConfig (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
 -> TableCustomRootFields)
-> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> TableCustomRootFields
forall a b. (a -> b) -> a -> b
$ TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo b
tableInfo

-- | This function is the basic building block for update mutations. It
-- implements the mutation schema in the general shape described in
-- @https://hasura.io/docs/latest/graphql/core/databases/postgres/mutations/update.html@.
--
-- Something that varies between backends is the @update operators@ that they
-- support (i.e. the schema fields @_set@, @_inc@, etc., see
-- <src/Hasura.Backends.Postgres.Instances.Schema.html#updateOperators Hasura.Backends.Postgres.Instances.Schema.updateOperators> for an example
-- implementation). Therefore, this function is parameterised over a monadic
-- action that produces the operators that the backend supports in the context
-- of some table and associated update permissions.
--
-- Apart from this detail, the rest of the arguments are the same as those
-- of @BackendSchema.@'Hasura.GraphQL.Schema.Backend.buildTableUpdateMutationFields'.
--
-- The suggested way to use this is like:
--
-- > instance BackendSchema MyBackend where
-- >   ...
-- >   buildTableUpdateMutationFields = GSB.buildTableUpdateMutationFields myBackendUpdateOperators
-- >   ...
buildTableUpdateMutationFields ::
  forall b r m n.
  ( MonadBuildSchema b r m n,
    AggregationPredicatesSchema b,
    BackendTableSelectSchema b
  ) =>
  -- | an action that builds @BackendUpdate@ with the
  -- backend-specific data needed to perform an update mutation
  ( TableInfo b ->
    m
      (InputFieldsParser n (BackendUpdate b (UnpreparedValue b)))
  ) ->
  MkRootFieldName ->
  Scenario ->
  -- | The source that the table lives in
  SourceInfo b ->
  -- | The name of the table being acted on
  TableName b ->
  -- | table info
  TableInfo b ->
  -- | field display name
  C.GQLNameIdentifier ->
  m [FieldParser n (AnnotatedUpdateG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
buildTableUpdateMutationFields :: (TableInfo b
 -> m (InputFieldsParser n (BackendUpdate b (UnpreparedValue b))))
-> MkRootFieldName
-> Scenario
-> SourceInfo b
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> m [FieldParser
        n
        (AnnotatedUpdateG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
buildTableUpdateMutationFields TableInfo b
-> m (InputFieldsParser n (BackendUpdate b (UnpreparedValue b)))
mkBackendUpdate MkRootFieldName
mkRootFieldName Scenario
scenario SourceInfo b
sourceInfo TableName b
tableName TableInfo b
tableInfo GQLNameIdentifier
gqlName = do
  NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
  InputFieldsParser n (BackendUpdate b (UnpreparedValue b))
backendUpdate <- TableInfo b
-> m (InputFieldsParser n (BackendUpdate b (UnpreparedValue b)))
mkBackendUpdate TableInfo b
tableInfo
  let -- update table
      updateName :: Name
updateName = MkRootFieldName -> Name -> Name
runMkRootFieldName MkRootFieldName
mkRootFieldName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
forall (b :: BackendType).
NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
setFieldNameCase NamingCase
tCase TableInfo b
tableInfo CustomRootField
_tcrfUpdate GQLNameIdentifier -> GQLNameIdentifier
mkUpdateField GQLNameIdentifier
gqlName
      -- update table by pk
      updatePKName :: Name
updatePKName = MkRootFieldName -> Name -> Name
runMkRootFieldName MkRootFieldName
mkRootFieldName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
forall (b :: BackendType).
NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
setFieldNameCase NamingCase
tCase TableInfo b
tableInfo CustomRootField
_tcrfUpdateByPk GQLNameIdentifier -> GQLNameIdentifier
mkUpdateByPkField GQLNameIdentifier
gqlName

  Maybe
  (FieldParser
     n
     (AnnotatedUpdateG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
update <- InputFieldsParser n (BackendUpdate b (UnpreparedValue b))
-> Scenario
-> SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnotatedUpdateG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
InputFieldsParser n (BackendUpdate b (UnpreparedValue b))
-> Scenario
-> SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnotatedUpdateG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
updateTable InputFieldsParser n (BackendUpdate b (UnpreparedValue b))
backendUpdate Scenario
scenario SourceInfo b
sourceInfo TableInfo b
tableInfo Name
updateName Maybe Description
updateDesc
  -- Primary keys can only be tested in the `where` clause if a primary key
  -- exists on the table and if the user has select permissions on all columns
  -- that make up the key.
  Maybe
  (FieldParser
     n
     (AnnotatedUpdateG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
updateByPk <- InputFieldsParser n (BackendUpdate b (UnpreparedValue b))
-> Scenario
-> SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnotatedUpdateG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendTableSelectSchema b) =>
InputFieldsParser n (BackendUpdate b (UnpreparedValue b))
-> Scenario
-> SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnotatedUpdateG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
updateTableByPk InputFieldsParser n (BackendUpdate b (UnpreparedValue b))
backendUpdate Scenario
scenario SourceInfo b
sourceInfo TableInfo b
tableInfo Name
updatePKName Maybe Description
updatePKDesc
  [FieldParser
   n
   (AnnotatedUpdateG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
-> m [FieldParser
        n
        (AnnotatedUpdateG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldParser
    n
    (AnnotatedUpdateG
       b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
 -> m [FieldParser
         n
         (AnnotatedUpdateG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))])
-> [FieldParser
      n
      (AnnotatedUpdateG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
-> m [FieldParser
        n
        (AnnotatedUpdateG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall a b. (a -> b) -> a -> b
$ [Maybe
   (FieldParser
      n
      (AnnotatedUpdateG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))]
-> [FieldParser
      n
      (AnnotatedUpdateG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe
  (FieldParser
     n
     (AnnotatedUpdateG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
update, Maybe
  (FieldParser
     n
     (AnnotatedUpdateG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
updateByPk]
  where
    updateDesc :: Maybe Description
updateDesc = Text -> Comment -> Maybe Description
buildFieldDescription Text
defaultUpdateDesc (Comment -> Maybe Description) -> Comment -> Maybe Description
forall a b. (a -> b) -> a -> b
$ CustomRootField -> Comment
_crfComment CustomRootField
_tcrfUpdate
    updatePKDesc :: Maybe Description
updatePKDesc = Text -> Comment -> Maybe Description
buildFieldDescription Text
defaultUpdatePKDesc (Comment -> Maybe Description) -> Comment -> Maybe Description
forall a b. (a -> b) -> a -> b
$ CustomRootField -> Comment
_crfComment CustomRootField
_tcrfUpdateByPk
    defaultUpdateDesc :: Text
defaultUpdateDesc = Text
"update data of the table: " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName
    defaultUpdatePKDesc :: Text
defaultUpdatePKDesc = Text
"update single row of the table: " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName
    TableCustomRootFields {CustomRootField
_tcrfDeleteByPk :: CustomRootField
_tcrfDelete :: CustomRootField
_tcrfUpdateMany :: CustomRootField
_tcrfInsertOne :: CustomRootField
_tcrfInsert :: CustomRootField
_tcrfSelectStream :: CustomRootField
_tcrfSelectAggregate :: CustomRootField
_tcrfSelectByPk :: CustomRootField
_tcrfSelect :: CustomRootField
_tcrfUpdateByPk :: CustomRootField
_tcrfUpdate :: CustomRootField
_tcrfDeleteByPk :: TableCustomRootFields -> CustomRootField
_tcrfDelete :: TableCustomRootFields -> CustomRootField
_tcrfUpdateMany :: TableCustomRootFields -> CustomRootField
_tcrfUpdateByPk :: TableCustomRootFields -> CustomRootField
_tcrfUpdate :: TableCustomRootFields -> CustomRootField
_tcrfInsertOne :: TableCustomRootFields -> CustomRootField
_tcrfInsert :: TableCustomRootFields -> CustomRootField
_tcrfSelectStream :: TableCustomRootFields -> CustomRootField
_tcrfSelectAggregate :: TableCustomRootFields -> CustomRootField
_tcrfSelectByPk :: TableCustomRootFields -> CustomRootField
_tcrfSelect :: TableCustomRootFields -> CustomRootField
..} = TableConfig b -> TableCustomRootFields
forall (b :: BackendType). TableConfig b -> TableCustomRootFields
_tcCustomRootFields (TableConfig b -> TableCustomRootFields)
-> (TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b)
-> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> TableCustomRootFields
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableConfig b
_tciCustomConfig (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
 -> TableCustomRootFields)
-> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> TableCustomRootFields
forall a b. (a -> b) -> a -> b
$ TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo b
tableInfo

buildTableDeleteMutationFields ::
  forall b r m n.
  ( MonadBuildSchema b r m n,
    AggregationPredicatesSchema b,
    BackendTableSelectSchema b
  ) =>
  MkRootFieldName ->
  Scenario ->
  SourceInfo b ->
  TableName b ->
  TableInfo b ->
  C.GQLNameIdentifier ->
  m [FieldParser n (AnnDelG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
buildTableDeleteMutationFields :: MkRootFieldName
-> Scenario
-> SourceInfo b
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> m [FieldParser
        n
        (AnnDelG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
buildTableDeleteMutationFields MkRootFieldName
mkRootFieldName Scenario
scenario SourceInfo b
sourceInfo TableName b
tableName TableInfo b
tableInfo GQLNameIdentifier
gqlName = do
  NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
  let -- delete from table
      deleteName :: Name
deleteName = MkRootFieldName -> Name -> Name
runMkRootFieldName MkRootFieldName
mkRootFieldName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
forall (b :: BackendType).
NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
setFieldNameCase NamingCase
tCase TableInfo b
tableInfo CustomRootField
_tcrfDelete GQLNameIdentifier -> GQLNameIdentifier
mkDeleteField GQLNameIdentifier
gqlName
      -- delete from table by pk
      deletePKName :: Name
deletePKName = MkRootFieldName -> Name -> Name
runMkRootFieldName MkRootFieldName
mkRootFieldName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
forall (b :: BackendType).
NamingCase
-> TableInfo b
-> CustomRootField
-> (GQLNameIdentifier -> GQLNameIdentifier)
-> GQLNameIdentifier
-> Name
setFieldNameCase NamingCase
tCase TableInfo b
tableInfo CustomRootField
_tcrfDeleteByPk GQLNameIdentifier -> GQLNameIdentifier
mkDeleteByPkField GQLNameIdentifier
gqlName

  Maybe
  (FieldParser
     n
     (AnnDelG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
delete <- Scenario
-> SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnDelG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
Scenario
-> SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnDelG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
deleteFromTable Scenario
scenario SourceInfo b
sourceInfo TableInfo b
tableInfo Name
deleteName Maybe Description
deleteDesc
  -- Primary keys can only be tested in the `where` clause if the user has
  -- select permissions for them, which at the very least requires select
  -- permissions.
  Maybe
  (FieldParser
     n
     (AnnDelG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
deleteByPk <- Scenario
-> SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnDelG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendTableSelectSchema b) =>
Scenario
-> SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe
        (FieldParser
           n
           (AnnDelG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
deleteFromTableByPk Scenario
scenario SourceInfo b
sourceInfo TableInfo b
tableInfo Name
deletePKName Maybe Description
deletePKDesc
  [FieldParser
   n
   (AnnDelG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
-> m [FieldParser
        n
        (AnnDelG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldParser
    n
    (AnnDelG
       b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
 -> m [FieldParser
         n
         (AnnDelG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))])
-> [FieldParser
      n
      (AnnDelG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
-> m [FieldParser
        n
        (AnnDelG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall a b. (a -> b) -> a -> b
$ [Maybe
   (FieldParser
      n
      (AnnDelG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))]
-> [FieldParser
      n
      (AnnDelG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe
  (FieldParser
     n
     (AnnDelG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
delete, Maybe
  (FieldParser
     n
     (AnnDelG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
deleteByPk]
  where
    deleteDesc :: Maybe Description
deleteDesc = Text -> Comment -> Maybe Description
buildFieldDescription Text
defaultDeleteDesc (Comment -> Maybe Description) -> Comment -> Maybe Description
forall a b. (a -> b) -> a -> b
$ CustomRootField -> Comment
_crfComment CustomRootField
_tcrfDelete
    deletePKDesc :: Maybe Description
deletePKDesc = Text -> Comment -> Maybe Description
buildFieldDescription Text
defaultDeletePKDesc (Comment -> Maybe Description) -> Comment -> Maybe Description
forall a b. (a -> b) -> a -> b
$ CustomRootField -> Comment
_crfComment CustomRootField
_tcrfDeleteByPk
    defaultDeleteDesc :: Text
defaultDeleteDesc = Text
"delete data from the table: " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName
    defaultDeletePKDesc :: Text
defaultDeletePKDesc = Text
"delete single row from the table: " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName
    TableCustomRootFields {CustomRootField
_tcrfUpdateMany :: CustomRootField
_tcrfUpdateByPk :: CustomRootField
_tcrfUpdate :: CustomRootField
_tcrfInsertOne :: CustomRootField
_tcrfInsert :: CustomRootField
_tcrfSelectStream :: CustomRootField
_tcrfSelectAggregate :: CustomRootField
_tcrfSelectByPk :: CustomRootField
_tcrfSelect :: CustomRootField
_tcrfDeleteByPk :: CustomRootField
_tcrfDelete :: CustomRootField
_tcrfDeleteByPk :: TableCustomRootFields -> CustomRootField
_tcrfDelete :: TableCustomRootFields -> CustomRootField
_tcrfUpdateMany :: TableCustomRootFields -> CustomRootField
_tcrfUpdateByPk :: TableCustomRootFields -> CustomRootField
_tcrfUpdate :: TableCustomRootFields -> CustomRootField
_tcrfInsertOne :: TableCustomRootFields -> CustomRootField
_tcrfInsert :: TableCustomRootFields -> CustomRootField
_tcrfSelectStream :: TableCustomRootFields -> CustomRootField
_tcrfSelectAggregate :: TableCustomRootFields -> CustomRootField
_tcrfSelectByPk :: TableCustomRootFields -> CustomRootField
_tcrfSelect :: TableCustomRootFields -> CustomRootField
..} = TableConfig b -> TableCustomRootFields
forall (b :: BackendType). TableConfig b -> TableCustomRootFields
_tcCustomRootFields (TableConfig b -> TableCustomRootFields)
-> (TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b)
-> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> TableCustomRootFields
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableConfig b
_tciCustomConfig (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
 -> TableCustomRootFields)
-> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> TableCustomRootFields
forall a b. (a -> b) -> a -> b
$ TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo b
tableInfo

buildFieldDescription :: Text -> Comment -> Maybe G.Description
buildFieldDescription :: Text -> Comment -> Maybe Description
buildFieldDescription Text
defaultDescription = \case
  Comment
Automatic -> Description -> Maybe Description
forall a. a -> Maybe a
Just (Description -> Maybe Description)
-> Description -> Maybe Description
forall a b. (a -> b) -> a -> b
$ Text -> Description
G.Description Text
defaultDescription
  Explicit Maybe NonEmptyText
comment -> Text -> Description
G.Description (Text -> Description)
-> (NonEmptyText -> Text) -> NonEmptyText -> Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyText -> Text
forall a. ToTxt a => a -> Text
toTxt (NonEmptyText -> Description)
-> Maybe NonEmptyText -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NonEmptyText
comment