{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.CodeGen.Server.Interpreting.Transform
  ( parseServerTypeDefinitions,
  )
where

import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Morpheus.CodeGen.Internal.AST
  ( AssociatedType (..),
    CodeGenConstructor (..),
    CodeGenField (..),
    CodeGenType (..),
    CodeGenTypeName (CodeGenTypeName, typeParameters),
    MethodArgument (..),
    TypeClassInstance (..),
    fromTypeName,
  )
import Data.Morpheus.CodeGen.Server.Internal.AST
  ( CodeGenConfig (..),
    DerivingClass (..),
    FIELD_TYPE_WRAPPER (..),
    GQLTypeDefinition (..),
    InterfaceDefinition (..),
    Kind (..),
    ServerDeclaration (..),
    ServerDirectiveUsage (..),
    ServerMethod (..),
  )
import Data.Morpheus.CodeGen.Server.Interpreting.Directive (dirRename, getDirs, getNamespaceDirs)
import Data.Morpheus.CodeGen.Server.Interpreting.Utils (CodeGenMonad (printWarnings), CodeGenT, TypeContext (..), getEnumName, getFieldName, inType, isParamResolverType, isSubscription)
import Data.Morpheus.CodeGen.TH (ToName (..))
import Data.Morpheus.CodeGen.Utils
  ( camelCaseTypeName,
    toHaskellTypeName,
  )
import Data.Morpheus.Core (parseDefinitions)
import Data.Morpheus.Error (renderGQLErrors)
import Data.Morpheus.Internal.Ext (Result (..))
import Data.Morpheus.Server.Types (Arg, DIRECTIVE_LOCATIONS, GQLDirective, GQLType (..), SubscriptionField)
import Data.Morpheus.Types.Internal.AST
  ( ANY,
    ArgumentDefinition (..),
    CONST,
    DataEnumValue (..),
    DirectiveDefinition (..),
    FieldContent (..),
    FieldDefinition (..),
    FieldName,
    FieldsDefinition,
    IN,
    OUT,
    RawTypeDefinition (..),
    TRUE,
    TypeContent (..),
    TypeDefinition (..),
    TypeKind (..),
    TypeName,
    TypeRef (..),
    UnionMember (..),
    isNullable,
    isPossibleInterfaceType,
    isResolverType,
    kindOf,
    packName,
    unpackName,
  )
import qualified Data.Morpheus.Types.Internal.AST as AST
import Relude hiding (ByteString, get)

parseServerTypeDefinitions :: CodeGenMonad m => CodeGenConfig -> ByteString -> m [ServerDeclaration]
parseServerTypeDefinitions :: forall (m :: * -> *).
CodeGenMonad m =>
CodeGenConfig -> ByteString -> m [ServerDeclaration]
parseServerTypeDefinitions CodeGenConfig
ctx ByteString
txt =
  case ByteString -> GQLResult [RawTypeDefinition]
parseDefinitions ByteString
txt of
    Failure NonEmpty GQLError
errors -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (NonEmpty GQLError -> String
renderGQLErrors NonEmpty GQLError
errors)
    Success {[RawTypeDefinition]
result :: forall err a. Result err a -> a
result :: [RawTypeDefinition]
result, [GQLError]
warnings :: forall err a. Result err a -> [err]
warnings :: [GQLError]
warnings} -> forall (m :: * -> *). CodeGenMonad m => [GQLError] -> m ()
printWarnings [GQLError]
warnings forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *).
CodeGenMonad m =>
Bool -> [RawTypeDefinition] -> m [ServerDeclaration]
toTHDefinitions (CodeGenConfig -> Bool
namespace CodeGenConfig
ctx) [RawTypeDefinition]
result

toTHDefinitions ::
  CodeGenMonad m =>
  Bool ->
  [RawTypeDefinition] ->
  m [ServerDeclaration]
toTHDefinitions :: forall (m :: * -> *).
CodeGenMonad m =>
Bool -> [RawTypeDefinition] -> m [ServerDeclaration]
toTHDefinitions Bool
namespace [RawTypeDefinition]
defs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *).
CodeGenMonad m =>
RawTypeDefinition -> m [ServerDeclaration]
generateTypes [RawTypeDefinition]
defs
  where
    typeDefinitions :: [TypeDefinition ANY CONST]
typeDefinitions = [TypeDefinition ANY CONST
td | RawTypeDefinition TypeDefinition ANY CONST
td <- [RawTypeDefinition]
defs]
    directiveDefinitions :: [DirectiveDefinition CONST]
directiveDefinitions = [DirectiveDefinition CONST
td | RawDirectiveDefinition DirectiveDefinition CONST
td <- [RawTypeDefinition]
defs]
    generateTypes :: CodeGenMonad m => RawTypeDefinition -> m [ServerDeclaration]
    generateTypes :: forall (m :: * -> *).
