{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Client.Transform.Inputs
( renderNonOutputTypes,
renderOperationArguments,
)
where
import Data.Morpheus.Client.Internal.Types
( ClientConstructorDefinition (..),
ClientTypeDefinition (..),
TypeNameTH (..),
)
import Data.Morpheus.Client.Internal.Utils
( removeDuplicates,
)
import Data.Morpheus.Client.Transform.Core
( Converter (..),
UpdateT (..),
customScalarTypes,
getType,
resolveUpdates,
typeFrom,
)
import Data.Morpheus.Internal.Utils
( empty,
)
import Data.Morpheus.Types.Internal.AST
( ANY,
DataEnumValue (DataEnumValue, enumName),
FieldDefinition (..),
IN,
Operation (..),
RAW,
TRUE,
TypeContent (..),
TypeDefinition (..),
TypeKind (..),
TypeName,
TypeRef (..),
VALID,
Variable (..),
VariableDefinitions,
getOperationName,
toAny,
)
import Relude hiding (empty)
renderArguments ::
VariableDefinitions RAW ->
TypeName ->
Maybe ClientTypeDefinition
renderArguments :: VariableDefinitions RAW -> TypeName -> Maybe ClientTypeDefinition
renderArguments VariableDefinitions RAW
variables TypeName
cName
| VariableDefinitions RAW -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null VariableDefinitions RAW
variables = Maybe ClientTypeDefinition
forall a. Maybe a
Nothing
| Bool
otherwise = ClientTypeDefinition -> Maybe ClientTypeDefinition
forall a. a -> Maybe a
Just ClientTypeDefinition
rootArgumentsType
where
rootArgumentsType :: ClientTypeDefinition
rootArgumentsType :: ClientTypeDefinition
rootArgumentsType =
ClientTypeDefinition :: TypeNameTH
-> [ClientConstructorDefinition]
-> TypeKind
-> ClientTypeDefinition
ClientTypeDefinition
{ clientTypeName :: TypeNameTH
clientTypeName = [FieldName] -> TypeName -> TypeNameTH
TypeNameTH [] TypeName
cName,
clientKind :: TypeKind
clientKind = TypeKind
KindInputObject,
clientCons :: [ClientConstructorDefinition]
clientCons =
[ ClientConstructorDefinition :: TypeName
-> [FieldDefinition ANY VALID] -> ClientConstructorDefinition
ClientConstructorDefinition
{ TypeName
cName :: TypeName
cName :: TypeName
cName,
cFields :: [FieldDefinition ANY VALID]
cFields = Variable RAW -> FieldDefinition ANY VALID
fieldD (Variable RAW -> FieldDefinition ANY VALID)
-> [Variable RAW] -> [FieldDefinition ANY VALID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VariableDefinitions RAW -> [Variable RAW]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList VariableDefinitions RAW
variables
}
]
}
where
fieldD :: Variable RAW -> FieldDefinition ANY VALID
fieldD :: Variable RAW -> FieldDefinition ANY VALID
fieldD Variable {FieldName
variableName :: forall (stage :: Stage). Variable stage -> FieldName
variableName :: FieldName
variableName, TypeRef
variableType :: forall (stage :: Stage). Variable stage -> TypeRef
variableType :: TypeRef
variableType} =
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
variableName,
fieldContent :: Maybe (FieldContent TRUE ANY VALID)
fieldContent = Maybe (FieldContent TRUE ANY VALID)
forall a. Maybe a
Nothing,
fieldType :: TypeRef
fieldType = TypeRef
variableType,
fieldDescription :: Maybe Description
fieldDescription = Maybe Description
forall a. Maybe a
Nothing,
fieldDirectives :: Directives VALID
fieldDirectives = Directives VALID
forall coll. Empty coll => coll
empty
}
renderOperationArguments ::
Operation VALID ->
Converter (Maybe ClientTypeDefinition)
renderOperationArguments :: Operation VALID -> Converter (Maybe ClientTypeDefinition)
renderOperationArguments Operation {Maybe FieldName
operationName :: forall (s :: Stage). Operation s -> Maybe FieldName
operationName :: Maybe FieldName
operationName} =
((Schema VALID, VariableDefinitions RAW)
-> Maybe ClientTypeDefinition)
-> Converter (Maybe ClientTypeDefinition)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((VariableDefinitions RAW -> TypeName -> Maybe ClientTypeDefinition
`renderArguments` (Maybe FieldName -> TypeName
getOperationName Maybe FieldName
operationName TypeName -> TypeName -> TypeName
forall a. Semigroup a => a -> a -> a
<> TypeName
"Args")) (VariableDefinitions RAW -> Maybe ClientTypeDefinition)
-> ((Schema VALID, VariableDefinitions RAW)
-> VariableDefinitions RAW)
-> (Schema VALID, VariableDefinitions RAW)
-> Maybe ClientTypeDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema VALID, VariableDefinitions RAW) -> VariableDefinitions RAW
forall a b. (a, b) -> b
snd)
renderNonOutputTypes ::
[TypeName] ->
Converter [ClientTypeDefinition]
renderNonOutputTypes :: [TypeName] -> Converter [ClientTypeDefinition]
renderNonOutputTypes [TypeName]
leafTypes = do
[Variable RAW]
variables <- ((Schema VALID, VariableDefinitions RAW) -> [Variable RAW])
-> Converter [Variable RAW]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (VariableDefinitions RAW -> [Variable RAW]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (VariableDefinitions RAW -> [Variable RAW])
-> ((Schema VALID, VariableDefinitions RAW)
-> VariableDefinitions RAW)
-> (Schema VALID, VariableDefinitions RAW)
-> [Variable RAW]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema VALID, VariableDefinitions RAW) -> VariableDefinitions RAW
forall a b. (a, b) -> b
snd)
[TypeName]
inputTypeRequests <- [TypeName]
-> [UpdateT Converter [TypeName]] -> Converter [TypeName]
forall (m :: * -> *) a. Monad m => a -> [UpdateT m a] -> m a
resolveUpdates [] ([UpdateT Converter [TypeName]] -> Converter [TypeName])
-> [UpdateT Converter [TypeName]] -> Converter [TypeName]
forall a b. (a -> b) -> a -> b
$ (Variable RAW -> UpdateT Converter [TypeName])
-> [Variable RAW] -> [UpdateT Converter [TypeName]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([TypeName] -> Converter [TypeName])
-> UpdateT Converter [TypeName]
forall (m :: * -> *) a. (a -> m a) -> UpdateT m a
UpdateT (([TypeName] -> Converter [TypeName])
-> UpdateT Converter [TypeName])
-> (Variable RAW -> [TypeName] -> Converter [TypeName])
-> Variable RAW
-> UpdateT Converter [TypeName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> [TypeName] -> Converter [TypeName]
exploreInputTypeNames (TypeName -> [TypeName] -> Converter [TypeName])
-> (Variable RAW -> TypeName)
-> Variable RAW
-> [TypeName]
-> Converter [TypeName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRef -> TypeName
typeConName (TypeRef -> TypeName)
-> (Variable RAW -> TypeRef) -> Variable RAW -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable RAW -> TypeRef
forall (stage :: Stage). Variable stage -> TypeRef
variableType) [Variable RAW]
variables
[[ClientTypeDefinition]] -> [ClientTypeDefinition]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ClientTypeDefinition]] -> [ClientTypeDefinition])
-> Converter [[ClientTypeDefinition]]
-> Converter [ClientTypeDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeName -> Converter [ClientTypeDefinition])
-> [TypeName] -> Converter [[ClientTypeDefinition]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TypeName -> Converter [ClientTypeDefinition]
buildInputType ([TypeName] -> [TypeName]
forall a. Eq a => [a] -> [a]
removeDuplicates ([TypeName] -> [TypeName]) -> [TypeName] -> [TypeName]
forall a b. (a -> b) -> a -> b
$ [TypeName]
inputTypeRequests [TypeName] -> [TypeName] -> [TypeName]
forall a. Semigroup a => a -> a -> a
<> [TypeName]
leafTypes)
exploreInputTypeNames :: TypeName -> [TypeName] -> Converter [TypeName]
exploreInputTypeNames :: TypeName -> [TypeName] -> Converter [TypeName]
exploreInputTypeNames TypeName
name [TypeName]
collected
| TypeName
name TypeName -> [TypeName] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [TypeName]
collected = [TypeName] -> Converter [TypeName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeName]
collected
| Bool
otherwise = TypeName -> Converter (TypeDefinition ANY VALID)
getType TypeName
name Converter (TypeDefinition ANY VALID)
-> (TypeDefinition ANY VALID -> Converter [TypeName])
-> Converter [TypeName]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeDefinition ANY VALID -> Converter [TypeName]
scanInpType
where
scanInpType :: TypeDefinition ANY VALID -> Converter [TypeName]
scanInpType 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 :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName :: TypeName
typeName} = TypeContent TRUE ANY VALID -> Converter [TypeName]
scanType TypeContent TRUE ANY VALID
typeContent
where
scanType :: TypeContent TRUE ANY VALID -> Converter [TypeName]
scanType (DataInputObject FieldsDefinition IN VALID
fields) =
[TypeName]
-> [UpdateT Converter [TypeName]] -> Converter [TypeName]
forall (m :: * -> *) a. Monad m => a -> [UpdateT m a] -> m a
resolveUpdates
(TypeName
name TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: [TypeName]
collected)
(FieldDefinition IN VALID -> UpdateT Converter [TypeName]
toInputTypeD (FieldDefinition IN VALID -> UpdateT Converter [TypeName])
-> [FieldDefinition IN VALID] -> [UpdateT Converter [TypeName]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldsDefinition IN VALID -> [FieldDefinition IN VALID]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FieldsDefinition IN VALID
fields)
where
toInputTypeD :: FieldDefinition IN VALID -> UpdateT Converter [TypeName]
toInputTypeD :: FieldDefinition IN VALID -> UpdateT Converter [TypeName]
toInputTypeD FieldDefinition {fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType = TypeRef {TypeName
typeConName :: TypeName
typeConName :: TypeRef -> TypeName
typeConName}} =
([TypeName] -> Converter [TypeName])
-> UpdateT Converter [TypeName]
forall (m :: * -> *) a. (a -> m a) -> UpdateT m a
UpdateT (TypeName -> [TypeName] -> Converter [TypeName]
exploreInputTypeNames TypeName
typeConName)
scanType (DataEnum DataEnum VALID
_) = [TypeName] -> Converter [TypeName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TypeName]
collected [TypeName] -> [TypeName] -> [TypeName]
forall a. Semigroup a => a -> a -> a
<> [TypeName
typeName])
scanType (DataScalar ScalarDefinition
_) = [TypeName] -> Converter [TypeName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TypeName]
collected [TypeName] -> [TypeName] -> [TypeName]
forall a. Semigroup a => a -> a -> a
<> TypeName -> [TypeName]
customScalarTypes TypeName
typeName)
scanType TypeContent TRUE ANY VALID
_ = [TypeName] -> Converter [TypeName]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TypeName]
collected
buildInputType ::
TypeName ->
Converter [ClientTypeDefinition]
buildInputType :: TypeName -> Converter [ClientTypeDefinition]
buildInputType TypeName
name = TypeName -> Converter (TypeDefinition ANY VALID)
getType TypeName
name Converter (TypeDefinition ANY VALID)
-> (TypeDefinition ANY VALID -> Converter [ClientTypeDefinition])
-> Converter [ClientTypeDefinition]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeDefinition ANY VALID -> Converter [ClientTypeDefinition]
generateTypes
where
generateTypes :: TypeDefinition ANY VALID -> Converter [ClientTypeDefinition]
generateTypes TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName, TypeContent TRUE ANY VALID
typeContent :: TypeContent TRUE ANY VALID
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent} = TypeContent TRUE ANY VALID -> Converter [ClientTypeDefinition]
subTypes TypeContent TRUE ANY VALID
typeContent
where
subTypes :: TypeContent TRUE ANY VALID -> Converter [ClientTypeDefinition]
subTypes :: TypeContent TRUE ANY VALID -> Converter [ClientTypeDefinition]
subTypes (DataInputObject FieldsDefinition IN VALID
inputFields) = do
[FieldDefinition IN VALID]
fields <- (FieldDefinition IN VALID -> Converter (FieldDefinition IN VALID))
-> [FieldDefinition IN VALID]
-> Converter [FieldDefinition IN VALID]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldDefinition IN VALID -> Converter (FieldDefinition IN VALID)
toClientFieldDefinition (FieldsDefinition IN VALID -> [FieldDefinition IN VALID]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FieldsDefinition IN VALID
inputFields)
[ClientTypeDefinition] -> Converter [ClientTypeDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[ TypeName
-> TypeKind
-> [ClientConstructorDefinition]
-> ClientTypeDefinition
mkInputType
TypeName
typeName
TypeKind
KindInputObject
[ ClientConstructorDefinition :: TypeName
-> [FieldDefinition ANY VALID] -> ClientConstructorDefinition
ClientConstructorDefinition
{ cName :: TypeName
cName = TypeName
typeName,
cFields :: [FieldDefinition ANY VALID]
cFields = (FieldDefinition IN VALID -> FieldDefinition ANY VALID)
-> [FieldDefinition IN VALID] -> [FieldDefinition ANY VALID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldDefinition IN VALID -> FieldDefinition ANY VALID
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny [FieldDefinition IN VALID]
fields
}
]
]
subTypes (DataEnum DataEnum VALID
enumTags) =
[ClientTypeDefinition] -> Converter [ClientTypeDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[ TypeName
-> TypeKind
-> [ClientConstructorDefinition]
-> ClientTypeDefinition
mkInputType
TypeName
typeName
TypeKind
KindEnum
((DataEnumValue VALID -> ClientConstructorDefinition)
-> DataEnum VALID -> [ClientConstructorDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DataEnumValue VALID -> ClientConstructorDefinition
forall (s :: Stage). DataEnumValue s -> ClientConstructorDefinition
mkConsEnum DataEnum VALID
enumTags)
]
subTypes DataScalar {} =
[ClientTypeDefinition] -> Converter [ClientTypeDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[ TypeName
-> TypeKind
-> [ClientConstructorDefinition]
-> ClientTypeDefinition
mkInputType
TypeName
typeName
TypeKind
KindScalar
[]
]
subTypes TypeContent TRUE ANY VALID
_ = [ClientTypeDefinition] -> Converter [ClientTypeDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
mkConsEnum :: DataEnumValue s -> ClientConstructorDefinition
mkConsEnum :: DataEnumValue s -> ClientConstructorDefinition
mkConsEnum DataEnumValue {TypeName
enumName :: TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName} = TypeName
-> [FieldDefinition ANY VALID] -> ClientConstructorDefinition
ClientConstructorDefinition TypeName
enumName []
mkInputType :: TypeName -> TypeKind -> [ClientConstructorDefinition] -> ClientTypeDefinition
mkInputType :: TypeName
-> TypeKind
-> [ClientConstructorDefinition]
-> ClientTypeDefinition
mkInputType TypeName
typename TypeKind
clientKind [ClientConstructorDefinition]
clientCons =
ClientTypeDefinition :: TypeNameTH
-> [ClientConstructorDefinition]
-> TypeKind
-> ClientTypeDefinition
ClientTypeDefinition
{ clientTypeName :: TypeNameTH
clientTypeName = [FieldName] -> TypeName -> TypeNameTH
TypeNameTH [] TypeName
typename,
TypeKind
clientKind :: TypeKind
clientKind :: TypeKind
clientKind,
[ClientConstructorDefinition]
clientCons :: [ClientConstructorDefinition]
clientCons :: [ClientConstructorDefinition]
clientCons
}
toClientFieldDefinition :: FieldDefinition IN VALID -> Converter (FieldDefinition IN VALID)
toClientFieldDefinition :: FieldDefinition IN VALID -> Converter (FieldDefinition IN VALID)
toClientFieldDefinition FieldDefinition {TypeRef
fieldType :: TypeRef
fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType, Maybe Description
Maybe (FieldContent TRUE IN VALID)
FieldName
Directives VALID
fieldDirectives :: Directives VALID
fieldContent :: Maybe (FieldContent TRUE IN VALID)
fieldName :: FieldName
fieldDescription :: Maybe Description
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives s
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
..} = do
TypeName
typeConName <- [FieldName] -> TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory).
[FieldName] -> TypeDefinition a VALID -> TypeName
typeFrom [] (TypeDefinition ANY VALID -> TypeName)
-> Converter (TypeDefinition ANY VALID) -> Converter TypeName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeName -> Converter (TypeDefinition ANY VALID)
getType (TypeRef -> TypeName
typeConName TypeRef
fieldType)
FieldDefinition IN VALID -> Converter (FieldDefinition IN 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 {fieldType :: TypeRef
fieldType = TypeRef
fieldType {TypeName
typeConName :: TypeName
typeConName :: TypeName
typeConName}, Maybe Description
Maybe (FieldContent TRUE IN VALID)
FieldName
Directives VALID
fieldDirectives :: Directives VALID
fieldContent :: Maybe (FieldContent TRUE IN VALID)
fieldName :: FieldName
fieldDescription :: Maybe Description
fieldDirectives :: Directives VALID
fieldDescription :: Maybe Description
fieldContent :: Maybe (FieldContent TRUE IN VALID)
fieldName :: FieldName
..}