{-# LANGUAGE TemplateHaskellQuotes #-}

module Hasura.GraphQL.Schema.Action
  ( actionExecute,
    actionAsyncMutation,
    actionAsyncQuery,
  )
where

import Data.Aeson qualified as J
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.HashMap.Strict qualified as HashMap
import Data.Text.Extended
import Data.Text.NonEmpty
import Hasura.Backends.Postgres.Instances.Schema ()
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.Types.Column
import Hasura.Base.Error
import Hasura.Base.ErrorMessage (toErrorMessage)
import Hasura.GraphQL.Parser.Class
import Hasura.GraphQL.Parser.Internal.Scalars (mkScalar)
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Parser
  ( FieldParser,
    InputFieldsParser,
    Kind (..),
    Parser,
  )
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.IR.Action qualified as IR
import Hasura.RQL.IR.Root qualified as IR
import Hasura.RQL.IR.Value qualified as IR
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.Roles (adminRoleName)
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.SQL.AnyBackend qualified as AB
import Language.GraphQL.Draft.Syntax qualified as G

-- | actionExecute is used to execute either a query action or a synchronous
--   mutation action. A query action or a synchronous mutation action accepts
--   the field name and input arguments and a selectionset. The
--   input argument and selectionset types are defined by the user.
--
-- > action_name(action_input_arguments) {
-- >   col1: col1_type
-- >   col2: col2_type
-- > }
actionExecute ::
  forall r m n.
  (MonadBuildActionSchema r m n) =>
  AnnotatedCustomTypes ->
  ActionInfo ->
  SchemaT r m (Maybe (FieldParser n (IR.AnnActionExecution (IR.RemoteRelationshipField IR.UnpreparedValue))))
actionExecute :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildActionSchema r m n =>
AnnotatedCustomTypes
-> ActionInfo
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n (AnnActionExecution (RemoteRelationshipField UnpreparedValue))))
actionExecute AnnotatedCustomTypes
customTypes ActionInfo
actionInfo = MaybeT
  (SchemaT r m)
  (FieldParser
     n (AnnActionExecution (RemoteRelationshipField UnpreparedValue)))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n (AnnActionExecution (RemoteRelationshipField UnpreparedValue))))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  RoleName
roleName <- (SchemaContext -> RoleName) -> MaybeT (SchemaT r m) RoleName
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RoleName
scRole
  Bool -> MaybeT (SchemaT r m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RoleName
roleName RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
adminRoleName Bool -> Bool -> Bool
|| RoleName
roleName RoleName -> HashMap RoleName ActionPermissionInfo -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HashMap.member` HashMap RoleName ActionPermissionInfo
permissions)
  let fieldName :: Name
fieldName = ActionName -> Name
unActionName ActionName
actionName
      description :: Maybe Description
description = Text -> Description
G.Description (Text -> Description) -> Maybe Text -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
comment
  InputFieldsParser n Value
inputArguments <- SchemaT r m (InputFieldsParser n Value)
-> MaybeT (SchemaT r m) (InputFieldsParser n Value)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchemaT r m (InputFieldsParser n Value)
 -> MaybeT (SchemaT r m) (InputFieldsParser n Value))
-> SchemaT r m (InputFieldsParser n Value)
-> MaybeT (SchemaT r m) (InputFieldsParser n Value)
forall a b. (a -> b) -> a -> b
$ HashMap Name AnnotatedInputType
-> [ArgumentDefinition (GType, AnnotatedInputType)]
-> SchemaT r m (InputFieldsParser n Value)
forall r (m :: * -> *) (n :: * -> *).
MonadBuildActionSchema r m n =>
HashMap Name AnnotatedInputType
-> [ArgumentDefinition (GType, AnnotatedInputType)]
-> SchemaT r m (InputFieldsParser n Value)
actionInputArguments (AnnotatedCustomTypes -> HashMap Name AnnotatedInputType
_actInputTypes AnnotatedCustomTypes
customTypes) ([ArgumentDefinition (GType, AnnotatedInputType)]
 -> SchemaT r m (InputFieldsParser n Value))
-> [ArgumentDefinition (GType, AnnotatedInputType)]
-> SchemaT r m (InputFieldsParser n Value)
forall a b. (a -> b) -> a -> b
$ ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> [ArgumentDefinition (GType, AnnotatedInputType)]
forall arg webhook.
ActionDefinition arg webhook -> [ArgumentDefinition arg]
_adArguments ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
definition
  FieldParser MetadataObjId n (Value, AnnotatedActionFields)
parserOutput <- case AnnotatedOutputType
outputObject of
    AOTObject AnnotatedObjectType
aot -> do
      Parser 'Output n AnnotatedActionFields
selectionSet <- SchemaT r m (Parser 'Output n AnnotatedActionFields)
-> MaybeT (SchemaT r m) (Parser 'Output n AnnotatedActionFields)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchemaT r m (Parser 'Output n AnnotatedActionFields)
 -> MaybeT (SchemaT r m) (Parser 'Output n AnnotatedActionFields))
-> SchemaT r m (Parser 'Output n AnnotatedActionFields)
-> MaybeT (SchemaT r m) (Parser 'Output n AnnotatedActionFields)
forall a b. (a -> b) -> a -> b
$ GType
-> AnnotatedObjectType
-> HashMap Name AnnotatedObjectType
-> SchemaT r m (Parser 'Output n AnnotatedActionFields)
forall r (m :: * -> *) (n :: * -> *).
MonadBuildActionSchema r m n =>
GType
-> AnnotatedObjectType
-> HashMap Name AnnotatedObjectType
-> SchemaT r m (Parser 'Output n AnnotatedActionFields)
actionOutputFields GType
outputType AnnotatedObjectType
aot (AnnotatedCustomTypes -> HashMap Name AnnotatedObjectType
_actObjectTypes AnnotatedCustomTypes
customTypes)
      FieldParser MetadataObjId n (Value, AnnotatedActionFields)
-> MaybeT
     (SchemaT r m)
     (FieldParser MetadataObjId n (Value, AnnotatedActionFields))
forall a. a -> MaybeT (SchemaT r m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldParser MetadataObjId n (Value, AnnotatedActionFields)
 -> MaybeT
      (SchemaT r m)
      (FieldParser MetadataObjId n (Value, AnnotatedActionFields)))
-> FieldParser MetadataObjId n (Value, AnnotatedActionFields)
-> MaybeT
     (SchemaT r m)
     (FieldParser MetadataObjId n (Value, AnnotatedActionFields))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> InputFieldsParser n Value
-> Parser 'Output n AnnotatedActionFields
-> FieldParser MetadataObjId n (Value, AnnotatedActionFields)
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Output m b
-> FieldParser origin m (a, b)
P.subselection Name
fieldName Maybe Description
description InputFieldsParser n Value
inputArguments Parser 'Output n AnnotatedActionFields
selectionSet
    AOTScalar AnnotatedScalarType
ast -> do
      let selectionSet :: Parser 'Both n Value
selectionSet = AnnotatedScalarType -> Parser 'Both n Value
forall (m :: * -> *).
MonadParse m =>
AnnotatedScalarType -> Parser 'Both m Value
customScalarParser AnnotatedScalarType
ast
      FieldParser MetadataObjId n (Value, AnnotatedActionFields)
-> MaybeT
     (SchemaT r m)
     (FieldParser MetadataObjId n (Value, AnnotatedActionFields))
forall a. a -> MaybeT (SchemaT r m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldParser MetadataObjId n (Value, AnnotatedActionFields)
 -> MaybeT
      (SchemaT r m)
      (FieldParser MetadataObjId n (Value, AnnotatedActionFields)))
-> FieldParser MetadataObjId n (Value, AnnotatedActionFields)
-> MaybeT
     (SchemaT r m)
     (FieldParser MetadataObjId n (Value, AnnotatedActionFields))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> InputFieldsParser n Value
-> Parser 'Both n Value
-> FieldParser MetadataObjId n Value
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Both m b
-> FieldParser origin m a
P.selection Name
fieldName Maybe Description
description InputFieldsParser n Value
inputArguments Parser 'Both n Value
selectionSet FieldParser MetadataObjId n Value
-> (Value -> (Value, AnnotatedActionFields))
-> FieldParser MetadataObjId n (Value, AnnotatedActionFields)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,[])
  FieldParser
  n (AnnActionExecution (RemoteRelationshipField UnpreparedValue))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n (AnnActionExecution (RemoteRelationshipField UnpreparedValue)))
forall a. a -> MaybeT (SchemaT r m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (FieldParser
   n (AnnActionExecution (RemoteRelationshipField UnpreparedValue))
 -> MaybeT
      (SchemaT r m)
      (FieldParser
         n (AnnActionExecution (RemoteRelationshipField UnpreparedValue))))
-> FieldParser
     n (AnnActionExecution (RemoteRelationshipField UnpreparedValue))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n (AnnActionExecution (RemoteRelationshipField UnpreparedValue)))
forall a b. (a -> b) -> a -> b
$ FieldParser MetadataObjId n (Value, AnnotatedActionFields)
parserOutput
    FieldParser MetadataObjId n (Value, AnnotatedActionFields)
-> ((Value, AnnotatedActionFields)
    -> AnnActionExecution (RemoteRelationshipField UnpreparedValue))
-> FieldParser
     n (AnnActionExecution (RemoteRelationshipField UnpreparedValue))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Value
argsJson, AnnotatedActionFields
fields) ->
      IR.AnnActionExecution
        { _aaeName :: ActionName
_aaeName = ActionName
actionName,
          _aaeFields :: AnnotatedActionFields
_aaeFields = AnnotatedActionFields
fields,
          _aaePayload :: Value
_aaePayload = Value
argsJson,
          _aaeOutputType :: GraphQLType
_aaeOutputType = ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> GraphQLType
forall arg webhook. ActionDefinition arg webhook -> GraphQLType
_adOutputType ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
definition,
          _aaeOutputFields :: ActionOutputFields
_aaeOutputFields = AnnotatedOutputType -> ActionOutputFields
IR.getActionOutputFields AnnotatedOutputType
outputObject,
          _aaeWebhook :: EnvRecord ResolvedWebhook
_aaeWebhook = ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> EnvRecord ResolvedWebhook
forall arg webhook. ActionDefinition arg webhook -> webhook
_adHandler ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
definition,
          _aaeHeaders :: [HeaderConf]
_aaeHeaders = ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> [HeaderConf]
forall arg webhook. ActionDefinition arg webhook -> [HeaderConf]
_adHeaders ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
definition,
          _aaeForwardClientHeaders :: Bool
_aaeForwardClientHeaders = ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> Bool
forall arg webhook. ActionDefinition arg webhook -> Bool
_adForwardClientHeaders ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
definition,
          _aaeTimeOut :: Timeout
_aaeTimeOut = ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> Timeout
forall arg webhook. ActionDefinition arg webhook -> Timeout
_adTimeout ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
definition,
          _aaeRequestTransform :: Maybe RequestTransform
_aaeRequestTransform = ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> Maybe RequestTransform
forall arg webhook.
ActionDefinition arg webhook -> Maybe RequestTransform
_adRequestTransform ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
definition,
          _aaeResponseTransform :: Maybe MetadataResponseTransform
_aaeResponseTransform = ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> Maybe MetadataResponseTransform
forall arg webhook.
ActionDefinition arg webhook -> Maybe MetadataResponseTransform
_adResponseTransform ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
definition
        }
  where
    ActionInfo ActionName
actionName (GType
outputType, AnnotatedOutputType
outputObject) ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
definition HashMap RoleName ActionPermissionInfo
permissions Bool
_ Maybe Text
comment = ActionInfo
actionInfo

-- | actionAsyncMutation is used to execute a asynchronous mutation action. An
--   asynchronous action expects the field name and the input arguments to the
--   action. A selectionset is *not* expected. An action ID (UUID) will be
--   returned after performing the action
--
-- > action_name(action_input_arguments)
actionAsyncMutation ::
  forall r m n.
  (MonadBuildActionSchema r m n) =>
  HashMap G.Name AnnotatedInputType ->
  ActionInfo ->
  SchemaT r m (Maybe (FieldParser n IR.AnnActionMutationAsync))
actionAsyncMutation :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildActionSchema r m n =>
HashMap Name AnnotatedInputType
-> ActionInfo
-> SchemaT r m (Maybe (FieldParser n AnnActionMutationAsync))
actionAsyncMutation HashMap Name AnnotatedInputType
nonObjectTypeMap ActionInfo
actionInfo = MaybeT (SchemaT r m) (FieldParser n AnnActionMutationAsync)
-> SchemaT r m (Maybe (FieldParser n AnnActionMutationAsync))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  RoleName
roleName <- (SchemaContext -> RoleName) -> MaybeT (SchemaT r m) RoleName
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RoleName
scRole
  Bool -> MaybeT (SchemaT r m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT (SchemaT r m) ())
-> Bool -> MaybeT (SchemaT r m) ()
forall a b. (a -> b) -> a -> b
$ RoleName
roleName RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
adminRoleName Bool -> Bool -> Bool
|| RoleName
roleName RoleName -> HashMap RoleName ActionPermissionInfo -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HashMap.member` HashMap RoleName ActionPermissionInfo
permissions
  InputFieldsParser n Value
inputArguments <- SchemaT r m (InputFieldsParser n Value)
-> MaybeT (SchemaT r m) (InputFieldsParser n Value)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchemaT r m (InputFieldsParser n Value)
 -> MaybeT (SchemaT r m) (InputFieldsParser n Value))