CodeGenMonad m =>
RawTypeDefinition -> m [ServerDeclaration]
generateTypes (RawTypeDefinition TypeDefinition ANY CONST
typeDef) =
      forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
        (forall (m :: * -> *).
CodeGenMonad m =>
TypeDefinition ANY CONST -> CodeGenT m [ServerDeclaration]
genTypeDefinition TypeDefinition ANY CONST
typeDef)
        TypeContext
          { toArgsTypeName :: FieldName -> TypeName
toArgsTypeName = Bool -> TypeName -> FieldName -> TypeName
mkArgsTypeName Bool
namespace (forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition ANY CONST
typeDef),
            [TypeDefinition ANY CONST]
typeDefinitions :: [TypeDefinition ANY CONST]
typeDefinitions :: [TypeDefinition ANY CONST]
typeDefinitions,
            [DirectiveDefinition CONST]
directiveDefinitions :: [DirectiveDefinition CONST]
directiveDefinitions :: [DirectiveDefinition CONST]
directiveDefinitions,
            currentTypeName :: Maybe TypeName
currentTypeName = forall a. a -> Maybe a
Just (forall a (t :: NAME). NamePacking a => a -> Name t
packName forall a b. (a -> b) -> a -> b
$ TypeName -> Text
toHaskellTypeName forall a b. (a -> b) -> a -> b
$ forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition ANY CONST
typeDef),
            currentKind :: Maybe TypeKind
currentKind = forall a. a -> Maybe a
Just (forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeKind
kindOf TypeDefinition ANY CONST
typeDef),
            hasNamespace :: Bool
hasNamespace = Bool
namespace
          }
    generateTypes (RawDirectiveDefinition DirectiveDefinition {[DirectiveLocation]
Maybe Text
FieldName
ArgumentsDefinition CONST
directiveDefinitionName :: forall (s :: Stage). DirectiveDefinition s -> FieldName
directiveDefinitionDescription :: forall (s :: Stage). DirectiveDefinition s -> Maybe Text
directiveDefinitionArgs :: forall (s :: Stage). DirectiveDefinition s -> ArgumentsDefinition s
directiveDefinitionLocations :: forall (s :: Stage). DirectiveDefinition s -> [DirectiveLocation]
directiveDefinitionLocations :: [DirectiveLocation]
directiveDefinitionArgs :: ArgumentsDefinition CONST
directiveDefinitionDescription :: Maybe Text
directiveDefinitionName :: FieldName
..}) =
      forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
        ( do
            [CodeGenField]
fields <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *) (c :: TypeCategory).
Monad m =>
FieldDefinition c CONST -> CodeGenT m CodeGenField
renderDataField (forall (s :: Stage). ArgumentDefinition s -> FieldDefinition IN s
argument forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ArgumentsDefinition CONST
directiveDefinitionArgs)
            let typename :: TypeName
typename = coerce :: forall a b. Coercible a b => a -> b
coerce FieldName
directiveDefinitionName
            [ServerDirectiveUsage]
namespaceDirs <- forall (s :: Stage) (m :: * -> *).
MonadReader (TypeContext s) m =>
Text -> m [ServerDirectiveUsage]
getNamespaceDirs (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
typename)
            let cgTypeName :: CodeGenTypeName
cgTypeName = TypeName -> CodeGenTypeName
fromTypeName TypeName
typename
            forall (f :: * -> *) a. Applicative f => a -> f a
pure
              [ CodeGenType -> ServerDeclaration
DataType
                  CodeGenType
                    { CodeGenTypeName
cgTypeName :: CodeGenTypeName
cgTypeName :: CodeGenTypeName
cgTypeName,
                      cgConstructors :: [CodeGenConstructor]
cgConstructors = [CodeGenTypeName -> [CodeGenField] -> CodeGenConstructor
CodeGenConstructor (TypeName -> CodeGenTypeName
fromTypeName TypeName
typename) [CodeGenField]
fields],
                      cgDerivations :: [DerivingClass]
cgDerivations = [DerivingClass
SHOW, DerivingClass
GENERIC]
                    },
                TypeClassInstance ServerMethod -> ServerDeclaration
GQLDirectiveInstance
                  TypeClassInstance
                    { typeClassName :: Name
typeClassName = ''GQLDirective,
                      typeClassContext :: [(Name, Name)]
typeClassContext = [],
                      typeClassTarget :: CodeGenTypeName
typeClassTarget = CodeGenTypeName
cgTypeName,
                      assoc :: [(Name, AssociatedType)]
assoc = [(''DIRECTIVE_LOCATIONS, [DirectiveLocation] -> AssociatedType
AssociatedLocations [DirectiveLocation]
directiveDefinitionLocations)],
                      typeClassMethods :: [(Name, MethodArgument, ServerMethod)]
typeClassMethods = []
                    },
                GQLTypeDefinition -> ServerDeclaration
gqlTypeToInstance
                  GQLTypeDefinition
                    { gqlTarget :: CodeGenTypeName
gqlTarget = CodeGenTypeName
cgTypeName,
                      gqlKind :: Kind
gqlKind = Kind
Type,
                      gqlTypeDefaultValues :: Map Text (Value CONST)
gqlTypeDefaultValues = forall a. Monoid a => a
mempty,
                      gqlTypeDirectiveUses :: [ServerDirectiveUsage]
gqlTypeDirectiveUses = [ServerDirectiveUsage]
namespaceDirs
                    }
              ]
        )
        TypeContext
          { toArgsTypeName :: FieldName -> TypeName
toArgsTypeName = coerce :: forall a b. Coercible a b => a -> b
coerce,
            [TypeDefinition ANY CONST]
typeDefinitions :: [TypeDefinition ANY CONST]
typeDefinitions :: [TypeDefinition ANY CONST]
typeDefinitions,
            currentTypeName :: Maybe TypeName
currentTypeName = forall a. a -> Maybe a
Just (coerce :: forall a b. Coercible a b => a -> b
coerce FieldName
directiveDefinitionName),
            [DirectiveDefinition CONST]
directiveDefinitions :: [DirectiveDefinition CONST]
directiveDefinitions :: [DirectiveDefinition CONST]
directiveDefinitions,
            currentKind :: Maybe TypeKind
currentKind = forall a. Maybe a
Nothing,
            hasNamespace :: Bool
hasNamespace = Bool
namespace
          }
    generateTypes RawTypeDefinition
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []

