{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Client.Transform.Local
( toLocalDefinitions,
)
where
import Control.Monad.Except (MonadError (throwError))
import Data.Morpheus.Client.Internal.Types
( ClientConstructorDefinition (..),
ClientTypeDefinition (..),
FetchDefinition (..),
TypeNameTH (..),
)
import Data.Morpheus.Client.Transform.Core (Converter (..), compileError, deprecationWarning, getType, typeFrom)
import Data.Morpheus.Client.Transform.Global (toArgumentsType)
import Data.Morpheus.Core (Config (..), VALIDATION_MODE (WITHOUT_VARIABLES), validateRequest)
import Data.Morpheus.Internal.Ext
( GQLResult,
)
import Data.Morpheus.Internal.Utils
( empty,
keyOf,
selectBy,
)
import Data.Morpheus.Types.Internal.AST
( ANY,
ExecutableDocument (..),
FieldDefinition (..),
FieldName,
OUT,
Operation (..),
Ref (..),
Schema (..),
Selection (..),
SelectionContent (..),
SelectionSet,
TRUE,
TypeContent (..),
TypeDefinition (..),
TypeKind (..),
TypeName,
TypeRef (..),
UnionTag (..),
VALID,
getOperationDataType,
getOperationName,
mkTypeRef,
msg,
toAny,
)
import Relude hiding (empty, show)
import Prelude (show)
clientConfig :: Config
clientConfig :: Config
clientConfig =
Config :: Bool -> VALIDATION_MODE -> Config
Config
{ debug :: Bool
debug = Bool
False,
validationMode :: VALIDATION_MODE
validationMode = VALIDATION_MODE
WITHOUT_VARIABLES
}
toLocalDefinitions ::
ExecutableDocument ->
Schema VALID ->
GQLResult
( FetchDefinition,
[ClientTypeDefinition]
)
toLocalDefinitions :: ExecutableDocument
-> Schema VALID
-> GQLResult (FetchDefinition, [ClientTypeDefinition])
toLocalDefinitions ExecutableDocument
request Schema VALID
schema = do
Operation VALID
validOperation <- Config
-> Schema VALID
-> ExecutableDocument
-> GQLResult (Operation VALID)
validateRequest Config
clientConfig Schema VALID
schema ExecutableDocument
request
(ReaderT
(Schema VALID, VariableDefinitions RAW)
GQLResult
(FetchDefinition, [ClientTypeDefinition])
-> (Schema VALID, VariableDefinitions RAW)
-> GQLResult (FetchDefinition, [ClientTypeDefinition]))
-> (Schema VALID, VariableDefinitions RAW)
-> ReaderT
(Schema VALID, VariableDefinitions RAW)
GQLResult
(FetchDefinition, [ClientTypeDefinition])
-> GQLResult (FetchDefinition, [ClientTypeDefinition])
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
(Schema VALID, VariableDefinitions RAW)
GQLResult
(FetchDefinition, [ClientTypeDefinition])
-> (Schema VALID, VariableDefinitions RAW)
-> GQLResult (FetchDefinition, [ClientTypeDefinition])
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Schema VALID
schema, Operation RAW -> VariableDefinitions RAW
forall (s :: Stage). Operation s -> VariableDefinitions s
operationArguments (Operation RAW -> VariableDefinitions RAW)
-> Operation RAW -> VariableDefinitions RAW
forall a b. (a -> b) -> a -> b
$ ExecutableDocument -> Operation RAW
operation ExecutableDocument
request) (ReaderT
(Schema VALID, VariableDefinitions RAW)
GQLResult
(FetchDefinition, [ClientTypeDefinition])
-> GQLResult (FetchDefinition, [ClientTypeDefinition]))
-> ReaderT
(Schema VALID, VariableDefinitions RAW)
GQLResult
(FetchDefinition, [ClientTypeDefinition])
-> GQLResult (FetchDefinition, [ClientTypeDefinition])
forall a b. (a -> b) -> a -> b
$
Converter (FetchDefinition, [ClientTypeDefinition])
-> ReaderT
(Schema VALID, VariableDefinitions RAW)
GQLResult
(FetchDefinition, [ClientTypeDefinition])
forall a.
Converter a
-> ReaderT (Schema VALID, VariableDefinitions RAW) GQLResult a
runConverter (Converter (FetchDefinition, [ClientTypeDefinition])
-> ReaderT
(Schema VALID, VariableDefinitions RAW)
GQLResult
(FetchDefinition, [ClientTypeDefinition]))
-> Converter (FetchDefinition, [ClientTypeDefinition])
-> ReaderT
(Schema VALID, VariableDefinitions RAW)
GQLResult
(FetchDefinition, [ClientTypeDefinition])
forall a b. (a -> b) -> a -> b
$ Operation VALID
-> Converter (FetchDefinition, [ClientTypeDefinition])
genOperation Operation VALID
validOperation
genOperation :: Operation VALID -> Converter (FetchDefinition, [ClientTypeDefinition])
genOperation :: Operation VALID
-> Converter (FetchDefinition, [ClientTypeDefinition])
genOperation op :: Operation VALID
op@Operation {Maybe FieldName
operationName :: forall (s :: Stage). Operation s -> Maybe FieldName
operationName :: Maybe FieldName
operationName, SelectionSet VALID
operationSelection :: forall (s :: Stage). Operation s -> SelectionSet s
operationSelection :: SelectionSet VALID
operationSelection} = do
(Schema VALID
schema, VariableDefinitions RAW
varDefs) <- ((Schema VALID, VariableDefinitions RAW)
-> (Schema VALID, VariableDefinitions RAW))
-> Converter (Schema VALID, VariableDefinitions RAW)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Schema VALID, VariableDefinitions RAW)
-> (Schema VALID, VariableDefinitions RAW)
forall a. a -> a
id
TypeDefinition OBJECT VALID
datatype <- Operation VALID
-> Schema VALID -> Converter (TypeDefinition OBJECT VALID)
forall (m :: * -> *) (s :: Stage).
MonadError GQLError m =>
Operation s -> Schema VALID -> m (TypeDefinition OBJECT VALID)
getOperationDataType Operation VALID
op Schema VALID
schema
let argumentsType :: Maybe ClientTypeDefinition
argumentsType = TypeName -> VariableDefinitions RAW -> Maybe ClientTypeDefinition
toArgumentsType (Maybe FieldName -> TypeName
getOperationName Maybe FieldName
operationName TypeName -> TypeName -> TypeName
forall a. Semigroup a => a -> a -> a
<> TypeName
"Args") VariableDefinitions RAW
varDefs
(ClientTypeDefinition
rootType :| [ClientTypeDefinition]
localTypes) <-
[FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> Converter (NonEmpty ClientTypeDefinition)
genLocalTypes
[]
(Maybe FieldName -> TypeName
getOperationName Maybe FieldName
operationName)
(TypeDefinition OBJECT VALID -> TypeDefinition ANY VALID
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny TypeDefinition OBJECT VALID
datatype)
SelectionSet VALID
operationSelection
(FetchDefinition, [ClientTypeDefinition])
-> Converter (FetchDefinition, [ClientTypeDefinition])
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( FetchDefinition :: TypeNameTH -> Maybe TypeNameTH -> FetchDefinition
FetchDefinition
{ clientArgumentsTypeName :: Maybe TypeNameTH
clientArgumentsTypeName = (ClientTypeDefinition -> TypeNameTH)
-> Maybe ClientTypeDefinition -> Maybe TypeNameTH
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClientTypeDefinition -> TypeNameTH
clientTypeName Maybe ClientTypeDefinition
argumentsType,
rootTypeName :: TypeNameTH
rootTypeName = ClientTypeDefinition -> TypeNameTH
clientTypeName ClientTypeDefinition
rootType
},
ClientTypeDefinition
rootType ClientTypeDefinition
-> [ClientTypeDefinition] -> [ClientTypeDefinition]
forall a. a -> [a] -> [a]
: ([ClientTypeDefinition]
localTypes [ClientTypeDefinition]
-> [ClientTypeDefinition] -> [ClientTypeDefinition]
forall a. Semigroup a => a -> a -> a
<> Maybe ClientTypeDefinition -> [ClientTypeDefinition]
forall a. Maybe a -> [a]
maybeToList Maybe ClientTypeDefinition
argumentsType)
)
genLocalTypes ::
[FieldName] ->
TypeName ->
TypeDefinition ANY VALID ->
SelectionSet VALID ->
Converter (NonEmpty ClientTypeDefinition)
genLocalTypes :: [FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> Converter (NonEmpty ClientTypeDefinition)
genLocalTypes [FieldName]
path TypeName
tName TypeDefinition ANY VALID
dataType SelectionSet VALID
recordSelSet = do
(ClientConstructorDefinition
con, [ClientTypeDefinition]
subTypes) <- [FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> Converter (ClientConstructorDefinition, [ClientTypeDefinition])
toConstructorDefinition (if [FieldName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldName]
path then [TypeName -> FieldName
coerce TypeName
tName] else [FieldName]
path) TypeName
tName TypeDefinition ANY VALID
dataType SelectionSet VALID
recordSelSet
NonEmpty ClientTypeDefinition
-> Converter (NonEmpty ClientTypeDefinition)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty ClientTypeDefinition
-> Converter (NonEmpty ClientTypeDefinition))
-> NonEmpty ClientTypeDefinition
-> Converter (NonEmpty ClientTypeDefinition)
forall a b. (a -> b) -> a -> b
$
ClientTypeDefinition :: TypeNameTH
-> [ClientConstructorDefinition]
-> TypeKind
-> ClientTypeDefinition
ClientTypeDefinition
{ clientTypeName :: TypeNameTH
clientTypeName = [FieldName] -> TypeName -> TypeNameTH
TypeNameTH [FieldName]
path TypeName
tName,
clientCons :: [ClientConstructorDefinition]
clientCons = [ClientConstructorDefinition
con],
clientKind :: TypeKind
clientKind = Maybe OperationType -> TypeKind
KindObject Maybe OperationType
forall a. Maybe a
Nothing
}
ClientTypeDefinition
-> [ClientTypeDefinition] -> NonEmpty ClientTypeDefinition
forall a. a -> [a] -> NonEmpty a
:| [ClientTypeDefinition]
subTypes
toConstructorDefinition ::
[FieldName] ->
TypeName ->
TypeDefinition ANY VALID ->
SelectionSet VALID ->
Converter (ClientConstructorDefinition, [ClientTypeDefinition])
toConstructorDefinition :: [FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> Converter (ClientConstructorDefinition, [ClientTypeDefinition])
toConstructorDefinition [FieldName]
path TypeName
cName TypeDefinition ANY VALID
datatype SelectionSet VALID
selSet = do
([FieldDefinition ANY VALID]
cFields, [[ClientTypeDefinition]]
subTypes) <- [(FieldDefinition ANY VALID, [ClientTypeDefinition])]
-> ([FieldDefinition ANY VALID], [[ClientTypeDefinition]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(FieldDefinition ANY VALID, [ClientTypeDefinition])]
-> ([FieldDefinition ANY VALID], [[ClientTypeDefinition]]))
-> Converter [(FieldDefinition ANY VALID, [ClientTypeDefinition])]
-> Converter
([FieldDefinition ANY VALID], [[ClientTypeDefinition]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Selection VALID
-> Converter (FieldDefinition ANY VALID, [ClientTypeDefinition]))
-> [Selection VALID]
-> Converter [(FieldDefinition ANY VALID, [ClientTypeDefinition])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Selection VALID
-> Converter (FieldDefinition ANY VALID, [ClientTypeDefinition])
genField (MergeMap 'False FieldName (Selection VALID) -> [Selection VALID]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList MergeMap 'False FieldName (Selection VALID)
SelectionSet VALID
selSet)
(ClientConstructorDefinition, [ClientTypeDefinition])
-> Converter (ClientConstructorDefinition, [ClientTypeDefinition])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientConstructorDefinition :: TypeName
-> [FieldDefinition ANY VALID] -> ClientConstructorDefinition
ClientConstructorDefinition {TypeName
cName :: TypeName
cName :: TypeName
cName, [FieldDefinition ANY VALID]
cFields :: [FieldDefinition ANY VALID]
cFields :: [FieldDefinition ANY VALID]
cFields}, [[ClientTypeDefinition]] -> [ClientTypeDefinition]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ClientTypeDefinition]]
subTypes)
where
genField :: Selection VALID -> Converter (FieldDefinition ANY VALID, [ClientTypeDefinition])
genField :: Selection VALID
-> Converter (FieldDefinition ANY VALID, [ClientTypeDefinition])
genField Selection VALID
sel = do
let fieldName :: FieldName
fieldName = Selection VALID -> FieldName
forall k a. KeyOf k a => a -> k
keyOf Selection VALID
sel
let fieldPath :: [FieldName]
fieldPath = [FieldName]
path [FieldName] -> [FieldName] -> [FieldName]
forall a. Semigroup a => a -> a -> a
<> [FieldName
fieldName]
(TypeDefinition ANY VALID
fieldDataType, TypeRef
fieldType) <- [FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> Converter (TypeDefinition ANY VALID, TypeRef)
getFieldType [FieldName]
fieldPath TypeDefinition ANY VALID
datatype Selection VALID
sel
[ClientTypeDefinition]
subTypes <- [FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> Converter [ClientTypeDefinition]
subTypesBySelection [FieldName]
fieldPath TypeDefinition ANY VALID
fieldDataType Selection VALID
sel
(FieldDefinition ANY VALID, [ClientTypeDefinition])
-> Converter (FieldDefinition ANY VALID, [ClientTypeDefinition])
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( FieldDefinition :: forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition
{ FieldName
fieldName :: FieldName
fieldName :: FieldName
fieldName,
TypeRef
fieldType :: TypeRef
fieldType :: TypeRef
fieldType,
fieldContent :: Maybe (FieldContent TRUE ANY VALID)
fieldContent = Maybe (FieldContent TRUE ANY VALID)
forall a. Maybe a
Nothing,
fieldDescription :: Maybe Description
fieldDescription = Maybe Description
forall a. Maybe a
Nothing,
fieldDirectives :: Directives VALID
fieldDirectives = Directives VALID
forall coll. Empty coll => coll
empty
},
[ClientTypeDefinition]
subTypes
)
subTypesBySelection ::
[FieldName] ->
TypeDefinition ANY VALID ->
Selection VALID ->
Converter [ClientTypeDefinition]
subTypesBySelection :: [FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> Converter [ClientTypeDefinition]
subTypesBySelection [FieldName]
_ TypeDefinition ANY VALID
_ Selection {selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionContent = SelectionContent VALID
SelectionField} = [ClientTypeDefinition] -> Converter [ClientTypeDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
subTypesBySelection [FieldName]
path TypeDefinition ANY VALID
dType Selection {selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionContent = SelectionSet SelectionSet VALID
selectionSet} = do
NonEmpty ClientTypeDefinition -> [ClientTypeDefinition]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty ClientTypeDefinition -> [ClientTypeDefinition])
-> Converter (NonEmpty ClientTypeDefinition)
-> Converter [ClientTypeDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> Converter (NonEmpty ClientTypeDefinition)
genLocalTypes [FieldName]
path ([FieldName] -> TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory).
[FieldName] -> TypeDefinition a VALID -> TypeName
typeFrom [] TypeDefinition ANY VALID
dType) TypeDefinition ANY VALID
dType SelectionSet VALID
selectionSet
subTypesBySelection [FieldName]
path TypeDefinition ANY VALID
dType Selection {selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionContent = UnionSelection SelectionSet VALID
interface UnionSelection VALID
unionSelections} =
do
let variants :: [UnionTag]
variants = TypeName -> SelectionSet VALID -> UnionTag
UnionTag (TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition ANY VALID
dType) SelectionSet VALID
interface UnionTag -> [UnionTag] -> [UnionTag]
forall a. a -> [a] -> [a]
: MergeMap 'False TypeName UnionTag -> [UnionTag]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList MergeMap 'False TypeName UnionTag
UnionSelection VALID
unionSelections
([ClientConstructorDefinition]
clientCons, [[ClientTypeDefinition]]
subTypes) <- [(ClientConstructorDefinition, [ClientTypeDefinition])]
-> ([ClientConstructorDefinition], [[ClientTypeDefinition]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ClientConstructorDefinition, [ClientTypeDefinition])]
-> ([ClientConstructorDefinition], [[ClientTypeDefinition]]))
-> Converter
[(ClientConstructorDefinition, [ClientTypeDefinition])]
-> Converter
([ClientConstructorDefinition], [[ClientTypeDefinition]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UnionTag
-> Converter (ClientConstructorDefinition, [ClientTypeDefinition]))
-> [UnionTag]
-> Converter
[(ClientConstructorDefinition, [ClientTypeDefinition])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([FieldName]
-> UnionTag
-> Converter (ClientConstructorDefinition, [ClientTypeDefinition])
getVariantType [FieldName]
path) [UnionTag]
variants
[ClientTypeDefinition] -> Converter [ClientTypeDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( ClientTypeDefinition :: TypeNameTH
-> [ClientConstructorDefinition]
-> TypeKind
-> ClientTypeDefinition
ClientTypeDefinition
{ clientTypeName :: TypeNameTH
clientTypeName = [FieldName] -> TypeName -> TypeNameTH
TypeNameTH [FieldName]
path ([FieldName] -> TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory).
[FieldName] -> TypeDefinition a VALID -> TypeName
typeFrom [] TypeDefinition ANY VALID
dType),
[ClientConstructorDefinition]
clientCons :: [ClientConstructorDefinition]
clientCons :: [ClientConstructorDefinition]
clientCons,
clientKind :: TypeKind
clientKind = TypeKind
KindUnion
} ClientTypeDefinition
-> [ClientTypeDefinition] -> [ClientTypeDefinition]
forall a. a -> [a] -> [a]
:
[[ClientTypeDefinition]] -> [ClientTypeDefinition]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ClientTypeDefinition]]
subTypes
)
getVariantType :: [FieldName] -> UnionTag -> Converter (ClientConstructorDefinition, [ClientTypeDefinition])
getVariantType :: [FieldName]
-> UnionTag
-> Converter (ClientConstructorDefinition, [ClientTypeDefinition])
getVariantType [FieldName]
path (UnionTag TypeName
selectedTyName SelectionSet VALID
selectionVariant) = do
TypeDefinition ANY VALID
conDatatype <- TypeName -> Converter (TypeDefinition ANY VALID)
getType TypeName
selectedTyName
[FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> Converter (ClientConstructorDefinition, [ClientTypeDefinition])
toConstructorDefinition [FieldName]
path TypeName
selectedTyName TypeDefinition ANY VALID
conDatatype SelectionSet VALID
selectionVariant
getFieldType ::
[FieldName] ->
TypeDefinition ANY VALID ->
Selection VALID ->
Converter (TypeDefinition ANY VALID, TypeRef)
getFieldType :: [FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> Converter (TypeDefinition ANY VALID, TypeRef)
getFieldType
[FieldName]
path
TypeDefinition {TypeContent TRUE ANY VALID
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent :: TypeContent TRUE ANY VALID
typeContent, TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName}
Selection
{ FieldName
selectionName :: forall (s :: Stage). Selection s -> FieldName
selectionName :: FieldName
selectionName,
Position
selectionPosition :: forall (s :: Stage). Selection s -> Position
selectionPosition :: Position
selectionPosition
} = TypeContent TRUE ANY VALID -> Converter (FieldDefinition OUT VALID)
toFieldDef TypeContent TRUE ANY VALID
typeContent Converter (FieldDefinition OUT VALID)
-> (FieldDefinition OUT VALID
-> Converter (TypeDefinition ANY VALID, TypeRef))
-> Converter (TypeDefinition ANY VALID, TypeRef)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FieldDefinition OUT VALID
-> Converter (TypeDefinition ANY VALID, TypeRef)
processFieldDefinition
where
toFieldDef :: TypeContent TRUE ANY VALID -> Converter (FieldDefinition OUT VALID)
toFieldDef :: TypeContent TRUE ANY VALID -> Converter (FieldDefinition OUT VALID)
toFieldDef TypeContent TRUE ANY VALID
_
| FieldName
selectionName FieldName -> FieldName -> Bool
forall a. Eq a => a -> a -> Bool
== FieldName
"__typename" =
FieldDefinition OUT VALID -> Converter (FieldDefinition OUT VALID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
FieldDefinition :: forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition
{ fieldName :: FieldName
fieldName = FieldName
"__typename",
fieldDescription :: Maybe Description
fieldDescription = Maybe Description
forall a. Maybe a
Nothing,
fieldType :: TypeRef
fieldType = TypeName -> TypeRef
mkTypeRef TypeName
"String",
fieldDirectives :: Directives VALID
fieldDirectives = Directives VALID
forall coll. Empty coll => coll
empty,
fieldContent :: Maybe (FieldContent TRUE OUT VALID)
fieldContent = Maybe (FieldContent TRUE OUT VALID)
forall a. Maybe a
Nothing
}
toFieldDef DataObject {FieldsDefinition OUT VALID
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT VALID
objectFields} = GQLError
-> FieldName
-> FieldsDefinition OUT VALID
-> Converter (FieldDefinition OUT VALID)
forall e (m :: * -> *) k (c :: * -> *) a.
(MonadError e m, IsMap k c, Monad m) =>
e -> k -> c a -> m a
selectBy GQLError
selError FieldName
selectionName FieldsDefinition OUT VALID
objectFields
toFieldDef DataInterface {FieldsDefinition OUT VALID
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT VALID
interfaceFields} = GQLError
-> FieldName
-> FieldsDefinition OUT VALID
-> Converter (FieldDefinition OUT VALID)
forall e (m :: * -> *) k (c :: * -> *) a.
(MonadError e m, IsMap k c, Monad m) =>
e -> k -> c a -> m a
selectBy GQLError
selError FieldName
selectionName FieldsDefinition OUT VALID
interfaceFields
toFieldDef TypeContent TRUE ANY VALID
dt = GQLError -> Converter (FieldDefinition OUT VALID)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
compileError (GQLError -> GQLError) -> GQLError -> GQLError
forall a b. (a -> b) -> a -> b
$ GQLError
"Type should be output Object \"" GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> String -> GQLError
forall a. Msg a => a -> GQLError
msg (TypeContent TRUE ANY VALID -> String
forall a. Show a => a -> String
show TypeContent TRUE ANY VALID
dt))
selError :: GQLError
selError = GQLError -> GQLError
compileError (GQLError -> GQLError) -> GQLError -> GQLError
forall a b. (a -> b) -> a -> b
$ GQLError
"can't find field " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> FieldName -> GQLError
forall a. Msg a => a -> GQLError
msg FieldName
selectionName GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
" on type: " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> String -> GQLError
forall a. Msg a => a -> GQLError
msg (TypeContent TRUE ANY VALID -> String
forall a. Show a => a -> String
show TypeContent TRUE ANY VALID
typeContent)
processFieldDefinition :: FieldDefinition OUT VALID
-> Converter (TypeDefinition ANY VALID, TypeRef)
processFieldDefinition
FieldDefinition
{ fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType = TypeRef {TypeWrapper
TypeName
typeWrappers :: TypeRef -> TypeWrapper
typeConName :: TypeRef -> TypeName
typeWrappers :: TypeWrapper
typeConName :: TypeName
..},
Directives VALID
fieldDirectives :: Directives VALID
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives s
fieldDirectives
} =
Converter ()
checkDeprecated Converter ()
-> Converter (TypeDefinition ANY VALID, TypeRef)
-> Converter (TypeDefinition ANY VALID, TypeRef)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (TypeDefinition ANY VALID -> (TypeDefinition ANY VALID, TypeRef)
trans (TypeDefinition ANY VALID -> (TypeDefinition ANY VALID, TypeRef))
-> Converter (TypeDefinition ANY VALID)
-> Converter (TypeDefinition ANY VALID, TypeRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeName -> Converter (TypeDefinition ANY VALID)
getType TypeName
typeConName)
where
trans :: TypeDefinition ANY VALID -> (TypeDefinition ANY VALID, TypeRef)
trans TypeDefinition ANY VALID
x = (TypeDefinition ANY VALID
x, TypeRef :: TypeName -> TypeWrapper -> TypeRef
TypeRef {typeConName :: TypeName
typeConName = [FieldName] -> TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory).
[FieldName] -> TypeDefinition a VALID -> TypeName
typeFrom [FieldName]
path TypeDefinition ANY VALID
x, TypeWrapper
typeWrappers :: TypeWrapper
typeWrappers :: TypeWrapper
..})
checkDeprecated :: Converter ()
checkDeprecated :: Converter ()
checkDeprecated = Directives VALID -> (FieldName, Ref FieldName) -> Converter ()
deprecationWarning Directives VALID
fieldDirectives (TypeName -> FieldName
coerce TypeName
typeName, FieldName -> Position -> Ref FieldName
forall name. name -> Position -> Ref name
Ref FieldName
selectionName Position
selectionPosition)