-> SchemaT r m (InputFieldsParser n Value)
-> MaybeT (SchemaT r m) (InputFieldsParser n Value)
forall a b. (a -> b) -> a -> b
$ HashMap Name AnnotatedInputType
-> [ArgumentDefinition (GType, AnnotatedInputType)]
-> SchemaT r m (InputFieldsParser n Value)
forall r (m :: * -> *) (n :: * -> *).
MonadBuildActionSchema r m n =>
HashMap Name AnnotatedInputType
-> [ArgumentDefinition (GType, AnnotatedInputType)]
-> SchemaT r m (InputFieldsParser n Value)
actionInputArguments HashMap Name AnnotatedInputType
nonObjectTypeMap ([ArgumentDefinition (GType, AnnotatedInputType)]
 -> SchemaT r m (InputFieldsParser n Value))
-> [ArgumentDefinition (GType, AnnotatedInputType)]
-> SchemaT r m (InputFieldsParser n Value)
forall a b. (a -> b) -> a -> b
$ ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> [ArgumentDefinition (GType, AnnotatedInputType)]
forall arg webhook.
ActionDefinition arg webhook -> [ArgumentDefinition arg]
_adArguments ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
definition
  let fieldName :: Name
fieldName = ActionName -> Name
unActionName ActionName
actionName
      description :: Maybe Description
description = Text -> Description
G.Description (Text -> Description) -> Maybe Text -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
comment
  FieldParser n AnnActionMutationAsync
-> MaybeT (SchemaT r m) (FieldParser n AnnActionMutationAsync)
forall a. a -> MaybeT (SchemaT r m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (FieldParser n AnnActionMutationAsync
 -> MaybeT (SchemaT r m) (FieldParser n AnnActionMutationAsync))
-> FieldParser n AnnActionMutationAsync
-> MaybeT (SchemaT r m) (FieldParser n AnnActionMutationAsync)
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> InputFieldsParser n Value
-> Parser MetadataObjId 'Both n ActionId
-> FieldParser MetadataObjId n Value
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Both m b
-> FieldParser origin m a
P.selection Name
fieldName Maybe Description
description InputFieldsParser n Value
inputArguments Parser MetadataObjId 'Both n ActionId
forall (n :: * -> *). MonadParse n => Parser 'Both n ActionId
actionIdParser
    FieldParser MetadataObjId n Value
-> (Value -> AnnActionMutationAsync)
-> FieldParser n AnnActionMutationAsync
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ActionName -> Bool -> Value -> AnnActionMutationAsync
IR.AnnActionMutationAsync ActionName
actionName Bool
forwardClientHeaders
  where
    ActionInfo ActionName
actionName (GType, AnnotatedOutputType)
_ ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
definition HashMap RoleName ActionPermissionInfo
permissions Bool
forwardClientHeaders Maybe Text
comment = ActionInfo
actionInfo

-- | actionAsyncQuery is used to query/subscribe to the result of an
--   asynchronous mutation action. The only input argument to an
--   asynchronous mutation action is the action ID (UUID) and a selection
--   set is expected, the selection set contains 4 fields namely 'id',
--   'created_at','errors' and 'output'. The result of the action can be queried
--   through the 'output' field.
--
-- > action_name (id: UUID!) {
-- >   id: UUID!
-- >   created_at: timestampz!
-- >   errors: JSON
-- >   output: user_defined_type!
-- > }
actionAsyncQuery ::
  forall r m n.
  (MonadBuildActionSchema r m n) =>
  HashMap G.Name AnnotatedObjectType ->
  ActionInfo ->
  SchemaT r m (Maybe (FieldParser n (IR.AnnActionAsyncQuery ('Postgres 'Vanilla) (IR.RemoteRelationshipField IR.UnpreparedValue))))
actionAsyncQuery :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildActionSchema r m n =>
HashMap Name AnnotatedObjectType
-> ActionInfo
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnActionAsyncQuery
              ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue))))
actionAsyncQuery HashMap Name AnnotatedObjectType
objectTypes ActionInfo
actionInfo = MaybeT
  (SchemaT r m)
  (FieldParser
     n
     (AnnActionAsyncQuery
        ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue)))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnActionAsyncQuery
              ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue))))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  RoleName
roleName <- (SchemaContext -> RoleName) -> MaybeT (SchemaT r m) RoleName
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RoleName
scRole
  Bool -> MaybeT (SchemaT r m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT (SchemaT r m) ())