mkInterfaceName :: TypeName -> TypeName
mkInterfaceName :: TypeName -> TypeName
mkInterfaceName = (TypeName
"Interface" forall a. Semigroup a => a -> a -> a
<>)

mkPossibleTypesName :: TypeName -> TypeName
mkPossibleTypesName :: TypeName -> TypeName
mkPossibleTypesName = (TypeName
"PossibleTypes" forall a. Semigroup a => a -> a -> a
<>)

genTypeDefinition ::
  CodeGenMonad m =>
  TypeDefinition ANY CONST ->
  CodeGenT m [ServerDeclaration]
genTypeDefinition :: forall (m :: * -> *).
CodeGenMonad m =>
TypeDefinition ANY CONST -> CodeGenT m [ServerDeclaration]
genTypeDefinition
  typeDef :: TypeDefinition ANY CONST
typeDef@TypeDefinition {typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName = TypeName
originalTypeName, TypeContent TRUE ANY CONST
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent :: TypeContent TRUE ANY CONST
typeContent} =
    case TypeKind
tKind of
      TypeKind
KindScalar -> do
        ServerDeclaration
scalarGQLType <- ReaderT (TypeContext CONST) m ServerDeclaration
deriveGQL
        forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> ServerDeclaration
ScalarType (TypeName -> Text
toHaskellTypeName TypeName
typeName), ServerDeclaration
scalarGQLType]
      TypeKind
_ -> forall (m :: * -> *).
CodeGenMonad m =>
TypeName -> TypeContent TRUE ANY CONST -> CodeGenT m BuildPlan
genTypeContent TypeName
originalTypeName TypeContent TRUE ANY CONST
typeContent forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BuildPlan -> CodeGenT m [ServerDeclaration]
withType
    where
      typeName :: TypeName
typeName
        | TypeKind
tKind forall a. Eq a => a -> a -> Bool
== TypeKind
KindInterface = TypeName -> TypeName
mkInterfaceName TypeName
originalTypeName
        | Bool
otherwise = TypeName
originalTypeName
      tKind :: TypeKind
tKind = forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeKind
kindOf TypeDefinition ANY CONST
typeDef
      hsTypeName :: TypeName
hsTypeName = forall a (t :: NAME). NamePacking a => a -> Name t
packName forall a b. (a -> b) -> a -> b
$ TypeName -> Text
toHaskellTypeName TypeName
typeName
      cgTypeName :: CodeGenTypeName
cgTypeName = [FieldName] -> [Text] -> TypeName -> CodeGenTypeName
CodeGenTypeName [] [Text
"m" | forall t. Strictness t => t -> Bool
isResolverType TypeKind
tKind] TypeName
hsTypeName
      renameDir :: [ServerDirectiveUsage]
renameDir = [TypeValue -> ServerDirectiveUsage
TypeDirectiveUsage (forall (t :: NAME). Name t -> TypeValue
dirRename TypeName
originalTypeName) | TypeName
originalTypeName forall a. Eq a => a -> a -> Bool
/= TypeName
hsTypeName]
      deriveGQL :: ReaderT (TypeContext CONST) m ServerDeclaration
deriveGQL = do
        [ServerDirectiveUsage]
namespaceDirs <- forall (s :: Stage) (m :: * -> *).
MonadReader (TypeContext s) m =>
Text -> m [ServerDirectiveUsage]
getNamespaceDirs (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
hsTypeName)
        [ServerDirectiveUsage]
dirs <- forall a (m :: * -> *).
(Meta a, MonadFail m) =>
a -> CodeGenT m [ServerDirectiveUsage]
getDirs TypeDefinition ANY CONST
typeDef
        -- TODO: here
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
          GQLTypeDefinition -> ServerDeclaration
gqlTypeToInstance
            GQLTypeDefinition
              { gqlTarget :: CodeGenTypeName
gqlTarget = CodeGenTypeName
cgTypeName,
                gqlTypeDirectiveUses :: [ServerDirectiveUsage]
gqlTypeDirectiveUses = [ServerDirectiveUsage]
renameDir forall a. Semigroup a => a -> a -> a
<> [ServerDirectiveUsage]
namespaceDirs forall a. Semigroup a => a -> a -> a
<> [ServerDirectiveUsage]
dirs,
                gqlKind :: Kind
gqlKind = TypeKind -> Kind
derivingKind TypeKind
tKind,
                gqlTypeDefaultValues :: Map Text (Value CONST)
gqlTypeDefaultValues =
                  forall l. IsList l => [Item l] -> l
fromList forall a b. (a -> b) -> a -> b
$
                    forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall (c :: TypeCategory) (s :: Stage).
FieldDefinition c s -> Maybe (Text, Value s)
getDefaultValue forall a b. (a -> b) -> a -> b
$
                      forall (c :: TypeCategory) (s :: Stage).
TypeDefinition c s -> [FieldDefinition IN s]
getInputFields TypeDefinition ANY CONST
typeDef
              }
      cgDerivations :: [DerivingClass]
cgDerivations = Bool -> [DerivingClass]
derivesClasses (forall t. Strictness t => t -> Bool
isResolverType TypeKind
tKind)
      -------------------------
      withType :: BuildPlan -> CodeGenT m [ServerDeclaration]
withType (ConsIN [CodeGenConstructor]
cgConstructors) = do
        ServerDeclaration
gqlType <- ReaderT (TypeContext CONST) m ServerDeclaration
deriveGQL
        forall (f :: * -> *) a. Applicative f => a -> f a
pure [CodeGenType -> ServerDeclaration
DataType CodeGenType {[DerivingClass]
[CodeGenConstructor]
CodeGenTypeName
cgConstructors :: [CodeGenConstructor]
cgDerivations :: [DerivingClass]
cgTypeName :: CodeGenTypeName
cgDerivations :: [DerivingClass]
cgConstructors :: [CodeGenConstructor]
cgTypeName :: CodeGenTypeName
..}, ServerDeclaration
gqlType]
      withType (ConsOUT [ServerDeclaration]
others [CodeGenConstructor]
cgConstructors) = do
        ServerDeclaration
gqlType <- ReaderT (TypeContext CONST) m ServerDeclaration
deriveGQL
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodeGenType -> ServerDeclaration
DataType CodeGenType {[DerivingClass]
[CodeGenConstructor]
CodeGenTypeName
cgConstructors :: [CodeGenConstructor]
cgDerivations :: [DerivingClass]
cgTypeName :: CodeGenTypeName
cgDerivations :: [DerivingClass]
cgConstructors :: [CodeGenConstructor]
cgTypeName :: CodeGenTypeName
..} forall a. a -> [a] -> [a]
: ServerDeclaration
gqlType forall a. a -> [a] -> [a]
: [ServerDeclaration]
others)

derivingKind :: TypeKind -> Kind
derivingKind :: TypeKind -> Kind
derivingKind TypeKind
KindScalar = Kind
Scalar
derivingKind TypeKind
_ = Kind
Type

derivesClasses :: Bool -> [DerivingClass]
derivesClasses :: Bool -> [DerivingClass]
derivesClasses Bool
isResolver = DerivingClass
GENERIC forall a. a -> [a] -> [a]
: [DerivingClass
SHOW | Bool -> Bool
not Bool
isResolver]

mkObjectCons :: TypeName -> [CodeGenField] -> [CodeGenConstructor]
mkObjectCons :: TypeName -> [CodeGenField] -> [CodeGenConstructor]
mkObjectCons TypeName
name = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeGenTypeName -> [CodeGenField] -> CodeGenConstructor
CodeGenConstructor (TypeName -> CodeGenTypeName
fromTypeName TypeName
name)

mkArgsTypeName :: Bool -> TypeName -> FieldName -> TypeName
mkArgsTypeName :: Bool -> TypeName -> FieldName -> TypeName
mkArgsTypeName Bool
namespace TypeName
typeName FieldName
fieldName
  | Bool
namespace = TypeName
typeName forall a. Semigroup a => a -> a -> a
<> TypeName
argTName
  | Bool
otherwise = TypeName
argTName
  where
    argTName :: TypeName
argTName = forall (t :: NAME). [Name t] -> TypeName -> TypeName
camelCaseTypeName [FieldName
fieldName] TypeName
"Args"

mkObjectField ::
  CodeGenMonad m =>
  FieldDefinition OUT CONST ->
  CodeGenT m CodeGenField
mkObjectField :: forall (m :: * -> *).
CodeGenMonad m =>
FieldDefinition OUT CONST -> CodeGenT m CodeGenField
mkObjectField
  FieldDefinition
    { fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName = FieldName
fName,
      Maybe (FieldContent TRUE OUT CONST)
fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldContent :: Maybe (FieldContent TRUE OUT CONST)
fieldContent,
      fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType = TypeRef {TypeName
typeConName :: TypeRef -> TypeName
typeConName :: TypeName
typeConName, TypeWrapper
typeWrappers :: TypeRef -> TypeWrapper
typeWrappers :: TypeWrapper
typeWrappers}
    } = do
    Bool
isParametrized <- forall (m :: * -> *).
CodeGenMonad m =>
TypeName -> ReaderT (TypeContext CONST) m Bool
isParamResolverType TypeName
typeConName
    FieldName -> TypeName
genName <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (s :: Stage). TypeContext s -> FieldName -> TypeName
toArgsTypeName
    Maybe TypeKind
kind <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (s :: Stage). TypeContext s -> Maybe TypeKind
currentKind
    FieldName