-> Bool -> MaybeT (SchemaT r m) ()
forall a b. (a -> b) -> a -> b
$ RoleName
roleName RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
adminRoleName Bool -> Bool -> Bool
|| RoleName
roleName RoleName -> HashMap RoleName ActionPermissionInfo -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HashMap.member` HashMap RoleName ActionPermissionInfo
permissions
  Parser 'Both n ()
createdAtFieldParser <- PGScalarType -> MaybeT (SchemaT r m) (Parser 'Both n ())
forall (m' :: * -> *).
MonadError QErr m' =>
PGScalarType -> m' (Parser 'Both n ())
mkOutputParser PGScalarType
PGTimeStampTZ
  Parser MetadataObjId 'Both n (Maybe ())
errorsFieldParser <- Parser 'Both n () -> Parser MetadataObjId 'Both n (Maybe ())
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m (Maybe a)
P.nullable (Parser 'Both n () -> Parser MetadataObjId 'Both n (Maybe ()))
-> MaybeT (SchemaT r m) (Parser 'Both n ())
-> MaybeT (SchemaT r m) (Parser MetadataObjId 'Both n (Maybe ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PGScalarType -> MaybeT (SchemaT r m) (Parser 'Both n ())
forall (m' :: * -> *).
MonadError QErr m' =>
PGScalarType -> m' (Parser 'Both n ())
mkOutputParser PGScalarType
PGJSON
  let outputTypeName :: Name
outputTypeName = ActionName -> Name
unActionName ActionName
actionName
      fieldName :: Name
fieldName = ActionName -> Name
unActionName ActionName
actionName
      description :: Maybe Description
description = Text -> Description
G.Description (Text -> Description) -> Maybe Text -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
comment
      actionIdInputField :: InputFieldsParser MetadataObjId n ActionId
actionIdInputField =
        Name
-> Maybe Description
-> Parser MetadataObjId 'Both n ActionId
-> InputFieldsParser MetadataObjId n ActionId
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field Name
idFieldName (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
idFieldDescription) Parser MetadataObjId 'Both n ActionId
forall (n :: * -> *). MonadParse n => Parser 'Both n ActionId
actionIdParser
      allFieldParsers :: Parser MetadataObjId 'Output n AnnotatedActionFields
-> [FieldParser
      MetadataObjId
      n
      (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))]
allFieldParsers Parser MetadataObjId 'Output n AnnotatedActionFields
actionOutputParser =
        let idField :: FieldParser
  MetadataObjId
  n
  (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
idField = Name
-> Maybe Description
-> Parser MetadataObjId 'Both n ActionId
-> FieldParser MetadataObjId n ()
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> Parser origin 'Both m a
-> FieldParser origin m ()
P.selection_ Name
idFieldName (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
idFieldDescription) Parser MetadataObjId 'Both n ActionId
forall (n :: * -> *). MonadParse n => Parser 'Both n ActionId
actionIdParser FieldParser MetadataObjId n ()
-> AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)
-> FieldParser
     MetadataObjId
     n
     (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)
forall r. AsyncActionQueryFieldG r
IR.AsyncId
            createdAtField :: FieldParser
  MetadataObjId
  n
  (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
createdAtField =
              Name
-> Maybe Description
-> Parser 'Both n ()
-> FieldParser MetadataObjId n ()
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> Parser origin 'Both m a
-> FieldParser origin m ()
P.selection_
                Name
Name._created_at
                (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"the time at which this action was created")
                Parser 'Both n ()
createdAtFieldParser
                FieldParser MetadataObjId n ()
-> AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)
-> FieldParser
     MetadataObjId
     n
     (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)
forall r. AsyncActionQueryFieldG r
IR.AsyncCreatedAt
            errorsField :: FieldParser
  MetadataObjId
  n
  (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
errorsField =
              Name
-> Maybe Description
-> Parser MetadataObjId 'Both n (Maybe ())
-> FieldParser MetadataObjId n ()
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> Parser origin 'Both m a
-> FieldParser origin m ()
P.selection_
                Name
Name._errors
                (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"errors related to the invocation")
                Parser MetadataObjId 'Both n (Maybe ())
errorsFieldParser
                FieldParser MetadataObjId n ()
-> AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)
-> FieldParser
     MetadataObjId
     n
     (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)
forall r. AsyncActionQueryFieldG r
IR.AsyncErrors
            outputField :: FieldParser
  MetadataObjId
  n
  (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
outputField =
              Name
-> Maybe Description
-> Parser MetadataObjId 'Output n AnnotatedActionFields
-> FieldParser MetadataObjId n AnnotatedActionFields
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> Parser origin 'Output m a
-> FieldParser origin m a
P.subselection_
                Name
Name._output
                (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"the output fields of this action")
                Parser MetadataObjId 'Output n AnnotatedActionFields
actionOutputParser
                FieldParser MetadataObjId n AnnotatedActionFields
-> (AnnotatedActionFields
    -> AsyncActionQueryFieldG
         (RemoteRelationshipField UnpreparedValue))
-> FieldParser
     MetadataObjId
     n
     (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> AnnotatedActionFields
-> AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)
forall r. ActionFieldsG r -> AsyncActionQueryFieldG r
IR.AsyncOutput
         in [FieldParser
  MetadataObjId
  n
  (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
idField, FieldParser
  MetadataObjId
  n
  (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
createdAtField, FieldParser
  MetadataObjId
  n
  (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
errorsField, FieldParser
  MetadataObjId
  n
  (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
outputField]
  FieldParser
  MetadataObjId
  n
  (ActionId,
   Fields
     (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
parserOutput <- case AnnotatedOutputType
outputObject of
    AOTObject AnnotatedObjectType
aot -> do
      Parser MetadataObjId 'Output n AnnotatedActionFields
actionOutputParser <- SchemaT r m (Parser MetadataObjId 'Output n AnnotatedActionFields)
-> MaybeT
     (SchemaT r m)
     (Parser MetadataObjId 'Output n AnnotatedActionFields)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchemaT r m (Parser MetadataObjId 'Output n AnnotatedActionFields)
 -> MaybeT
      (SchemaT r m)
      (Parser MetadataObjId 'Output n AnnotatedActionFields))
-> SchemaT
     r m (Parser MetadataObjId 'Output n AnnotatedActionFields)
-> MaybeT
     (SchemaT r m)
     (Parser MetadataObjId 'Output n AnnotatedActionFields)
forall a b. (a -> b) -> a -> b
$ GType
-> AnnotatedObjectType
-> HashMap Name AnnotatedObjectType
-> SchemaT
     r m (Parser MetadataObjId 'Output n AnnotatedActionFields)
forall r (m :: * -> *) (n :: * -> *).
MonadBuildActionSchema r m n =>
GType
-> AnnotatedObjectType
-> HashMap Name AnnotatedObjectType
-> SchemaT r m (Parser 'Output n AnnotatedActionFields)
actionOutputFields GType
outputType AnnotatedObjectType
aot HashMap Name AnnotatedObjectType
objectTypes
      let desc :: Description
desc = Text -> Description
G.Description (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
"fields of action: " Text -> ActionName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> ActionName
actionName
          selectionSet :: Parser
  MetadataObjId
  'Output
  n
  (Fields
     (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
selectionSet =
            -- Note: If we want support for Apollo Federation for Actions later,
            -- we'd need to add support for "key" directive here as well.
            Name
-> Maybe Description
-> [FieldParser
      MetadataObjId
      n
      (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))]
-> Parser
     MetadataObjId
     'Output
     n
     (InsOrdHashMap
        Name
        (ParsedSelection
           (AsyncActionQueryFieldG
              (RemoteRelationshipField UnpreparedValue))))
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> [FieldParser origin m a]
-> Parser origin 'Output m (InsOrdHashMap Name (ParsedSelection a))
P.selectionSet Name
outputTypeName (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
desc) (Parser MetadataObjId 'Output n AnnotatedActionFields
-> [FieldParser
      MetadataObjId
      n
      (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))]
allFieldParsers Parser MetadataObjId 'Output n AnnotatedActionFields
actionOutputParser)
              Parser
  MetadataObjId
  'Output
  n
  (InsOrdHashMap
     Name
     (ParsedSelection
        (AsyncActionQueryFieldG
           (RemoteRelationshipField UnpreparedValue))))
-> (InsOrdHashMap
      Name
      (ParsedSelection
         (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
    -> Fields
         (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
-> Parser
     MetadataObjId
     'Output
     n
     (Fields
        (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text
 -> AsyncActionQueryFieldG
      (RemoteRelationshipField UnpreparedValue))
-> InsOrdHashMap
     Name
     (ParsedSelection
        (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
-> Fields
     (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
forall a.
(Text -> a) -> InsOrdHashMap Name (ParsedSelection a) -> Fields a
parsedSelectionsToFields Text
-> AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)
forall r. Text -> AsyncActionQueryFieldG r
IR.AsyncTypename
      FieldParser
  MetadataObjId
  n
  (ActionId,
   Fields
     (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        MetadataObjId
        n
        (ActionId,
         Fields
           (AsyncActionQueryFieldG
              (RemoteRelationshipField UnpreparedValue))))
forall a. a -> MaybeT (SchemaT r m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldParser
   MetadataObjId
   n
   (ActionId,
    Fields
      (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
 -> MaybeT
      (SchemaT r m)
      (FieldParser
         MetadataObjId
         n
         (ActionId,
          Fields
            (AsyncActionQueryFieldG
               (RemoteRelationshipField UnpreparedValue)))))
-> FieldParser
     MetadataObjId
     n
     (ActionId,
      Fields
        (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        MetadataObjId
        n
        (ActionId,
         Fields
           (AsyncActionQueryFieldG
              (RemoteRelationshipField UnpreparedValue))))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> InputFieldsParser MetadataObjId n ActionId
-> Parser
     MetadataObjId
     'Output
     n
     (Fields
        (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
-> FieldParser
     MetadataObjId
     n
     (ActionId,
      Fields
        (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Output m b
-> FieldParser origin m (a, b)
P.subselection Name
fieldName Maybe Description
description InputFieldsParser MetadataObjId n ActionId
actionIdInputField Parser
  MetadataObjId
  'Output
  n
  (Fields
     (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
selectionSet
    AOTScalar AnnotatedScalarType
ast -> do
      let selectionSet :: Parser 'Both n Value
selectionSet = AnnotatedScalarType -> Parser 'Both n Value
forall (m :: * -> *).
MonadParse m =>
AnnotatedScalarType -> Parser 'Both m Value
customScalarParser AnnotatedScalarType
ast
      FieldParser
  MetadataObjId
  n
  (ActionId,
   Fields
     (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        MetadataObjId
        n
        (ActionId,
         Fields
           (AsyncActionQueryFieldG
              (RemoteRelationshipField UnpreparedValue))))
forall a. a -> MaybeT (SchemaT r m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldParser
   MetadataObjId
   n
   (ActionId,
    Fields
      (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
 -> MaybeT
      (SchemaT r m)
      (FieldParser
         MetadataObjId
         n
         (ActionId,
          Fields
            (AsyncActionQueryFieldG
               (RemoteRelationshipField UnpreparedValue)))))
-> FieldParser
     MetadataObjId
     n
     (ActionId,
      Fields
        (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        MetadataObjId
        n
        (ActionId,
         Fields
           (AsyncActionQueryFieldG
              (RemoteRelationshipField UnpreparedValue))))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> InputFieldsParser MetadataObjId n ActionId
-> Parser 'Both n Value
-> FieldParser MetadataObjId n ActionId
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Both m b
-> FieldParser origin m a
P.selection Name
fieldName Maybe Description
description InputFieldsParser MetadataObjId n ActionId
actionIdInputField Parser 'Both n Value
selectionSet FieldParser MetadataObjId n ActionId
-> (ActionId
    -> (ActionId,
        Fields
          (AsyncActionQueryFieldG
             (RemoteRelationshipField UnpreparedValue))))
-> FieldParser
     MetadataObjId
     n
     (ActionId,
      Fields
        (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,[])

  StringifyNumbers
stringifyNumbers <- (SchemaOptions -> StringifyNumbers)
-> MaybeT (SchemaT r m) StringifyNumbers
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaOptions -> StringifyNumbers
Options.soStringifyNumbers
  [(PGCol, PGScalarType)]
definitionsList <- SchemaT r m [(PGCol, ScalarType ('Postgres 'Vanilla))]
-> MaybeT (SchemaT r m) [(PGCol, ScalarType ('Postgres 'Vanilla))]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchemaT r m [(PGCol, ScalarType ('Postgres 'Vanilla))]
 -> MaybeT (SchemaT r m) [(PGCol, ScalarType ('Postgres 'Vanilla))])
-> SchemaT r m [(PGCol, ScalarType ('Postgres 'Vanilla))]
-> MaybeT (SchemaT r m) [(PGCol, ScalarType ('Postgres 'Vanilla))]
forall a b. (a -> b) -> a -> b
$ AnnotatedOutputType
-> SchemaT r m [(PGCol, ScalarType ('Postgres 'Vanilla))]
mkDefinitionList AnnotatedOutputType
outputObject
  FieldParser
  n
  (AnnActionAsyncQuery
     ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (AnnActionAsyncQuery
           ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue)))
forall a. a -> MaybeT (SchemaT r m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (FieldParser
   n
   (AnnActionAsyncQuery
      ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue))
 -> MaybeT
      (SchemaT r m)
      (FieldParser
         n
         (AnnActionAsyncQuery
            ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue))))
-> FieldParser
     n
     (AnnActionAsyncQuery
        ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (AnnActionAsyncQuery
           ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue)))
forall a b. (a -> b) -> a -> b
$ FieldParser
  MetadataObjId
  n
  (ActionId,
   Fields
     (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
parserOutput
    FieldParser
  MetadataObjId
  n
  (ActionId,
   Fields
     (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
-> ((ActionId,
     Fields
       (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)))
    -> AnnActionAsyncQuery
         ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue))
-> FieldParser
     n
     (AnnActionAsyncQuery
        ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(ActionId
idArg, Fields
  (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
fields) ->
      IR.AnnActionAsyncQuery
        { _aaaqName :: ActionName
_aaaqName = ActionName
actionName,
          _aaaqActionId :: ActionId
_aaaqActionId = ActionId
idArg,
          _aaaqOutputType :: GraphQLType
_aaaqOutputType = ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> GraphQLType
forall arg webhook. ActionDefinition arg webhook -> GraphQLType
_adOutputType ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
definition,
          _aaaqFields :: Fields
  (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
_aaaqFields = Fields
  (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
fields,
          _aaaqDefinitionList :: [(Column ('Postgres 'Vanilla), ScalarType ('Postgres 'Vanilla))]
_aaaqDefinitionList = [(Column ('Postgres 'Vanilla), ScalarType ('Postgres 'Vanilla))]
[(PGCol, PGScalarType)]
definitionsList,
          _aaaqStringifyNum :: StringifyNumbers
_aaaqStringifyNum = StringifyNumbers
stringifyNumbers,
          _aaaqForwardClientHeaders :: Bool
_aaaqForwardClientHeaders = Bool
forwardClientHeaders,
          _aaaqSource :: ActionSourceInfo ('Postgres 'Vanilla)
_aaaqSource = AnnotatedOutputType -> ActionSourceInfo ('Postgres 'Vanilla)
getActionSourceInfo AnnotatedOutputType
outputObject
        }
  where
    -- For historical reasons, we use postgres-specific scalar names for two
    -- specific output fields. To avoid calling all the postgres schema
    -- machienry (especially since we are not currently associated with a given
    -- PG source), we manually craft the corresponding output parsers.
    --
    -- Since we know that those parsers are only used for output scalar fields,
    -- we don't care about their output value: they are not used to parse input
    -- values, nor do they have a selection set to process.
    mkOutputParser :: forall m'. (MonadError QErr m') => PGScalarType -> m' (Parser 'Both n ())
    mkOutputParser :: forall (m' :: * -> *).
MonadError QErr m' =>
PGScalarType -> m' (Parser 'Both n ())
mkOutputParser PGScalarType
scalarType = do
      Name
gName <- PGScalarType -> m' Name
forall (m :: * -> *). MonadError QErr m => PGScalarType -> m Name
mkScalarTypeName PGScalarType
scalarType
      Parser 'Both n () -> m' (Parser 'Both n ())
forall a. a -> m' a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser 'Both n () -> m' (Parser 'Both n ()))
-> Parser 'Both n () -> m' (Parser 'Both n ())
forall a b. (a -> b) -> a -> b
$ Name -> (InputValue Variable -> n ()) -> Parser 'Both n ()
forall (m :: * -> *) a origin.
MonadParse m =>
Name -> (InputValue Variable -> m a) -> Parser origin 'Both m a
mkScalar Name
gName ((InputValue Variable -> n ()) -> Parser 'Both n ())
-> (InputValue Variable -> n ()) -> Parser 'Both n ()
forall a b. (a -> b) -> a -> b
$ n () -> InputValue Variable -> n ()
forall a b. a -> b -> a
const (n () -> InputValue Variable -> n ())
-> n () -> InputValue Variable -> n ()
forall a b. (a -> b) -> a -> b
$ () -> n ()
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    ActionInfo ActionName
actionName (GType
outputType, AnnotatedOutputType
outputObject) ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
definition HashMap RoleName ActionPermissionInfo
permissions Bool
forwardClientHeaders Maybe Text
comment = ActionInfo
actionInfo
    idFieldName :: Name
idFieldName = Name
Name._id
    idFieldDescription :: Description
idFieldDescription = Description
"the unique id of an action"

    getActionSourceInfo :: AnnotatedOutputType -> IR.ActionSourceInfo ('Postgres 'Vanilla)
    getActionSourceInfo :: AnnotatedOutputType -> ActionSourceInfo ('Postgres 'Vanilla)
getActionSourceInfo = \case
      AOTObject AnnotatedObjectType
aot -> ActionSourceInfo ('Postgres 'Vanilla)
-> Maybe (ActionSourceInfo ('Postgres 'Vanilla))
-> ActionSourceInfo ('Postgres 'Vanilla)
forall a. a -> Maybe a -> a
fromMaybe ActionSourceInfo ('Postgres 'Vanilla)
forall (b :: BackendType). ActionSourceInfo b
IR.ASINoSource (Maybe (ActionSourceInfo ('Postgres 'Vanilla))
 -> ActionSourceInfo ('Postgres 'Vanilla))
-> Maybe (ActionSourceInfo ('Postgres 'Vanilla))
-> ActionSourceInfo ('Postgres 'Vanilla)
forall a b. (a -> b) -> a -> b
$ [ActionSourceInfo ('Postgres 'Vanilla)]
-> Maybe (ActionSourceInfo ('Postgres 'Vanilla))
forall a. [a] -> Maybe a
listToMaybe do
        AnnotatedTypeRelationship {HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
SourceName
RelType
SourceConfig ('Postgres 'Vanilla)
TableName ('Postgres 'Vanilla)
RelationshipName
_atrName :: RelationshipName
_atrType :: RelType
_atrSource :: SourceName
_atrSourceConfig :: SourceConfig ('Postgres 'Vanilla)
_atrTableName :: TableName ('Postgres 'Vanilla)
_atrFieldMapping :: HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
_atrName :: AnnotatedTypeRelationship -> RelationshipName
_atrType :: AnnotatedTypeRelationship -> RelType
_atrSource :: AnnotatedTypeRelationship -> SourceName
_atrSourceConfig :: AnnotatedTypeRelationship -> SourceConfig ('Postgres 'Vanilla)
_atrTableName :: AnnotatedTypeRelationship -> TableName ('Postgres 'Vanilla)
_atrFieldMapping :: AnnotatedTypeRelationship
-> HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
..} <- AnnotatedObjectType -> [AnnotatedTypeRelationship]
_aotRelationships AnnotatedObjectType
aot
        ActionSourceInfo ('Postgres 'Vanilla)
-> [ActionSourceInfo ('Postgres 'Vanilla)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionSourceInfo ('Postgres 'Vanilla)
 -> [ActionSourceInfo ('Postgres 'Vanilla)])
-> ActionSourceInfo ('Postgres 'Vanilla)
-> [ActionSourceInfo ('Postgres 'Vanilla)]
forall a b. (a -> b) -> a -> b
$ SourceName
-> SourceConfig ('Postgres 'Vanilla)
-> ActionSourceInfo ('Postgres 'Vanilla)
forall (b :: BackendType).
SourceName -> SourceConfig b -> ActionSourceInfo b
IR.ASISource SourceName
_atrSource SourceConfig ('Postgres 'Vanilla)
_atrSourceConfig
      AOTScalar AnnotatedScalarType
_ -> ActionSourceInfo ('Postgres 'Vanilla)
forall (b :: BackendType). ActionSourceInfo b
IR.ASINoSource

    mkDefinitionList :: AnnotatedOutputType -> SchemaT r m [(PGCol, ScalarType ('Postgres 'Vanilla))]
    mkDefinitionList :: AnnotatedOutputType
-> SchemaT r m [(PGCol, ScalarType ('Postgres 'Vanilla))]
mkDefinitionList = \case
      AOTScalar AnnotatedScalarType
_ -> [(PGCol, PGScalarType)] -> SchemaT r m [(PGCol, PGScalarType)]
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      AOTObject AnnotatedObjectType {[AnnotatedTypeRelationship]
Maybe Description
NonEmpty (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
ObjectTypeName
_aotRelationships :: AnnotatedObjectType -> [AnnotatedTypeRelationship]
_aotName :: ObjectTypeName
_aotDescription :: Maybe Description
_aotFields :: NonEmpty (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
_aotRelationships :: [AnnotatedTypeRelationship]
_aotName :: AnnotatedObjectType -> ObjectTypeName
_aotDescription :: AnnotatedObjectType -> Maybe Description
_aotFields :: AnnotatedObjectType
-> NonEmpty
     (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
..} -> do
        let fieldReferences :: HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
fieldReferences = [HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))]
-> HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
HashMap.unions ([HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))]
 -> HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla)))
-> [HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))]
-> HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ (AnnotatedTypeRelationship
 -> HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla)))
-> [AnnotatedTypeRelationship]
-> [HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))]
forall a b. (a -> b) -> [a] -> [b]
map AnnotatedTypeRelationship
-> HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
_atrFieldMapping [AnnotatedTypeRelationship]
_aotRelationships
        [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
-> (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
    -> SchemaT r m (PGCol, PGScalarType))
-> SchemaT r m [(PGCol, PGScalarType)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (NonEmpty (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
-> [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
_aotFields) \ObjectFieldDefinition {Maybe Value
Maybe Description
(GType, AnnotatedObjectFieldType)
ObjectFieldName
_ofdName :: ObjectFieldName
_ofdArguments :: Maybe Value
_ofdDescription :: Maybe Description
_ofdType :: (GType, AnnotatedObjectFieldType)
_ofdName :: forall field. ObjectFieldDefinition field -> ObjectFieldName
_ofdArguments :: forall field. ObjectFieldDefinition field -> Maybe Value
_ofdDescription :: forall field. ObjectFieldDefinition field -> Maybe Description
_ofdType :: forall field. ObjectFieldDefinition field -> field
..} ->
          (Text -> PGCol
unsafePGCol (Text -> PGCol)
-> (ObjectFieldName -> Text) -> ObjectFieldName -> PGCol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
G.unName (Name -> Text)
-> (ObjectFieldName -> Name) -> ObjectFieldName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectFieldName -> Name
unObjectFieldName (ObjectFieldName -> PGCol) -> ObjectFieldName -> PGCol
forall a b. (a -> b) -> a -> b
$ ObjectFieldName
_ofdName,)
            (PGScalarType -> (PGCol, PGScalarType))
-> SchemaT r m PGScalarType -> SchemaT r m (PGCol, PGScalarType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ObjectFieldName
-> HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
-> Maybe (ColumnInfo ('Postgres 'Vanilla))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup ObjectFieldName
_ofdName HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
fieldReferences of
              Maybe (ColumnInfo ('Postgres 'Vanilla))
Nothing -> AnnotatedObjectFieldType -> SchemaT r m PGScalarType
fieldTypeToScalarType (AnnotatedObjectFieldType -> SchemaT r m PGScalarType)
-> AnnotatedObjectFieldType -> SchemaT r m PGScalarType
forall a b. (a -> b) -> a -> b
$ (GType, AnnotatedObjectFieldType) -> AnnotatedObjectFieldType
forall a b. (a, b) -> b
snd (GType, AnnotatedObjectFieldType)
_ofdType
              Just ColumnInfo ('Postgres 'Vanilla)
columnInfo -> PGScalarType -> SchemaT r m PGScalarType
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PGScalarType -> SchemaT r m PGScalarType)
-> PGScalarType -> SchemaT r m PGScalarType
forall a b. (a -> b) -> a -> b
$ ColumnType ('Postgres 'Vanilla) -> PGScalarType
forall (pgKind :: PostgresKind).
ColumnType ('Postgres pgKind) -> PGScalarType
unsafePGColumnToBackend (ColumnType ('Postgres 'Vanilla) -> PGScalarType)
-> ColumnType ('Postgres 'Vanilla) -> PGScalarType
forall a b. (a -> b) -> a -> b
$ ColumnInfo ('Postgres 'Vanilla) -> ColumnType ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo ('Postgres 'Vanilla)
columnInfo

    -- warning: we don't support other backends than Postgres for async queries;
    -- here, we fail if we encounter a non-Postgres scalar type
    fieldTypeToScalarType :: AnnotatedObjectFieldType -> SchemaT r m PGScalarType
    fieldTypeToScalarType :: AnnotatedObjectFieldType -> SchemaT r m PGScalarType
fieldTypeToScalarType = \case
      AOFTEnum EnumTypeDefinition
_ -> PGScalarType -> SchemaT r m PGScalarType
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PGScalarType
PGText
      AOFTObject Name
_ -> PGScalarType -> SchemaT r m PGScalarType
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PGScalarType
PGJSON
      AOFTScalar AnnotatedScalarType
annotatedScalar -> case AnnotatedScalarType
annotatedScalar of
        ASTReusedScalar Name
_ AnyBackend ScalarWrapper
scalar ->
          case forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend @('Postgres 'Vanilla) AnyBackend ScalarWrapper
scalar of
            Just ScalarWrapper ('Postgres 'Vanilla)
pgScalar -> PGScalarType -> SchemaT r m PGScalarType
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PGScalarType -> SchemaT r m PGScalarType)
-> PGScalarType -> SchemaT r m PGScalarType
forall a b. (a -> b) -> a -> b
$ ScalarWrapper ('Postgres 'Vanilla)
-> ScalarType ('Postgres 'Vanilla)
forall (b :: BackendType). ScalarWrapper b -> ScalarType b
unwrapScalar ScalarWrapper ('Postgres 'Vanilla)
pgScalar
            Maybe (ScalarWrapper ('Postgres 'Vanilla))
Nothing -> Text -> SchemaT r m PGScalarType
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"encountered non-Postgres scalar in async query actions"
        ASTCustom ScalarTypeDefinition {Maybe Description
Name
_stdName :: Name
_stdDescription :: Maybe Description
_stdName :: ScalarTypeDefinition -> Name
_stdDescription :: ScalarTypeDefinition -> Maybe Description
..} ->
          PGScalarType -> SchemaT r m PGScalarType
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (PGScalarType -> SchemaT r m PGScalarType)
-> PGScalarType -> SchemaT r m PGScalarType
forall a b. (a -> b) -> a -> b
$ if
              | Name
_stdName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
GName._ID -> PGScalarType
PGText
              | Name
_stdName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
GName._Int -> PGScalarType
PGInteger
              | Name
_stdName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
GName._Float -> PGScalarType
PGFloat
              | Name
_stdName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
GName._String -> PGScalarType
PGText
              | Name
_stdName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
GName._Boolean -> PGScalarType
PGBoolean
              | Bool
otherwise -> PGScalarType
PGJSON

-- | Async action's unique id
actionIdParser :: (MonadParse n) => Parser 'Both n ActionId
actionIdParser :: forall (n :: * -> *). MonadParse n => Parser 'Both n ActionId
actionIdParser = UUID -> ActionId
ActionId (UUID -> ActionId)
-> Parser MetadataObjId 'Both n UUID
-> Parser MetadataObjId 'Both n ActionId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n UUID
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m UUID
P.uuid

actionOutputFields ::
  forall r m n.
  (MonadBuildActionSchema r m n) =>
  G.GType ->
  AnnotatedObjectType ->
  HashMap G.Name AnnotatedObjectType ->
  SchemaT r m (Parser 'Output n (AnnotatedActionFields))
actionOutputFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildActionSchema r m n =>
GType
-> AnnotatedObjectType
-> HashMap Name AnnotatedObjectType
-> SchemaT r m (Parser 'Output n AnnotatedActionFields)
actionOutputFields GType
outputType AnnotatedObjectType
annotatedObject HashMap Name AnnotatedObjectType
objectTypes = do
  [FieldParser n AnnotatedActionField]
scalarOrEnumOrObjectFields <- [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
-> (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
    -> SchemaT r m (FieldParser n AnnotatedActionField))
-> SchemaT r m [FieldParser n AnnotatedActionField]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (NonEmpty (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
-> [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
 -> [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)])
-> NonEmpty
     (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
-> [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
forall a b. (a -> b) -> a -> b
$ AnnotatedObjectType
-> NonEmpty
     (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
_aotFields AnnotatedObjectType
annotatedObject) ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
-> SchemaT r m (FieldParser n AnnotatedActionField)
outputFieldParser
  [Maybe [FieldParser n AnnotatedActionField]]
relationshipFields <- (AnnotatedTypeRelationship
 -> SchemaT r m (Maybe [FieldParser n AnnotatedActionField]))
-> [AnnotatedTypeRelationship]
-> SchemaT r m [Maybe [FieldParser n AnnotatedActionField]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse AnnotatedTypeRelationship
-> SchemaT r m (Maybe [FieldParser n AnnotatedActionField])
relationshipFieldParser ([AnnotatedTypeRelationship]
 -> SchemaT r m [Maybe [FieldParser n AnnotatedActionField]])
-> [AnnotatedTypeRelationship]
-> SchemaT r m [Maybe [FieldParser n AnnotatedActionField]]
forall a b. (a -> b) -> a -> b
$ AnnotatedObjectType -> [AnnotatedTypeRelationship]
_aotRelationships AnnotatedObjectType
annotatedObject
  let outputTypeName :: Name
outputTypeName = ObjectTypeName -> Name
unObjectTypeName (ObjectTypeName -> Name) -> ObjectTypeName -> Name
forall a b. (a -> b) -> a -> b
$ AnnotatedObjectType -> ObjectTypeName
_aotName AnnotatedObjectType
annotatedObject
      allFieldParsers :: [FieldParser n AnnotatedActionField]
allFieldParsers =
        [FieldParser n AnnotatedActionField]
scalarOrEnumOrObjectFields
          [FieldParser n AnnotatedActionField]
-> [FieldParser n AnnotatedActionField]
-> [FieldParser n AnnotatedActionField]
forall a. Semigroup a => a -> a -> a
<> [[FieldParser n AnnotatedActionField]]
-> [FieldParser n AnnotatedActionField]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Maybe [FieldParser n AnnotatedActionField]]
-> [[FieldParser n AnnotatedActionField]]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe [FieldParser n AnnotatedActionField]]
relationshipFields)
      outputTypeDescription :: Maybe Description
outputTypeDescription = AnnotatedObjectType -> Maybe Description
_aotDescription AnnotatedObjectType
annotatedObject
  Parser 'Output n AnnotatedActionFields
-> SchemaT r m (Parser 'Output n AnnotatedActionFields)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Parser 'Output n AnnotatedActionFields
 -> SchemaT r m (Parser 'Output n AnnotatedActionFields))
-> Parser 'Output n AnnotatedActionFields
-> SchemaT r m (Parser 'Output n AnnotatedActionFields)
forall a b. (a -> b) -> a -> b
$ GType
-> Parser 'Output n AnnotatedActionFields
-> Parser 'Output n AnnotatedActionFields
forall a. GType -> Parser 'Output n a -> Parser 'Output n a
outputParserModifier GType
outputType
    (Parser 'Output n AnnotatedActionFields
 -> Parser 'Output n AnnotatedActionFields)
-> Parser 'Output n AnnotatedActionFields
-> Parser 'Output n AnnotatedActionFields
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> [FieldParser n AnnotatedActionField]
-> Parser
     MetadataObjId
     'Output
     n
     (InsOrdHashMap Name (ParsedSelection AnnotatedActionField))
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> [FieldParser origin m a]
-> Parser origin 'Output m (InsOrdHashMap Name (ParsedSelection a))
P.selectionSet Name
outputTypeName Maybe Description
outputTypeDescription [FieldParser n AnnotatedActionField]
allFieldParsers
    Parser
  MetadataObjId
  'Output
  n
  (InsOrdHashMap Name (ParsedSelection AnnotatedActionField))
-> (InsOrdHashMap Name (ParsedSelection AnnotatedActionField)
    -> AnnotatedActionFields)
-> Parser 'Output n AnnotatedActionFields
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> AnnotatedActionField)
-> InsOrdHashMap Name (ParsedSelection AnnotatedActionField)
-> AnnotatedActionFields
forall a.
(Text -> a) -> InsOrdHashMap Name (ParsedSelection a) -> Fields a
parsedSelectionsToFields Text -> AnnotatedActionField
forall r. Text -> ActionFieldG r
IR.ACFExpression
  where
    outputParserModifier :: G.GType -> Parser 'Output n a -> Parser 'Output n a
    outputParserModifier :: forall a. GType -> Parser 'Output n a -> Parser 'Output n a
outputParserModifier = \case
      G.TypeNamed (G.Nullability Bool
True) Name
_ -> Parser 'Output n a -> Parser 'Output n a
forall (m :: * -> *) origin (k :: Kind) a.
Parser origin k m a -> Parser origin k m a
P.nullableParser
      G.TypeNamed (G.Nullability Bool
False) Name
_ -> Parser 'Output n a -> Parser 'Output n a
forall (m :: * -> *) origin (k :: Kind) a.
Parser origin k m a -> Parser origin k m a
P.nonNullableParser
      G.TypeList (G.Nullability Bool
True) GType
t -> Parser 'Output n a -> Parser 'Output n a
forall (m :: * -> *) origin (k :: Kind) a.
Parser origin k m a -> Parser origin k m a
P.nullableParser (Parser 'Output n a -> Parser 'Output n a)
-> (Parser 'Output n a -> Parser 'Output n a)
-> Parser 'Output n a
-> Parser 'Output n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser 'Output n a -> Parser 'Output n a
forall (m :: * -> *) origin a.
Parser origin 'Output m a -> Parser origin 'Output m a
P.multiple (Parser 'Output n a -> Parser 'Output n a)
-> (Parser 'Output n a -> Parser 'Output n a)
-> Parser 'Output n a
-> Parser 'Output n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GType -> Parser 'Output n a -> Parser 'Output n a
forall a. GType -> Parser 'Output n a -> Parser 'Output n a
outputParserModifier GType
t
      G.TypeList (G.Nullability Bool
False) GType
t -> Parser 'Output n a -> Parser 'Output n a
forall (m :: * -> *) origin (k :: Kind) a.
Parser origin k m a -> Parser origin k m a
P.nonNullableParser (Parser 'Output n a -> Parser 'Output n a)
-> (Parser 'Output n a -> Parser 'Output n a)
-> Parser 'Output n a
-> Parser 'Output n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser 'Output n a -> Parser 'Output n a
forall (m :: * -> *) origin a.
Parser origin 'Output m a -> Parser origin 'Output m a
P.multiple (Parser 'Output n a -> Parser 'Output n a)
-> (Parser 'Output n a -> Parser 'Output n a)
-> Parser 'Output n a
-> Parser 'Output n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GType -> Parser 'Output n a -> Parser 'Output n a
forall a. GType -> Parser 'Output n a -> Parser 'Output n a
outputParserModifier GType
t

    outputFieldParser ::
      ObjectFieldDefinition (G.GType, AnnotatedObjectFieldType) ->
      SchemaT r m (FieldParser n (AnnotatedActionField))
    outputFieldParser :: ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
-> SchemaT r m (FieldParser n AnnotatedActionField)
outputFieldParser (ObjectFieldDefinition ObjectFieldName
name Maybe Value
_ Maybe Description
description (GType
gType, AnnotatedObjectFieldType
objectFieldType)) = Name
-> (ObjectTypeName, ObjectFieldName)
-> SchemaT r m (FieldParser n AnnotatedActionField)
-> SchemaT r m (FieldParser n AnnotatedActionField)
forall (m :: * -> *) a (p :: (* -> *) -> * -> *) (n :: * -> *) b.
(MonadMemoize m, Ord a, Typeable a, Typeable p, MonadParse n,
 Typeable b) =>
Name -> a -> m (p n b) -> m (p n b)
P.memoizeOn 'actionOutputFields (AnnotatedObjectType -> ObjectTypeName
_aotName AnnotatedObjectType
annotatedObject, ObjectFieldName
name) do
      case AnnotatedObjectFieldType
objectFieldType of
        AOFTScalar AnnotatedScalarType
def ->
          Parser MetadataObjId 'Both n Value
-> SchemaT r m (FieldParser n AnnotatedActionField)
wrapScalar (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (FieldParser n AnnotatedActionField))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (FieldParser n AnnotatedActionField)
forall a b. (a -> b) -> a -> b
$ AnnotatedScalarType -> Parser MetadataObjId 'Both n Value
forall (m :: * -> *).
MonadParse m =>
AnnotatedScalarType -> Parser 'Both m Value
customScalarParser AnnotatedScalarType
def
        AOFTEnum EnumTypeDefinition
def ->
          Parser MetadataObjId 'Both n Value
-> SchemaT r m (FieldParser n AnnotatedActionField)
wrapScalar (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (FieldParser n AnnotatedActionField))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (FieldParser n AnnotatedActionField)
forall a b. (a -> b) -> a -> b
$ EnumTypeDefinition -> Parser MetadataObjId 'Both n Value
forall (m :: * -> *).
MonadParse m =>
EnumTypeDefinition -> Parser 'Both m Value
customEnumParser EnumTypeDefinition
def
        AOFTObject Name
objectName -> do
          AnnotatedObjectType
def <- Name
-> HashMap Name AnnotatedObjectType -> Maybe AnnotatedObjectType
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
objectName HashMap Name AnnotatedObjectType
objectTypes Maybe AnnotatedObjectType
-> SchemaT r m AnnotatedObjectType
-> SchemaT r m AnnotatedObjectType
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> SchemaT r m AnnotatedObjectType
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
"Custom type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
objectName Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found")
          Parser MetadataObjId 'Output n AnnotatedActionField
parser <- (AnnotatedActionFields -> AnnotatedActionField)
-> Parser 'Output n AnnotatedActionFields
-> Parser MetadataObjId 'Output n AnnotatedActionField
forall a b.
(a -> b)
-> Parser MetadataObjId 'Output n a
-> Parser MetadataObjId 'Output n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> AnnotatedActionFields -> AnnotatedActionField
forall r. Name -> ActionFieldsG r -> ActionFieldG r
IR.ACFNestedObject Name
fieldName) (Parser 'Output n AnnotatedActionFields
 -> Parser MetadataObjId 'Output n AnnotatedActionField)
-> SchemaT r m (Parser 'Output n AnnotatedActionFields)
-> SchemaT
     r m (Parser MetadataObjId 'Output n AnnotatedActionField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GType
-> AnnotatedObjectType
-> HashMap Name AnnotatedObjectType
-> SchemaT r m (Parser 'Output n AnnotatedActionFields)
forall r (m :: * -> *) (n :: * -> *).
MonadBuildActionSchema r m n =>
GType
-> AnnotatedObjectType
-> HashMap Name AnnotatedObjectType
-> SchemaT r m (Parser 'Output n AnnotatedActionFields)
actionOutputFields GType
gType AnnotatedObjectType
def HashMap Name AnnotatedObjectType
objectTypes
          FieldParser n AnnotatedActionField
-> SchemaT r m (FieldParser n AnnotatedActionField)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldParser n AnnotatedActionField
 -> SchemaT r m (FieldParser n AnnotatedActionField))
-> FieldParser n AnnotatedActionField
-> SchemaT r m (FieldParser n AnnotatedActionField)
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> Parser MetadataObjId 'Output n AnnotatedActionField
-> FieldParser n AnnotatedActionField
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> Parser origin 'Output m a
-> FieldParser origin m a
P.subselection_ Name
fieldName Maybe Description
description Parser MetadataObjId 'Output n AnnotatedActionField
parser
      where
        fieldName :: Name
fieldName = ObjectFieldName -> Name
unObjectFieldName ObjectFieldName
name
        wrapScalar :: Parser MetadataObjId 'Both n Value
-> SchemaT r m (FieldParser n AnnotatedActionField)
wrapScalar Parser MetadataObjId 'Both n Value
parser =
          FieldParser n AnnotatedActionField
-> SchemaT r m (FieldParser n AnnotatedActionField)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (FieldParser n AnnotatedActionField
 -> SchemaT r m (FieldParser n AnnotatedActionField))
-> FieldParser n AnnotatedActionField
-> SchemaT r m (FieldParser n AnnotatedActionField)
forall a b. (a -> b) -> a -> b
$ GType
-> FieldParser MetadataObjId n () -> FieldParser MetadataObjId n ()
forall (m :: * -> *) origin a.
GType -> FieldParser origin m a -> FieldParser origin m a
P.wrapFieldParser GType
gType (Name
-> Maybe Description
-> Parser MetadataObjId 'Both n Value
-> FieldParser MetadataObjId n ()
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> Parser origin 'Both m a
-> FieldParser origin m ()
P.selection_ Name
fieldName Maybe Description
description Parser MetadataObjId 'Both n Value
parser)
            FieldParser MetadataObjId n ()
-> AnnotatedActionField -> FieldParser n AnnotatedActionField
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Name -> AnnotatedActionField
forall r. Name -> ActionFieldG r
IR.ACFScalar Name
fieldName

    relationshipFieldParser ::
      AnnotatedTypeRelationship ->
      SchemaT r m (Maybe [FieldParser n (AnnotatedActionField)])
    relationshipFieldParser :: AnnotatedTypeRelationship
-> SchemaT r m (Maybe [FieldParser n AnnotatedActionField])
relationshipFieldParser (AnnotatedTypeRelationship {HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
SourceName
RelType
SourceConfig ('Postgres 'Vanilla)
TableName ('Postgres 'Vanilla)
RelationshipName
_atrName :: AnnotatedTypeRelationship -> RelationshipName
_atrType :: AnnotatedTypeRelationship -> RelType
_atrSource :: AnnotatedTypeRelationship -> SourceName
_atrSourceConfig :: AnnotatedTypeRelationship -> SourceConfig ('Postgres 'Vanilla)
_atrTableName :: AnnotatedTypeRelationship -> TableName ('Postgres 'Vanilla)
_atrFieldMapping :: AnnotatedTypeRelationship
-> HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
_atrName :: RelationshipName
_atrType :: RelType
_atrSource :: SourceName
_atrSourceConfig :: SourceConfig ('Postgres 'Vanilla)
_atrTableName :: TableName ('Postgres 'Vanilla)
_atrFieldMapping :: HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
..}) = MaybeT (SchemaT r m) [FieldParser n AnnotatedActionField]
-> SchemaT r m (Maybe [FieldParser n AnnotatedActionField])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
      RelName
relName <- Maybe RelName -> MaybeT (SchemaT r m) RelName
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe RelName -> MaybeT (SchemaT r m) RelName)
-> Maybe RelName -> MaybeT (SchemaT r m) RelName
forall a b. (a -> b) -> a -> b
$ NonEmptyText -> RelName
RelName (NonEmptyText -> RelName) -> Maybe NonEmptyText -> Maybe RelName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe NonEmptyText
mkNonEmptyText (RelationshipName -> Text
forall a. ToTxt a => a -> Text
toTxt RelationshipName
_atrName)

      --  `lhsJoinFields` is a map of `x: y`
      --  where 'x' is the 'reference name' of a join field, i.e, how a join
      --         field is referenced in the remote relationships definition
      --  while 'y' is the join field.
      --  In case of logical models, they are pretty much the same.
      --  In case of databases, 'y' could be a computed field with session variables etc.
      let lhsJoinFields :: HashMap FieldName Name
lhsJoinFields = [(FieldName, Name)] -> HashMap FieldName Name
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text -> FieldName
FieldName (Text -> FieldName) -> Text -> FieldName
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName Name
k, Name
k) | ObjectFieldName Name
k <- HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
-> [ObjectFieldName]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
_atrFieldMapping]
          joinMapping :: HashMap FieldName (PGScalarType, PGCol)
joinMapping = [(FieldName, (PGScalarType, PGCol))]
-> HashMap FieldName (PGScalarType, PGCol)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(FieldName, (PGScalarType, PGCol))]
 -> HashMap FieldName (PGScalarType, PGCol))
-> [(FieldName, (PGScalarType, PGCol))]
-> HashMap FieldName (PGScalarType, PGCol)
forall a b. (a -> b) -> a -> b
$ do
            (ObjectFieldName
k, ColumnInfo ('Postgres 'Vanilla)
v) <- HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
-> [(ObjectFieldName, ColumnInfo ('Postgres 'Vanilla))]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
_atrFieldMapping
            let scalarType :: ScalarType ('Postgres 'Vanilla)
scalarType = case ColumnInfo ('Postgres 'Vanilla) -> ColumnType ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo ('Postgres 'Vanilla)
v of
                  ColumnScalar ScalarType ('Postgres 'Vanilla)
scalar -> ScalarType ('Postgres 'Vanilla)
scalar
                  -- We don't currently allow enum types as fields of logical models so they should not appear here.
                  -- If we do allow them in future then they would be represented in Postgres as Text.
                  ColumnEnumReference EnumReference ('Postgres 'Vanilla)
_ -> ScalarType ('Postgres 'Vanilla)
PGScalarType
PGText
            (FieldName, (PGScalarType, PGCol))
-> [(FieldName, (PGScalarType, PGCol))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> FieldName
FieldName (Text -> FieldName) -> Text -> FieldName
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ ObjectFieldName -> Name
unObjectFieldName ObjectFieldName
k, (ScalarType ('Postgres 'Vanilla)
PGScalarType
scalarType, ColumnInfo ('Postgres 'Vanilla) -> Column ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres 'Vanilla)
v))
          remoteFieldInfo :: RemoteFieldInfo Name
remoteFieldInfo =
            RemoteFieldInfo
              { _rfiLHS :: HashMap FieldName Name
_rfiLHS = HashMap FieldName Name
lhsJoinFields,
                _rfiRHS :: RemoteFieldInfoRHS
_rfiRHS =
                  AnyBackend RemoteSourceFieldInfo -> RemoteFieldInfoRHS
RFISource
                    (AnyBackend RemoteSourceFieldInfo -> RemoteFieldInfoRHS)
-> AnyBackend RemoteSourceFieldInfo -> RemoteFieldInfoRHS
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend @('Postgres 'Vanilla)
                    (RemoteSourceFieldInfo ('Postgres 'Vanilla)
 -> AnyBackend RemoteSourceFieldInfo)
-> RemoteSourceFieldInfo ('Postgres 'Vanilla)
-> AnyBackend RemoteSourceFieldInfo
forall a b. (a -> b) -> a -> b
$ RemoteSourceFieldInfo
                      { _rsfiName :: RelName
_rsfiName = RelName
relName,
                        _rsfiType :: RelType
_rsfiType = RelType
_atrType,
                        _rsfiSource :: SourceName
_rsfiSource = SourceName
_atrSource,
                        _rsfiSourceConfig :: SourceConfig ('Postgres 'Vanilla)
_rsfiSourceConfig = SourceConfig ('Postgres 'Vanilla)
_atrSourceConfig,
                        _rsfiTable :: TableName ('Postgres 'Vanilla)
_rsfiTable = TableName ('Postgres 'Vanilla)
_atrTableName,
                        _rsfiMapping :: HashMap
  FieldName
  (ScalarType ('Postgres 'Vanilla), Column ('Postgres 'Vanilla))
_rsfiMapping = HashMap
  FieldName
  (ScalarType ('Postgres 'Vanilla), Column ('Postgres 'Vanilla))
HashMap FieldName (PGScalarType, PGCol)
joinMapping
                      }
              }
      RemoteRelationshipParserBuilder forall lhsJoinField r (n :: * -> *) (m :: * -> *).
MonadBuildSchemaBase m n =>
RemoteFieldInfo lhsJoinField
-> SchemaT
     r
     m
     (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
remoteRelationshipField <- (SchemaContext -> RemoteRelationshipParserBuilder)
-> MaybeT (SchemaT r m) RemoteRelationshipParserBuilder
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RemoteRelationshipParserBuilder
scRemoteRelationshipParserBuilder
      [FieldParser n (RemoteRelationshipField UnpreparedValue)]
remoteRelationshipFieldParsers <- SchemaT
  r
  m
  (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
-> MaybeT
     (SchemaT r m)
     [FieldParser n (RemoteRelationshipField UnpreparedValue)]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (SchemaT
   r
   m
   (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
 -> MaybeT
      (SchemaT r m)
      [FieldParser n (RemoteRelationshipField UnpreparedValue)])
-> SchemaT
     r
     m
     (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
-> MaybeT
     (SchemaT r m)
     [FieldParser n (RemoteRelationshipField UnpreparedValue)]
forall a b. (a -> b) -> a -> b
$ RemoteFieldInfo Name
-> SchemaT
     r
     m
     (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
forall lhsJoinField r (n :: * -> *) (m :: * -> *).
MonadBuildSchemaBase m n =>
RemoteFieldInfo lhsJoinField
-> SchemaT
     r
     m
     (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
remoteRelationshipField RemoteFieldInfo Name
remoteFieldInfo
      [FieldParser n AnnotatedActionField]
-> MaybeT (SchemaT r m) [FieldParser n AnnotatedActionField]
forall a. a -> MaybeT (SchemaT r m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldParser n AnnotatedActionField]
 -> MaybeT (SchemaT r m) [FieldParser n AnnotatedActionField])
-> [FieldParser n AnnotatedActionField]
-> MaybeT (SchemaT r m) [FieldParser n AnnotatedActionField]
forall a b. (a -> b) -> a -> b
$ [FieldParser n (RemoteRelationshipField UnpreparedValue)]
remoteRelationshipFieldParsers [FieldParser n (RemoteRelationshipField UnpreparedValue)]
-> (FieldParser n (RemoteRelationshipField UnpreparedValue)
    -> FieldParser n AnnotatedActionField)
-> [FieldParser n AnnotatedActionField]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (RemoteRelationshipField UnpreparedValue -> AnnotatedActionField)
-> FieldParser n (RemoteRelationshipField UnpreparedValue)
-> FieldParser n AnnotatedActionField
forall a b.
(a -> b)
-> FieldParser MetadataObjId n a -> FieldParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ActionRemoteRelationshipSelect
  (RemoteRelationshipField UnpreparedValue)
-> AnnotatedActionField
forall r. ActionRemoteRelationshipSelect r -> ActionFieldG r
IR.ACFRemote (ActionRemoteRelationshipSelect
   (RemoteRelationshipField UnpreparedValue)
 -> AnnotatedActionField)
-> (RemoteRelationshipField UnpreparedValue
    -> ActionRemoteRelationshipSelect
         (RemoteRelationshipField UnpreparedValue))
-> RemoteRelationshipField UnpreparedValue
-> AnnotatedActionField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap FieldName Name
-> RemoteRelationshipField UnpreparedValue
-> ActionRemoteRelationshipSelect
     (RemoteRelationshipField UnpreparedValue)
forall r.
HashMap FieldName Name -> r -> ActionRemoteRelationshipSelect r
IR.ActionRemoteRelationshipSelect HashMap FieldName Name
lhsJoinFields)

actionInputArguments ::
  forall r m n.
  (MonadBuildActionSchema r m n) =>
  HashMap G.Name AnnotatedInputType ->
  [ArgumentDefinition (G.GType, AnnotatedInputType)] ->
  SchemaT r m (InputFieldsParser n J.Value)
actionInputArguments :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildActionSchema r m n =>
HashMap Name AnnotatedInputType
-> [ArgumentDefinition (GType, AnnotatedInputType)]
-> SchemaT r m (InputFieldsParser n Value)
actionInputArguments HashMap Name AnnotatedInputType
nonObjectTypeMap [ArgumentDefinition (GType, AnnotatedInputType)]
arguments = do
  [(Name, InputFieldsParser n (Maybe Value))]
argumentParsers <- [ArgumentDefinition (GType, AnnotatedInputType)]
-> (ArgumentDefinition (GType, AnnotatedInputType)
    -> SchemaT r m (Name, InputFieldsParser n (Maybe Value)))
-> SchemaT r m [(Name, InputFieldsParser n (Maybe Value))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [ArgumentDefinition (GType, AnnotatedInputType)]
arguments ((ArgumentDefinition (GType, AnnotatedInputType)
  -> SchemaT r m (Name, InputFieldsParser n (Maybe Value)))
 -> SchemaT r m [(Name, InputFieldsParser n (Maybe Value))])
-> (ArgumentDefinition (GType, AnnotatedInputType)
    -> SchemaT r m (Name, InputFieldsParser n (Maybe Value)))
-> SchemaT r m [(Name, InputFieldsParser n (Maybe Value))]
forall a b. (a -> b) -> a -> b
$ \ArgumentDefinition (GType, AnnotatedInputType)
argument -> do
    let ArgumentDefinition ArgumentName
argumentName (GType
gType, AnnotatedInputType
nonObjectType) Maybe Description
argumentDescription = ArgumentDefinition (GType, AnnotatedInputType)
argument
        name :: Name
name = ArgumentName -> Name
unArgumentName ArgumentName
argumentName
    (Name
name,) (InputFieldsParser n (Maybe Value)
 -> (Name, InputFieldsParser n (Maybe Value)))
-> SchemaT r m (InputFieldsParser n (Maybe Value))
-> SchemaT r m (Name, InputFieldsParser n (Maybe Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> GType
-> AnnotatedInputType
-> SchemaT r m (InputFieldsParser n (Maybe Value))
argumentParser Name
name Maybe Description
argumentDescription GType
gType AnnotatedInputType
nonObjectType
  InputFieldsParser n Value
-> SchemaT r m (InputFieldsParser n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldsParser n Value
 -> SchemaT r m (InputFieldsParser n Value))
-> InputFieldsParser n Value
-> SchemaT r m (InputFieldsParser n Value)
forall a b. (a -> b) -> a -> b
$ Object -> Value
J.Object (Object -> Value)
-> InputFieldsParser MetadataObjId n Object
-> InputFieldsParser n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, InputFieldsParser n (Maybe Value))]
-> InputFieldsParser MetadataObjId n Object
inputFieldsToObject [(Name, InputFieldsParser n (Maybe Value))]
argumentParsers
  where
    inputFieldsToObject ::
      [(G.Name, InputFieldsParser n (Maybe J.Value))] ->
      InputFieldsParser n J.Object
    inputFieldsToObject :: [(Name, InputFieldsParser n (Maybe Value))]
-> InputFieldsParser MetadataObjId n Object
inputFieldsToObject [(Name, InputFieldsParser n (Maybe Value))]
inputFields =
      let mkTuple :: (Name, f (f a)) -> f (f (Key, a))
mkTuple (Name
name, f (f a)
parser) = (a -> (Key, a)) -> f a -> f (Key, a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Key
K.fromText (Name -> Text
G.unName Name
name),) (f a -> f (Key, a)) -> f (f a) -> f (f (Key, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f a)
parser
       in [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([(Key, Value)] -> Object)
-> ([Maybe (Key, Value)] -> [(Key, Value)])
-> [Maybe (Key, Value)]
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes ([Maybe (Key, Value)] -> Object)
-> InputFieldsParser MetadataObjId n [Maybe (Key, Value)]
-> InputFieldsParser MetadataObjId n Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, InputFieldsParser n (Maybe Value))
 -> InputFieldsParser MetadataObjId n (Maybe (Key, Value)))
-> [(Name, InputFieldsParser n (Maybe Value))]
-> InputFieldsParser MetadataObjId n [Maybe (Key, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Name, InputFieldsParser n (Maybe Value))
-> InputFieldsParser MetadataObjId n (Maybe (Key, Value))
forall {f :: * -> *} {f :: * -> *} {a}.
(Functor f, Functor f) =>
(Name, f (f a)) -> f (f (Key, a))
mkTuple [(Name, InputFieldsParser n (Maybe Value))]
inputFields

    argumentParser ::
      G.Name ->
      Maybe G.Description ->
      G.GType ->
      AnnotatedInputType ->
      SchemaT r m (InputFieldsParser n (Maybe J.Value))
    argumentParser :: Name
-> Maybe Description
-> GType
-> AnnotatedInputType
-> SchemaT r m (InputFieldsParser n (Maybe Value))
argumentParser Name
name Maybe Description
description GType
gType AnnotatedInputType
nonObjectType = do
      let mkResult :: forall k. ('Input P.<: k) => Parser k n J.Value -> InputFieldsParser n (Maybe J.Value)
          mkResult :: forall (k :: Kind).
('Input <: k) =>
Parser k n Value -> InputFieldsParser n (Maybe Value)
mkResult = Name
-> Maybe Description
-> GType
-> Parser k n Value
-> InputFieldsParser n (Maybe Value)
forall (m :: * -> *) (k :: Kind).
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> GType
-> Parser k m Value
-> InputFieldsParser m (Maybe Value)
mkArgumentInputFieldParser Name
name Maybe Description
description GType
gType
      case AnnotatedInputType
nonObjectType of
        -- scalar and enum parsers are not recursive and need not be memoized
        NOCTScalar AnnotatedScalarType
def -> InputFieldsParser n (Maybe Value)
-> SchemaT r m (InputFieldsParser n (Maybe Value))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldsParser n (Maybe Value)
 -> SchemaT r m (InputFieldsParser n (Maybe Value)))
-> InputFieldsParser n (Maybe Value)
-> SchemaT r m (InputFieldsParser n (Maybe Value))
forall a b. (a -> b) -> a -> b
$ Parser 'Both n Value -> InputFieldsParser n (Maybe Value)
forall (k :: Kind).
('Input <: k) =>
Parser k n Value -> InputFieldsParser n (Maybe Value)
mkResult (Parser 'Both n Value -> InputFieldsParser n (Maybe Value))
-> Parser 'Both n Value -> InputFieldsParser n (Maybe Value)
forall a b. (a -> b) -> a -> b
$ AnnotatedScalarType -> Parser 'Both n Value
forall (m :: * -> *).
MonadParse m =>
AnnotatedScalarType -> Parser 'Both m Value
customScalarParser AnnotatedScalarType
def
        NOCTEnum EnumTypeDefinition
def -> InputFieldsParser n (Maybe Value)
-> SchemaT r m (InputFieldsParser n (Maybe Value))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldsParser n (Maybe Value)
 -> SchemaT r m (InputFieldsParser n (Maybe Value)))
-> InputFieldsParser n (Maybe Value)
-> SchemaT r m (InputFieldsParser n (Maybe Value))
forall a b. (a -> b) -> a -> b
$ Parser 'Both n Value -> InputFieldsParser n (Maybe Value)
forall (k :: Kind).
('Input <: k) =>
Parser k n Value -> InputFieldsParser n (Maybe Value)
mkResult (Parser 'Both n Value -> InputFieldsParser n (Maybe Value))
-> Parser 'Both n Value -> InputFieldsParser n (Maybe Value)
forall a b. (a -> b) -> a -> b
$ EnumTypeDefinition -> Parser 'Both n Value
forall (m :: * -> *).
MonadParse m =>
EnumTypeDefinition -> Parser 'Both m Value
customEnumParser EnumTypeDefinition
def
        -- input objects however may recursively contain one another
        NOCTInputObject (InputObjectTypeDefinition (InputObjectTypeName Name
objectName) Maybe Description
objectDesc NonEmpty InputObjectFieldDefinition
inputFields) ->
          Parser 'Input n Value -> InputFieldsParser n (Maybe Value)
forall (k :: Kind).
('Input <: k) =>
Parser k n Value -> InputFieldsParser n (Maybe Value)
mkResult (Parser 'Input n Value -> InputFieldsParser n (Maybe Value))
-> SchemaT r m (Parser 'Input n Value)
-> SchemaT r m (InputFieldsParser n (Maybe Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Name
-> SchemaT r m (Parser 'Input n Value)
-> SchemaT r m (Parser 'Input n Value)
forall (m :: * -> *) a (p :: (* -> *) -> * -> *) (n :: * -> *) b.
(MonadMemoize m, Ord a, Typeable a, Typeable p, MonadParse n,
 Typeable b) =>
Name -> a -> m (p n b) -> m (p n b)
P.memoizeOn 'actionInputArguments Name
objectName do
            [(Name, InputFieldsParser n (Maybe Value))]
inputFieldsParsers <- [InputObjectFieldDefinition]
-> (InputObjectFieldDefinition
    -> SchemaT r m (Name, InputFieldsParser n (Maybe Value)))
-> SchemaT r m [(Name, InputFieldsParser n (Maybe Value))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
              (NonEmpty InputObjectFieldDefinition -> [InputObjectFieldDefinition]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty InputObjectFieldDefinition
inputFields)
              \(InputObjectFieldDefinition (InputObjectFieldName Name
fieldName) Maybe Description
fieldDesc (GraphQLType GType
fieldType)) -> do
                AnnotatedInputType
nonObjectFieldType <-
                  Name -> HashMap Name AnnotatedInputType -> Maybe AnnotatedInputType
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (GType -> Name
G.getBaseType GType
fieldType) HashMap Name AnnotatedInputType
nonObjectTypeMap
                    Maybe AnnotatedInputType
-> SchemaT r m AnnotatedInputType -> SchemaT r m AnnotatedInputType
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> SchemaT r m AnnotatedInputType
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"object type for a field found in custom input object type"
                (Name
fieldName,) (InputFieldsParser n (Maybe Value)
 -> (Name, InputFieldsParser n (Maybe Value)))
-> SchemaT r m (InputFieldsParser n (Maybe Value))
-> SchemaT r m (Name, InputFieldsParser n (Maybe Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> GType
-> AnnotatedInputType
-> SchemaT r m (InputFieldsParser n (Maybe Value))
argumentParser Name
fieldName Maybe Description
fieldDesc GType
fieldType AnnotatedInputType
nonObjectFieldType
            Parser 'Input n Value -> SchemaT r m (Parser 'Input n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (Parser 'Input n Value -> SchemaT r m (Parser 'Input n Value))
-> Parser 'Input n Value -> SchemaT r m (Parser 'Input n Value)
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> InputFieldsParser n Value
-> Parser 'Input n Value
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
objectName Maybe Description
objectDesc
              (InputFieldsParser n Value -> Parser 'Input n Value)
-> InputFieldsParser n Value -> Parser 'Input n Value
forall a b. (a -> b) -> a -> b
$ Object -> Value
J.Object
              (Object -> Value)
-> InputFieldsParser MetadataObjId n Object
-> InputFieldsParser n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, InputFieldsParser n (Maybe Value))]
-> InputFieldsParser MetadataObjId n Object
inputFieldsToObject [(Name, InputFieldsParser n (Maybe Value))]
inputFieldsParsers

mkArgumentInputFieldParser ::
  forall m k.
  (MonadParse m, 'Input P.<: k) =>
  G.Name ->
  Maybe G.Description ->
  G.GType ->
  Parser k m J.Value ->
  InputFieldsParser m (Maybe J.Value)
mkArgumentInputFieldParser :: forall (m :: * -> *) (k :: Kind).
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> GType
-> Parser k m Value
-> InputFieldsParser m (Maybe Value)
mkArgumentInputFieldParser Name
name Maybe Description
description GType
gType Parser k m Value
parser =
  if GType -> Bool
G.isNullable GType
gType
    then Name
-> Maybe Description
-> Parser k m Value
-> InputFieldsParser MetadataObjId m (Maybe Value)
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m (Maybe a)
P.fieldOptional Name
name Maybe Description
description Parser k m Value
modifiedParser
    else Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> InputFieldsParser MetadataObjId m Value
-> InputFieldsParser MetadataObjId m (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser k m Value
-> InputFieldsParser MetadataObjId m Value
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field Name
name Maybe Description
description Parser k m Value
modifiedParser
  where
    modifiedParser :: Parser k m Value
modifiedParser = GType -> Parser k m Value -> Parser k m Value
parserModifier GType
gType Parser k m Value
parser

    parserModifier ::
      G.GType -> Parser k m J.Value -> Parser k m J.Value
    parserModifier :: GType -> Parser k m Value -> Parser k m Value
parserModifier = \case
      G.TypeNamed Nullability
nullable Name
_ -> Nullability -> Parser k m Value -> Parser k m Value
forall {origin}.
Nullability -> Parser origin k m Value -> Parser origin k m Value
nullableModifier Nullability
nullable
      G.TypeList Nullability
nullable GType
ty ->
        Nullability -> Parser k m Value -> Parser k m Value
forall {origin}.
Nullability -> Parser origin k m Value -> Parser origin k m Value
nullableModifier Nullability
nullable (Parser k m Value -> Parser k m Value)
-> (Parser k m Value -> Parser k m Value)
-> Parser k m Value
-> Parser k m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Value] -> Value)
-> Parser MetadataObjId k m [Value] -> Parser k m Value
forall a b.
(a -> b)
-> Parser MetadataObjId k m a -> Parser MetadataObjId k m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Value] -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Parser MetadataObjId k m [Value] -> Parser k m Value)
-> (Parser k m Value -> Parser MetadataObjId k m [Value])
-> Parser k m Value
-> Parser k m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser k m Value -> Parser MetadataObjId k m [Value]
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m [a]
P.list (Parser k m Value -> Parser MetadataObjId k m [Value])
-> (Parser k m Value -> Parser k m Value)
-> Parser k m Value
-> Parser MetadataObjId k m [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GType -> Parser k m Value -> Parser k m Value
parserModifier GType
ty
      where
        nullableModifier :: Nullability -> Parser origin k m Value -> Parser origin k m Value
nullableModifier =
          (Parser origin k m Value -> Parser origin k m Value)
-> (Parser origin k m Value -> Parser origin k m Value)
-> Bool
-> Parser origin k m Value
-> Parser origin k m Value
forall a. a -> a -> Bool -> a
bool ((Value -> Value)
-> Parser origin k m Value -> Parser origin k m Value
forall a b. (a -> b) -> Parser origin k m a -> Parser origin k m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
forall a. ToJSON a => a -> Value
J.toJSON) ((Maybe Value -> Value)
-> Parser origin k m (Maybe Value) -> Parser origin k m Value
forall a b. (a -> b) -> Parser origin k m a -> Parser origin k m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Value -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Parser origin k m (Maybe Value) -> Parser origin k m Value)
-> (Parser origin k m Value -> Parser origin k m (Maybe Value))
-> Parser origin k m Value
-> Parser origin k m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser origin k m Value -> Parser origin k m (Maybe Value)
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m (Maybe a)
P.nullable) (Bool -> Parser origin k m Value -> Parser origin k m Value)
-> (Nullability -> Bool)
-> Nullability
-> Parser origin k m Value
-> Parser origin k m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nullability -> Bool
G.unNullability

customScalarParser ::
  (MonadParse m) =>
  AnnotatedScalarType ->
  Parser 'Both m J.Value
customScalarParser :: forall (m :: * -> *).
MonadParse m =>
AnnotatedScalarType -> Parser 'Both m Value
customScalarParser = \case
  ASTCustom ScalarTypeDefinition {Maybe Description
Name
_stdName :: ScalarTypeDefinition -> Name
_stdDescription :: ScalarTypeDefinition -> Maybe Description
_stdName :: Name
_stdDescription :: Maybe Description
..} ->
    if
      | Name
_stdName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
GName._ID -> Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Text -> Value)
-> Parser MetadataObjId 'Both m Text -> Parser 'Both m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both m Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.identifier
      | Name
_stdName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
GName._Int -> Int32 -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Int32 -> Value)
-> Parser MetadataObjId 'Both m Int32 -> Parser 'Both m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both m Int32
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Int32
P.int
      | Name
_stdName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
GName._Float -> Double -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Double -> Value)
-> Parser MetadataObjId 'Both m Double -> Parser 'Both m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both m Double
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Double
P.float
      | Name
_stdName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
GName._String -> Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Text -> Value)
-> Parser MetadataObjId 'Both m Text -> Parser 'Both m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both m Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.string
      | Name
_stdName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
GName._Boolean -> Bool -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Bool -> Value)
-> Parser MetadataObjId 'Both m Bool -> Parser 'Both m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both m Bool
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Bool
P.boolean
      | Bool
otherwise -> Name -> Maybe Description -> Parser 'Both m Value
forall (m :: * -> *) origin.
MonadParse m =>
Name -> Maybe Description -> Parser origin 'Both m Value
P.jsonScalar Name
_stdName Maybe Description
_stdDescription
  ASTReusedScalar Name
name AnyBackend ScalarWrapper
backendScalarType ->
    let schemaType :: Type MetadataObjId 'Both
schemaType = Nullability
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
-> Type MetadataObjId 'Both
forall origin (k :: Kind).
Nullability
-> Definition origin (TypeInfo origin k) -> Type origin k
P.TNamed Nullability
P.NonNullable (Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
 -> Type MetadataObjId 'Both)
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
-> Type MetadataObjId 'Both
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> Maybe MetadataObjId
-> [Directive Void]
-> TypeInfo MetadataObjId 'Both
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
P.Definition Name
name Maybe Description
forall a. Maybe a
Nothing Maybe MetadataObjId
forall a. Maybe a
Nothing [] TypeInfo MetadataObjId 'Both
forall origin. TypeInfo origin 'Both
P.TIScalar
        backendScalarValidator :: Value -> m Value
backendScalarValidator =
          forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend ScalarWrapper
backendScalarType \(ScalarWrapper b
scalarType :: ScalarWrapper b) Value
jsonInput -> do
            -- We attempt to parse the value from JSON to validate it, but still
            -- output it as JSON. On one hand this allows us to detect issues
            -- ahead of time: if the value is not formatted correctly, we don't
            -- send the action at all; on the other, it means we are at risk of
            -- rejecting valid queries if our parser is more strict than the one
            -- of the remote server. We do not parse scalars for remote servers
            -- for that reason; we might want to reconsider this validation as
            -- well.
            m (ScalarValue b) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
              (m (ScalarValue b) -> m ()) -> m (ScalarValue b) -> m ()
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
Backend b =>
ScalarTypeParsingContext b
-> ScalarType b -> Value -> Either QErr (ScalarValue b)
parseScalarValue @b (ScalarWrapper b -> ScalarTypeParsingContext b
forall (b :: BackendType).
ScalarWrapper b -> ScalarTypeParsingContext b
parsingContext ScalarWrapper b
scalarType) (ScalarWrapper b -> ScalarType b
forall (b :: BackendType). ScalarWrapper b -> ScalarType b
unwrapScalar ScalarWrapper b
scalarType) Value
jsonInput
              Either QErr (ScalarValue b)
-> (QErr -> m (ScalarValue b)) -> m (ScalarValue b)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` \QErr
e -> ParseErrorCode -> ErrorMessage -> m (ScalarValue b)
forall a. ParseErrorCode -> ErrorMessage -> m a
forall (m :: * -> *) a.
MonadParse m =>
ParseErrorCode -> ErrorMessage -> m a
parseErrorWith ParseErrorCode
P.ParseFailed (ErrorMessage -> m (ScalarValue b))
-> (Text -> ErrorMessage) -> Text -> m (ScalarValue b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ErrorMessage
toErrorMessage (Text -> m (ScalarValue b)) -> Text -> m (ScalarValue b)
forall a b. (a -> b) -> a -> b
$ QErr -> Text
qeError QErr
e
            Value -> m Value
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
jsonInput
     in P.Parser
          { pType :: Type MetadataObjId 'Both
pType = Type MetadataObjId 'Both
schemaType,
            pParser :: ParserInput 'Both -> m Value
pParser = GType -> InputValue Variable -> m Value
forall (m :: * -> *).
MonadParse m =>
GType -> InputValue Variable -> m Value
P.valueToJSON (Type MetadataObjId 'Both -> GType
forall origin (k :: Kind). Type origin k -> GType
P.toGraphQLType Type MetadataObjId 'Both
schemaType) (InputValue Variable -> m Value)
-> (Value -> m Value) -> InputValue Variable -> m Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> m Value
backendScalarValidator
          }

customEnumParser ::
  (MonadParse m) =>
  EnumTypeDefinition ->
  Parser 'Both m J.Value
customEnumParser :: forall (m :: * -> *).
MonadParse m =>
EnumTypeDefinition -> Parser 'Both m Value
customEnumParser (EnumTypeDefinition EnumTypeName
typeName Maybe Description
description NonEmpty EnumValueDefinition
enumValues) =
  let enumName :: Name
enumName = EnumTypeName -> Name
unEnumTypeName EnumTypeName
typeName
      enumValueDefinitions :: NonEmpty (Definition MetadataObjId EnumValueInfo, Value)
enumValueDefinitions =
        NonEmpty EnumValueDefinition
enumValues NonEmpty EnumValueDefinition
-> (EnumValueDefinition
    -> (Definition MetadataObjId EnumValueInfo, Value))
-> NonEmpty (Definition MetadataObjId EnumValueInfo, Value)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \EnumValueDefinition
enumValue ->
          let valueName :: Name
valueName = EnumValue -> Name
G.unEnumValue (EnumValue -> Name) -> EnumValue -> Name
forall a b. (a -> b) -> a -> b
$ EnumValueDefinition -> EnumValue
_evdValue EnumValueDefinition
enumValue
           in (,Name -> Value
forall a. ToJSON a => a -> Value
J.toJSON Name
valueName)
                (Definition MetadataObjId EnumValueInfo
 -> (Definition MetadataObjId EnumValueInfo, Value))
-> Definition MetadataObjId EnumValueInfo
-> (Definition MetadataObjId EnumValueInfo, Value)
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> Maybe MetadataObjId
-> [Directive Void]
-> EnumValueInfo
-> Definition MetadataObjId EnumValueInfo
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
P.Definition
                  Name
valueName
                  (EnumValueDefinition -> Maybe Description
_evdDescription EnumValueDefinition
enumValue)
                  Maybe MetadataObjId
forall a. Maybe a
Nothing
                  []
                  EnumValueInfo
P.EnumValueInfo
   in Name
-> Maybe Description
-> NonEmpty (Definition MetadataObjId EnumValueInfo, Value)
-> Parser MetadataObjId 'Both m Value
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> NonEmpty (Definition origin EnumValueInfo, a)
-> Parser origin 'Both m a
P.enum Name
enumName Maybe Description
description NonEmpty (Definition MetadataObjId EnumValueInfo, Value)
enumValueDefinitions