fieldName <- forall (m :: * -> *). Monad m => FieldName -> CodeGenT m FieldName
getFieldName FieldName
fName
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      CodeGenField
        { fieldType :: TypeName
fieldType = forall a (t :: NAME). NamePacking a => a -> Name t
packName (TypeName -> Text
toHaskellTypeName TypeName
typeConName),
          fieldIsNullable :: Bool
fieldIsNullable = forall a. Nullable a => a -> Bool
isNullable TypeWrapper
typeWrappers,
          wrappers :: [FIELD_TYPE_WRAPPER]
wrappers =
            forall (s :: Stage).
FieldName
-> (FieldName -> TypeName)
-> [ArgumentDefinition s]
-> [FIELD_TYPE_WRAPPER]
mkFieldArguments FieldName
fName FieldName -> TypeName
genName (forall (bool :: Bool) (cat :: TypeCategory) (s :: Stage).
Maybe (FieldContent bool cat s) -> [ArgumentDefinition s]
toArgList Maybe (FieldContent TRUE OUT CONST)
fieldContent)
              forall a. Semigroup a => a -> a -> a
<> [Name -> FIELD_TYPE_WRAPPER
SUBSCRIPTION ''SubscriptionField | forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeKind -> Bool
isSubscription Maybe TypeKind
kind forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True]
              forall a. Semigroup a => a -> a -> a
<> [FIELD_TYPE_WRAPPER
MONAD]
              forall a. Semigroup a => a -> a -> a
<> [TypeWrapper -> FIELD_TYPE_WRAPPER
GQL_WRAPPER TypeWrapper
typeWrappers]
              forall a. Semigroup a => a -> a -> a
<> [FIELD_TYPE_WRAPPER
PARAMETRIZED | Bool
isParametrized],
          FieldName
fieldName :: FieldName
fieldName :: FieldName
..
        }

mkFieldArguments :: FieldName -> (FieldName -> TypeName) -> [ArgumentDefinition s] -> [FIELD_TYPE_WRAPPER]
mkFieldArguments :: forall (s :: Stage).
FieldName
-> (FieldName -> TypeName)
-> [ArgumentDefinition s]
-> [FIELD_TYPE_WRAPPER]
mkFieldArguments FieldName
_ FieldName -> TypeName
_ [] = []
mkFieldArguments
  FieldName
_
  FieldName -> TypeName
_
  [ ArgumentDefinition FieldDefinition {FieldName
fieldName :: FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName, TypeRef
fieldType :: TypeRef
fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType}
    ] = [Name -> FieldName -> TypeRef -> FIELD_TYPE_WRAPPER
TAGGED_ARG ''Arg FieldName
fieldName TypeRef
fieldType]
mkFieldArguments FieldName
fName FieldName -> TypeName
genName [ArgumentDefinition s]
_ = [TypeName -> FIELD_TYPE_WRAPPER
ARG (FieldName -> TypeName
genName FieldName
fName)]

toArgList :: Maybe (FieldContent bool cat s) -> [ArgumentDefinition s]
toArgList :: forall (bool :: Bool) (cat :: TypeCategory) (s :: Stage).
Maybe (FieldContent bool cat s) -> [ArgumentDefinition s]
toArgList (Just (FieldArgs ArgumentsDefinition s
args)) = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ArgumentsDefinition s
args
toArgList Maybe (FieldContent bool cat s)
_ = []

data BuildPlan
  = ConsIN [CodeGenConstructor]
  | ConsOUT [ServerDeclaration] [CodeGenConstructor]

gqlTypeToInstance :: GQLTypeDefinition -> ServerDeclaration
gqlTypeToInstance :: GQLTypeDefinition -> ServerDeclaration
gqlTypeToInstance GQLTypeDefinition {[ServerDirectiveUsage]
Map Text (Value CONST)
CodeGenTypeName
Kind
gqlTypeDefaultValues :: Map Text (Value CONST)
gqlTypeDirectiveUses :: [ServerDirectiveUsage]
gqlKind :: Kind
gqlTarget :: CodeGenTypeName
gqlTypeDirectiveUses :: GQLTypeDefinition -> [ServerDirectiveUsage]
gqlTypeDefaultValues :: GQLTypeDefinition -> Map Text (Value CONST)
gqlKind :: GQLTypeDefinition -> Kind
gqlTarget :: GQLTypeDefinition -> CodeGenTypeName
..} =
  Kind -> TypeClassInstance ServerMethod -> ServerDeclaration
GQLTypeInstance
    Kind
gqlKind
    TypeClassInstance
      { typeClassName :: Name
typeClassName = ''GQLType,
        typeClassContext :: [(Name, Name)]
typeClassContext = forall a b. (a -> b) -> [a] -> [b]
map ((''Typeable,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToName a => a -> Name
toName) (CodeGenTypeName -> [Text]
typeParameters CodeGenTypeName
gqlTarget),
        typeClassTarget :: CodeGenTypeName
typeClassTarget = CodeGenTypeName
gqlTarget,
        assoc :: [(Name, AssociatedType)]
assoc = [(''KIND, Name -> AssociatedType
AssociatedTypeName (forall a. ToName a => a -> Name
toName Kind
gqlKind))],
        typeClassMethods :: [(Name, MethodArgument, ServerMethod)]
typeClassMethods =
          [('defaultValues, MethodArgument
ProxyArgument, Map Text (Value CONST) -> ServerMethod
ServerMethodDefaultValues Map Text (Value CONST)
gqlTypeDefaultValues) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (Value CONST)
gqlTypeDefaultValues)]
            forall a. Semigroup a => a -> a -> a
<> [('directives, MethodArgument
ProxyArgument, [ServerDirectiveUsage] -> ServerMethod
ServerMethodDirectives [ServerDirectiveUsage]
gqlTypeDirectiveUses) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ServerDirectiveUsage]
gqlTypeDirectiveUses)]
      }

genInterfaceUnion :: Monad m => TypeName -> CodeGenT m [ServerDeclaration]
genInterfaceUnion :: forall (m :: * -> *).
Monad m =>
TypeName -> CodeGenT m [ServerDeclaration]
genInterfaceUnion TypeName
interfaceName =
  [TypeName] -> [ServerDeclaration]
mkInterface forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (c :: TypeCategory) (s :: Stage).
TypeName -> TypeDefinition c s -> Maybe (TypeDefinition c s)
isPossibleInterfaceType TypeName
interfaceName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (s :: Stage). TypeContext s -> [TypeDefinition ANY s]
typeDefinitions
  where
    mkInterface :: [TypeName] -> [ServerDeclaration]
mkInterface [] = []
    mkInterface [TypeName
possibleTypeName] = [TypeName -> ServerDeclaration
mkGuardWithPossibleType TypeName
possibleTypeName]
    mkInterface [TypeName]
members =
      [ TypeName -> ServerDeclaration
mkGuardWithPossibleType TypeName
tName,
        CodeGenType -> ServerDeclaration
DataType
          CodeGenType
            { cgTypeName :: CodeGenTypeName
cgTypeName = CodeGenTypeName
possTypeName,
              cgConstructors :: [CodeGenConstructor]
cgConstructors = forall a b. (a -> b) -> [a] -> [b]
map (TypeName -> TypeName -> CodeGenConstructor
mkUnionFieldDefinition TypeName
tName) [TypeName]
members,
              cgDerivations :: [DerivingClass]
cgDerivations = Bool -> [DerivingClass]
derivesClasses Bool
True
            },
        GQLTypeDefinition -> ServerDeclaration
gqlTypeToInstance
          GQLTypeDefinition
            { gqlTarget :: CodeGenTypeName
gqlTarget = CodeGenTypeName
possTypeName,
              gqlKind :: Kind
gqlKind = Kind
Type,
              gqlTypeDirectiveUses :: [ServerDirectiveUsage]
gqlTypeDirectiveUses = forall (f :: * -> *) a. Alternative f => f a
empty,
              gqlTypeDefaultValues :: Map Text (Value CONST)
gqlTypeDefaultValues = forall a. Monoid a => a
mempty
            }
      ]
      where
        possTypeName :: CodeGenTypeName
possTypeName = [FieldName] -> [Text] -> TypeName -> CodeGenTypeName
CodeGenTypeName [] [Text
"m"] (forall a (t :: NAME). NamePacking a => a -> Name t
packName forall a b. (a -> b) -> a -> b
$ TypeName -> Text
toHaskellTypeName TypeName
tName)
    mkGuardWithPossibleType :: TypeName -> ServerDeclaration
mkGuardWithPossibleType = InterfaceDefinition -> ServerDeclaration
InterfaceType forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> TypeName -> TypeName -> InterfaceDefinition
InterfaceDefinition TypeName
interfaceName (TypeName -> TypeName
mkInterfaceName TypeName
interfaceName)
    tName :: TypeName
tName = TypeName -> TypeName
mkPossibleTypesName TypeName
interfaceName

mkConsEnum :: Monad m => DataEnumValue CONST -> CodeGenT m CodeGenConstructor
mkConsEnum :: forall (m :: * -> *).
Monad m =>
DataEnumValue CONST -> CodeGenT m CodeGenConstructor
mkConsEnum DataEnumValue {TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName :: TypeName
enumName} = do
  CodeGenTypeName
constructorName <- forall (s :: Stage) (m :: * -> *).
MonadReader (TypeContext s) m =>
TypeName -> m CodeGenTypeName
getEnumName TypeName
enumName
  forall (f :: * -> *) a. Applicative f => a -> f a
pure CodeGenConstructor {CodeGenTypeName
constructorName :: CodeGenTypeName
constructorName :: CodeGenTypeName
constructorName, constructorFields :: [CodeGenField]
constructorFields = []}

renderDataField :: Monad m => FieldDefinition c CONST -> CodeGenT m CodeGenField
renderDataField :: forall (m :: * -> *) (c :: TypeCategory).
Monad m =>
FieldDefinition c CONST -> CodeGenT m CodeGenField
renderDataField FieldDefinition {fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType = TypeRef {TypeName
typeConName :: TypeName
typeConName :: TypeRef -> TypeName
typeConName, TypeWrapper
typeWrappers :: TypeWrapper
typeWrappers :: TypeRef -> TypeWrapper
typeWrappers}, fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName = FieldName
fName} = do
  FieldName
fieldName <- forall (m :: * -> *). Monad m => FieldName -> CodeGenT m FieldName
getFieldName FieldName
fName
  let wrappers :: [FIELD_TYPE_WRAPPER]
wrappers = [TypeWrapper -> FIELD_TYPE_WRAPPER
GQL_WRAPPER TypeWrapper
typeWrappers]
  let fieldType :: TypeName
fieldType = forall a (t :: NAME). NamePacking a => a -> Name t
packName (TypeName -> Text
toHaskellTypeName TypeName
typeConName)
  let fieldIsNullable :: Bool
fieldIsNullable = forall a. Nullable a => a -> Bool
isNullable TypeWrapper
typeWrappers
  forall (f :: * -> *) a. Applicative f => a -> f a
pure CodeGenField {Bool
[FIELD_TYPE_WRAPPER]
FieldName
TypeName
fieldIsNullable :: Bool
fieldType :: TypeName
wrappers :: [FIELD_TYPE_WRAPPER]
fieldName :: FieldName
fieldName :: FieldName
wrappers :: [FIELD_TYPE_WRAPPER]
fieldIsNullable :: Bool
fieldType :: TypeName
..}

genTypeContent ::
  CodeGenMonad m =>
  TypeName ->
  TypeContent TRUE ANY CONST ->
  CodeGenT m BuildPlan
genTypeContent :: forall (m :: * -> *).
CodeGenMonad m =>
TypeName -> TypeContent TRUE ANY CONST -> CodeGenT m BuildPlan
genTypeContent TypeName
_ DataScalar {} = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CodeGenConstructor] -> BuildPlan
ConsIN [])
genTypeContent TypeName
_ (DataEnum DataEnum CONST
tags) = [CodeGenConstructor] -> BuildPlan
ConsIN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *).
Monad m =>
DataEnumValue CONST -> CodeGenT m CodeGenConstructor
mkConsEnum DataEnum CONST
tags
genTypeContent TypeName
typeName (DataInputObject FieldsDefinition IN CONST
fields) =
  [CodeGenConstructor] -> BuildPlan
ConsIN forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> [CodeGenField] -> [CodeGenConstructor]
mkObjectCons TypeName
typeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *) (c :: TypeCategory).
Monad m =>
FieldDefinition c CONST -> CodeGenT m CodeGenField
renderDataField (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FieldsDefinition IN CONST
fields)
genTypeContent TypeName
_ DataInputUnion {} = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Input Unions not Supported"
genTypeContent TypeName
typeName DataInterface {FieldsDefinition OUT CONST
interfaceFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT CONST
interfaceFields} =
  [ServerDeclaration] -> [CodeGenConstructor] -> BuildPlan
ConsOUT
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadFail m =>
FieldsDefinition OUT CONST -> CodeGenT m [ServerDeclaration]
genArgumentTypes FieldsDefinition OUT CONST
interfaceFields forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
Monad m =>
TypeName -> CodeGenT m [ServerDeclaration]
genInterfaceUnion TypeName
typeName)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( do
            let interfaceName :: TypeName
interfaceName = TypeName -> TypeName
mkInterfaceName TypeName
typeName
            forall (s :: Stage) (m :: * -> *) a.
MonadReader (TypeContext s) m =>
Maybe TypeName -> m a -> m a
inType
              (forall a. a -> Maybe a
Just TypeName
interfaceName)
              ( TypeName -> [CodeGenField] -> [CodeGenConstructor]
mkObjectCons TypeName
interfaceName
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *).
CodeGenMonad m =>
FieldDefinition OUT CONST -> CodeGenT m CodeGenField
mkObjectField (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FieldsDefinition OUT CONST
interfaceFields)
              )
        )
genTypeContent TypeName
typeName DataObject {FieldsDefinition OUT CONST
objectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT CONST
objectFields} =
  [ServerDeclaration] -> [CodeGenConstructor] -> BuildPlan
ConsOUT
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadFail m =>
FieldsDefinition OUT CONST -> CodeGenT m [ServerDeclaration]
genArgumentTypes FieldsDefinition OUT CONST
objectFields
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( TypeName -> [CodeGenField] -> [CodeGenConstructor]
mkObjectCons TypeName
typeName
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *).
CodeGenMonad m =>
FieldDefinition OUT CONST -> CodeGenT m CodeGenField
mkObjectField (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FieldsDefinition OUT CONST
objectFields)
        )
genTypeContent TypeName
typeName (DataUnion UnionTypeDefinition OUT CONST
members) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [ServerDeclaration] -> [CodeGenConstructor] -> BuildPlan
ConsOUT [] (UnionMember OUT CONST -> CodeGenConstructor
unionCon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList UnionTypeDefinition OUT CONST
members)
  where
    unionCon :: UnionMember OUT CONST -> CodeGenConstructor
unionCon UnionMember {TypeName
memberName :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
memberName :: TypeName
memberName} = TypeName -> TypeName -> CodeGenConstructor
mkUnionFieldDefinition TypeName
typeName TypeName
memberName

mkUnionFieldDefinition :: TypeName -> TypeName -> CodeGenConstructor
mkUnionFieldDefinition :: TypeName -> TypeName -> CodeGenConstructor
mkUnionFieldDefinition TypeName
typeName TypeName
memberName =
  CodeGenConstructor
    { CodeGenTypeName
constructorName :: CodeGenTypeName
constructorName :: CodeGenTypeName
constructorName,
      constructorFields :: [CodeGenField]
constructorFields =
        [ CodeGenField
            { fieldName :: FieldName
fieldName = FieldName
"_",
              fieldType :: TypeName
fieldType = forall a (t :: NAME). NamePacking a => a -> Name t
packName (TypeName -> Text
toHaskellTypeName TypeName
memberName),
              wrappers :: [FIELD_TYPE_WRAPPER]
wrappers = [FIELD_TYPE_WRAPPER
PARAMETRIZED],
              fieldIsNullable :: Bool
fieldIsNullable = Bool
False
            }
        ]
    }
  where
    constructorName :: CodeGenTypeName
constructorName = [FieldName] -> [Text] -> TypeName -> CodeGenTypeName
CodeGenTypeName [coerce :: forall a b. Coercible a b => a -> b
coerce TypeName
typeName] [] TypeName
memberName

genArgumentTypes :: MonadFail m => FieldsDefinition OUT CONST -> CodeGenT m [ServerDeclaration]
genArgumentTypes :: forall (m :: * -> *).
MonadFail m =>
FieldsDefinition OUT CONST -> CodeGenT m [ServerDeclaration]
genArgumentTypes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *).
MonadFail m =>
FieldDefinition OUT CONST -> CodeGenT m [ServerDeclaration]
genArgumentType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

genArgumentType :: MonadFail m => FieldDefinition OUT CONST -> CodeGenT m [ServerDeclaration]
genArgumentType :: forall (m :: * -> *).
MonadFail m =>
FieldDefinition OUT CONST -> CodeGenT m [ServerDeclaration]
genArgumentType
  FieldDefinition
    { FieldName
fieldName :: FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName,
      fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldContent = Just (FieldArgs ArgumentsDefinition CONST
arguments)
    }
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length ArgumentsDefinition CONST
arguments forall a. Ord a => a -> a -> Bool
> Int
1 = do
        TypeName
tName <- (FieldName
fieldName forall a b. a -> (a -> b) -> b
&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (s :: Stage). TypeContext s -> FieldName -> TypeName
toArgsTypeName
        forall (s :: Stage) (m :: * -> *) a.
MonadReader (TypeContext s) m =>
Maybe TypeName -> m a -> m a
inType (forall a. a -> Maybe a
Just TypeName
tName) forall a b. (a -> b) -> a -> b
$ do
          let argumentFields :: [FieldDefinition IN CONST]
argumentFields = forall (s :: Stage). ArgumentDefinition s -> FieldDefinition IN s
argument forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ArgumentsDefinition CONST
arguments
          [CodeGenField]
fields <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *) (c :: TypeCategory).
Monad m =>
FieldDefinition c CONST -> CodeGenT m CodeGenField
renderDataField [FieldDefinition IN CONST]
argumentFields
          let typename :: Text
typename = TypeName -> Text
toHaskellTypeName TypeName
tName
          [ServerDirectiveUsage]
namespaceDirs <- forall (s :: Stage) (m :: * -> *).
MonadReader (TypeContext s) m =>
Text -> m [ServerDirectiveUsage]
getNamespaceDirs Text
typename
          [ServerDirectiveUsage]
dirs <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a (m :: * -> *).
(Meta a, MonadFail m) =>
a -> CodeGenT m [ServerDirectiveUsage]
getDirs [FieldDefinition IN CONST]
argumentFields
          let cgTypeName :: CodeGenTypeName
cgTypeName = TypeName -> CodeGenTypeName
fromTypeName (forall a (t :: NAME). NamePacking a => a -> Name t
packName Text
typename)
          forall (f :: * -> *) a. Applicative f => a -> f a
pure
            [ CodeGenType -> ServerDeclaration
DataType
                CodeGenType
                  { CodeGenTypeName
cgTypeName :: CodeGenTypeName
cgTypeName :: CodeGenTypeName
cgTypeName,
                    cgConstructors :: [CodeGenConstructor]
cgConstructors = TypeName -> [CodeGenField] -> [CodeGenConstructor]
mkObjectCons TypeName
tName [CodeGenField]
fields,
                    cgDerivations :: [DerivingClass]
cgDerivations = Bool -> [DerivingClass]
derivesClasses Bool
False
                  },
              GQLTypeDefinition -> ServerDeclaration
gqlTypeToInstance
                GQLTypeDefinition
                  { gqlTarget :: CodeGenTypeName
gqlTarget = CodeGenTypeName
cgTypeName,
                    gqlKind :: Kind
gqlKind = Kind
Type,
                    gqlTypeDefaultValues :: Map Text (Value CONST)
gqlTypeDefaultValues = forall l. IsList l => [Item l] -> l
fromList (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall (c :: TypeCategory) (s :: Stage).
FieldDefinition c s -> Maybe (Text, Value s)
getDefaultValue [FieldDefinition IN CONST]
argumentFields),
                    gqlTypeDirectiveUses :: [ServerDirectiveUsage]
gqlTypeDirectiveUses = [ServerDirectiveUsage]
namespaceDirs forall a. Semigroup a => a -> a -> a
<> [ServerDirectiveUsage]
dirs
                  }
            ]
genArgumentType FieldDefinition OUT CONST
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []

getInputFields :: TypeDefinition c s -> [FieldDefinition IN s]
getInputFields :: forall (c :: TypeCategory) (s :: Stage).
TypeDefinition c s -> [FieldDefinition IN s]
getInputFields TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataInputObject {FieldsDefinition IN s
inputObjectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields}} = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FieldsDefinition IN s
inputObjectFields
getInputFields TypeDefinition c s
_ = []

getDefaultValue :: FieldDefinition c s -> Maybe (Text, AST.Value s)
getDefaultValue :: forall (c :: TypeCategory) (s :: Stage).
FieldDefinition c s -> Maybe (Text, Value s)
getDefaultValue
  FieldDefinition
    { FieldName
fieldName :: FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName,
      fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldContent = Just DefaultInputValue {Value s
defaultInputValue :: forall (s :: Stage) (cat :: TypeCategory).
FieldContent (IN <=? cat) cat s -> Value s
defaultInputValue :: Value s
defaultInputValue}
    } = forall a. a -> Maybe a
Just (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
fieldName, Value s
defaultInputValue)
getDefaultValue FieldDefinition c s
_ = forall a. Maybe a
Nothing