{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

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

import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Morpheus.CodeGen.Internal.AST
  ( CodeGenConfig (..),
    DerivingClass (..),
    FIELD_TYPE_WRAPPER (..),
    GQLTypeDefinition (..),
    Kind (..),
    ServerConstructorDefinition (..),
    ServerFieldDefinition (..),
    ServerTypeDefinition (..),
  )
import Data.Morpheus.CodeGen.Internal.Name
  ( camelCaseFieldName,
    toHaskellTypeName,
  )
import Data.Morpheus.CodeGen.Internal.TH
  ( ToName (toName),
    camelCaseTypeName,
  )
import Data.Morpheus.Core
  ( parseTypeDefinitions,
  )
import Data.Morpheus.Error (gqlWarnings, renderGQLErrors)
import Data.Morpheus.Internal.Ext (GQLResult, Result (..))
import Data.Morpheus.Types.Internal.AST
  ( ANY,
    ArgumentDefinition (..),
    CONST,
    DataEnumValue (..),
    Description,
    Directives,
    FieldContent (..),
    FieldDefinition (..),
    FieldName,
    FieldsDefinition,
    GQLError,
    IN,
    OUT,
    OperationType (Subscription),
    TRUE,
    Token,
    TypeContent (..),
    TypeDefinition (..),
    TypeKind (..),
    TypeName,
    TypeRef (..),
    UnionMember (..),
    Value,
    isPossibleInterfaceType,
    isResolverType,
    kindOf,
    lookupWith,
    unpackName,
  )
import Language.Haskell.TH
  ( Dec (..),
    Info (..),
    Q,
    TyVarBndr,
    reify,
  )
import Relude hiding (ByteString, get)

type ServerQ m = ReaderT (TypeContext CONST) m

class (Monad m, MonadFail m) => CodeGenMonad m where
  isParametrizedType :: TypeName -> m Bool
  printWarnings :: [GQLError] -> m ()

isParametrizedHaskellType :: Info -> Bool
isParametrizedHaskellType :: Info -> Bool
isParametrizedHaskellType (TyConI Dec
x) = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Dec -> [TyVarBndr ()]
getTypeVariables Dec
x
isParametrizedHaskellType Info
_ = Bool
False

#if MIN_VERSION_template_haskell(2,17,0)
getTypeVariables :: Dec -> [TyVarBndr ()]
#else
getTypeVariables :: Dec -> [TyVarBndr]
#endif
getTypeVariables :: Dec -> [TyVarBndr ()]
getTypeVariables (DataD Cxt
_ Name
_ [TyVarBndr ()]
args Maybe Kind
_ [Con]
_ [DerivClause]
_) = [TyVarBndr ()]
args
getTypeVariables (NewtypeD Cxt
_ Name
_ [TyVarBndr ()]
args Maybe Kind
_ Con
_ [DerivClause]
_) = [TyVarBndr ()]
args
getTypeVariables (TySynD Name
_ [TyVarBndr ()]
args Kind
_) = [TyVarBndr ()]
args
getTypeVariables Dec
_ = []

instance CodeGenMonad Q where
  isParametrizedType :: TypeName -> Q Bool
isParametrizedType TypeName
name = Info -> Bool
isParametrizedHaskellType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Q Info
reify (forall a. ToName a => a -> Name
toName TypeName
name)
  printWarnings :: [GQLError] -> Q ()
printWarnings = [GQLError] -> Q ()
gqlWarnings

instance CodeGenMonad GQLResult where
  isParametrizedType :: TypeName -> GQLResult Bool
isParametrizedType TypeName
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  printWarnings :: [GQLError] -> GQLResult ()
printWarnings [GQLError]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

data TypeContext s = TypeContext
  { forall (s :: Stage). TypeContext s -> FieldName -> TypeName
toArgsTypeName :: FieldName -> TypeName,
    forall (s :: Stage). TypeContext s -> [TypeDefinition ANY s]
schema :: [TypeDefinition ANY s],
    forall (s :: Stage). TypeContext s -> TypeName
currentTypeName :: TypeName,
    forall (s :: Stage). TypeContext s -> Bool
hasNamespace :: Bool,
    forall (s :: Stage). TypeContext s -> Maybe TypeKind
currentKind :: Maybe TypeKind
  }

parseServerTypeDefinitions :: CodeGenMonad m => CodeGenConfig -> ByteString -> m [ServerTypeDefinition]
parseServerTypeDefinitions :: forall (m :: * -> *).
CodeGenMonad m =>
CodeGenConfig -> ByteString -> m [ServerTypeDefinition]
parseServerTypeDefinitions CodeGenConfig
ctx ByteString
txt =
  case ByteString -> GQLResult [TypeDefinition ANY CONST]
parseTypeDefinitions ByteString
txt of
    Failure NonEmpty GQLError
errors -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (NonEmpty GQLError -> String
renderGQLErrors NonEmpty GQLError
errors)
    Success {result :: forall err a. Result err a -> a
result = [TypeDefinition ANY CONST]
schema, [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 -> [TypeDefinition ANY CONST] -> m [ServerTypeDefinition]
toTHDefinitions (CodeGenConfig -> Bool
namespace CodeGenConfig
ctx) [TypeDefinition ANY CONST]
schema

toTHDefinitions ::
  CodeGenMonad m =>
  Bool ->
  [TypeDefinition ANY CONST] ->
  m [ServerTypeDefinition]
toTHDefinitions :: forall (m :: * -> *).
CodeGenMonad m =>
Bool -> [TypeDefinition ANY CONST] -> m [ServerTypeDefinition]
toTHDefinitions Bool
namespace [TypeDefinition ANY CONST]
schema = 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 =>
TypeDefinition ANY CONST -> m [ServerTypeDefinition]
generateTypes [TypeDefinition ANY CONST]
schema
  where
    generateTypes :: CodeGenMonad m => TypeDefinition ANY CONST -> m [ServerTypeDefinition]
    generateTypes :: forall (m :: * -> *).
CodeGenMonad m =>
TypeDefinition ANY CONST -> m [ServerTypeDefinition]
generateTypes TypeDefinition ANY CONST
typeDef =
      forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
        (forall (m :: * -> *).
CodeGenMonad m =>
TypeDefinition ANY CONST -> ServerQ m [ServerTypeDefinition]
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]
schema :: [TypeDefinition ANY CONST]
schema :: [TypeDefinition ANY CONST]
schema,
            currentTypeName :: TypeName
currentTypeName = 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
          }

inType :: MonadReader (TypeContext s) m => TypeName -> m a -> m a
inType :: forall (s :: Stage) (m :: * -> *) a.
MonadReader (TypeContext s) m =>
TypeName -> m a -> m a
inType TypeName
currentTypeName = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\TypeContext s
x -> TypeContext s
x {TypeName
currentTypeName :: TypeName
currentTypeName :: TypeName
currentTypeName, currentKind :: Maybe TypeKind
currentKind = forall a. Maybe a
Nothing})

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 ->
  ServerQ m [ServerTypeDefinition]
genTypeDefinition :: forall (m :: * -> *).
CodeGenMonad m =>
TypeDefinition ANY CONST -> ServerQ m [ServerTypeDefinition]
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,
      Maybe Text
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Text
typeDescription :: Maybe Text
typeDescription
    } = BuildPlan -> [ServerTypeDefinition]
withType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
CodeGenMonad m =>
TypeName -> TypeContent TRUE ANY CONST -> ServerQ m BuildPlan
genTypeContent TypeName
originalTypeName TypeContent TRUE ANY CONST
typeContent
    where
      typeName :: TypeName
typeName = case TypeContent TRUE ANY CONST
typeContent of
        DataInterface {} -> TypeName -> TypeName
mkInterfaceName TypeName
originalTypeName
        TypeContent TRUE ANY CONST
_ -> TypeName
originalTypeName
      tKind :: TypeKind
tKind = forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeKind
kindOf TypeDefinition ANY CONST
typeDef
      tName :: Text
tName = TypeName -> Text
toHaskellTypeName TypeName
typeName
      gql :: Maybe GQLTypeDefinition
gql =
        forall a. a -> Maybe a
Just
          GQLTypeDefinition
            { gqlTypeDescription :: Maybe Text
gqlTypeDescription = Maybe Text
typeDescription,
              gqlTypeDescriptions :: Map Text Text
gqlTypeDescriptions = forall (c :: TypeCategory) (s :: Stage).
TypeDefinition c s -> Map Text Text
getDesc TypeDefinition ANY CONST
typeDef,
              gqlTypeDirectives :: Map Text (Directives CONST)
gqlTypeDirectives = forall (c :: TypeCategory) (s :: Stage).
TypeDefinition c s -> Map Text (Directives s)
getDirs TypeDefinition ANY CONST
typeDef,
              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
            }
      typeParameters :: [Text]
typeParameters
        | forall t. Strictness t => t -> Bool
isResolverType TypeKind
tKind = [Text
"m"]
        | Bool
otherwise = []
      derives :: [DerivingClass]
derives = Bool -> [DerivingClass]
derivesClasses (forall t. Strictness t => t -> Bool
isResolverType TypeKind
tKind)
      -------------------------
      withType :: BuildPlan -> [ServerTypeDefinition]
withType (ConsIN [ServerConstructorDefinition]
tCons) = [ServerTypeDefinition {[Text]
[ServerConstructorDefinition]
[DerivingClass]
Maybe GQLTypeDefinition
Text
TypeKind
gql :: Maybe GQLTypeDefinition
derives :: [DerivingClass]
tKind :: TypeKind
tCons :: [ServerConstructorDefinition]
typeParameters :: [Text]
tName :: Text
tCons :: [ServerConstructorDefinition]
derives :: [DerivingClass]
typeParameters :: [Text]
gql :: Maybe GQLTypeDefinition
tName :: Text
tKind :: TypeKind
..}]
      withType (ConsOUT [ServerTypeDefinition]
others [ServerConstructorDefinition]
tCons) = ServerTypeDefinition {[Text]
[ServerConstructorDefinition]
[DerivingClass]
Maybe GQLTypeDefinition
Text
TypeKind
tCons :: [ServerConstructorDefinition]
gql :: Maybe GQLTypeDefinition
derives :: [DerivingClass]
tKind :: TypeKind
tCons :: [ServerConstructorDefinition]
typeParameters :: [Text]
tName :: Text
derives :: [DerivingClass]
typeParameters :: [Text]
gql :: Maybe GQLTypeDefinition
tName :: Text
tKind :: TypeKind
..} forall a. a -> [a] -> [a]
: [ServerTypeDefinition]
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 -> [ServerFieldDefinition] -> [ServerConstructorDefinition]
mkObjectCons :: TypeName
-> [ServerFieldDefinition] -> [ServerConstructorDefinition]
mkObjectCons TypeName
name = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> [ServerFieldDefinition] -> ServerConstructorDefinition
ServerConstructorDefinition 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"

isParametrizedResolverType :: CodeGenMonad m => TypeName -> [TypeDefinition ANY s] -> m Bool
isParametrizedResolverType :: forall (m :: * -> *) (s :: Stage).
CodeGenMonad m =>
TypeName -> [TypeDefinition ANY s] -> m Bool
isParametrizedResolverType TypeName
"__TypeKind" [TypeDefinition ANY s]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isParametrizedResolverType TypeName
"Boolean" [TypeDefinition ANY s]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isParametrizedResolverType TypeName
"String" [TypeDefinition ANY s]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isParametrizedResolverType TypeName
"Int" [TypeDefinition ANY s]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isParametrizedResolverType TypeName
"Float" [TypeDefinition ANY s]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isParametrizedResolverType TypeName
name [TypeDefinition ANY s]
lib = case forall k a. Eq k => (a -> k) -> k -> [a] -> Maybe a
lookupWith forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeName
name [TypeDefinition ANY s]
lib of
  Just TypeDefinition ANY s
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall t. Strictness t => t -> Bool
isResolverType TypeDefinition ANY s
x)
  Maybe (TypeDefinition ANY s)
Nothing -> forall (m :: * -> *). CodeGenMonad m => TypeName -> m Bool
isParametrizedType TypeName
name

isSubscription :: TypeKind -> Bool
isSubscription :: TypeKind -> Bool
isSubscription (KindObject (Just OperationType
Subscription)) = Bool
True
isSubscription TypeKind
_ = Bool
False

mkObjectField ::
  CodeGenMonad m =>
  FieldDefinition OUT CONST ->
  ServerQ m ServerFieldDefinition
mkObjectField :: forall (m :: * -> *).
CodeGenMonad m =>
FieldDefinition OUT CONST -> ServerQ m ServerFieldDefinition
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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (s :: Stage).
CodeGenMonad m =>
TypeName -> [TypeDefinition ANY s] -> m Bool
isParametrizedResolverType TypeName
typeConName forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (s :: Stage). TypeContext s -> [TypeDefinition ANY s]
schema
    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 -> ServerQ m FieldName
genFieldName FieldName
fName
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ServerFieldDefinition
        { fieldType :: Text
fieldType = TypeName -> Text
toHaskellTypeName TypeName
typeConName,
          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
<> [FIELD_TYPE_WRAPPER
SUBSCRIPTION | 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}
    ] = [FieldName -> TypeRef -> FIELD_TYPE_WRAPPER
TAGGED_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 [ServerConstructorDefinition]
  | ConsOUT [ServerTypeDefinition] [ServerConstructorDefinition]

genInterfaceUnion :: Monad m => TypeName -> ServerQ m [ServerTypeDefinition]
genInterfaceUnion :: forall (m :: * -> *).
Monad m =>
TypeName -> ServerQ m [ServerTypeDefinition]
genInterfaceUnion TypeName
interfaceName =
  [TypeName] -> [ServerTypeDefinition]
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]
schema
  where
    tKind :: TypeKind
tKind = TypeKind
KindUnion
    mkInterface :: [TypeName] -> [ServerTypeDefinition]
mkInterface [] = []
    mkInterface [TypeName
possibleTypeName] = [TypeName -> ServerTypeDefinition
mkGuardWithPossibleType TypeName
possibleTypeName]
    mkInterface [TypeName]
members =
      [ TypeName -> ServerTypeDefinition
mkGuardWithPossibleType TypeName
tName,
        ServerTypeDefinition
          { tName :: Text
tName = TypeName -> Text
toHaskellTypeName TypeName
tName,
            tCons :: [ServerConstructorDefinition]
tCons = forall a b. (a -> b) -> [a] -> [b]
map (TypeName -> TypeName -> ServerConstructorDefinition
mkUnionFieldDefinition TypeName
tName) [TypeName]
members,
            TypeKind
tKind :: TypeKind
tKind :: TypeKind
tKind,
            typeParameters :: [Text]
typeParameters = [Text
"m"],
            derives :: [DerivingClass]
derives = Bool -> [DerivingClass]
derivesClasses Bool
True,
            gql :: Maybe GQLTypeDefinition
gql = forall a. Maybe a
Nothing
          }
      ]
    mkGuardWithPossibleType :: TypeName -> ServerTypeDefinition
mkGuardWithPossibleType = TypeName -> TypeName -> TypeName -> ServerTypeDefinition
ServerInterfaceDefinition TypeName
interfaceName (TypeName -> TypeName
mkInterfaceName TypeName
interfaceName)
    tName :: TypeName
tName = TypeName -> TypeName
mkPossibleTypesName TypeName
interfaceName

genFieldName :: Monad m => FieldName -> ServerQ m FieldName
genFieldName :: forall (m :: * -> *). Monad m => FieldName -> ServerQ m FieldName
genFieldName FieldName
fieldName = do
  TypeContext {Bool
hasNamespace :: Bool
hasNamespace :: forall (s :: Stage). TypeContext s -> Bool
hasNamespace, TypeName
currentTypeName :: TypeName
currentTypeName :: forall (s :: Stage). TypeContext s -> TypeName
currentTypeName} <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    if Bool
hasNamespace
      then TypeName -> FieldName -> FieldName
camelCaseFieldName TypeName
currentTypeName FieldName
fieldName
      else FieldName
fieldName

mkConsEnum :: Monad m => TypeName -> DataEnumValue CONST -> ServerQ m ServerConstructorDefinition
mkConsEnum :: forall (m :: * -> *).
Monad m =>
TypeName
-> DataEnumValue CONST -> ServerQ m ServerConstructorDefinition
mkConsEnum TypeName
name DataEnumValue {TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName :: TypeName
enumName} = do
  Bool
namespace <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (s :: Stage). TypeContext s -> Bool
hasNamespace
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ServerConstructorDefinition
      { constructorName :: TypeName
constructorName =
          if Bool
namespace
            then forall (t :: NAME). [Name t] -> TypeName -> TypeName
camelCaseTypeName [TypeName
name] TypeName
enumName
            else TypeName
enumName,
        constructorFields :: [ServerFieldDefinition]
constructorFields = []
      }

toNonResolverServerField :: Monad m => FieldDefinition c CONST -> ServerQ m ServerFieldDefinition
toNonResolverServerField :: forall (m :: * -> *) (c :: TypeCategory).
Monad m =>
FieldDefinition c CONST -> ServerQ m ServerFieldDefinition
toNonResolverServerField
  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 -> ServerQ m FieldName
genFieldName FieldName
fName
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      ServerFieldDefinition
        { fieldType :: Text
fieldType = TypeName -> Text
toHaskellTypeName TypeName
typeConName,
          FieldName
fieldName :: FieldName
fieldName :: FieldName
fieldName,
          wrappers :: [FIELD_TYPE_WRAPPER]
wrappers = [TypeWrapper -> FIELD_TYPE_WRAPPER
GQL_WRAPPER TypeWrapper
typeWrappers]
        }

genTypeContent ::
  CodeGenMonad m =>
  TypeName ->
  TypeContent TRUE ANY CONST ->
  ServerQ m BuildPlan
genTypeContent :: forall (m :: * -> *).
CodeGenMonad m =>
TypeName -> TypeContent TRUE ANY CONST -> ServerQ m BuildPlan
genTypeContent TypeName
_ DataScalar {} = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ServerConstructorDefinition] -> BuildPlan
ConsIN [])
genTypeContent TypeName
typeName (DataEnum DataEnum CONST
tags) = [ServerConstructorDefinition] -> 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 =>
TypeName
-> DataEnumValue CONST -> ServerQ m ServerConstructorDefinition
mkConsEnum TypeName
typeName) DataEnum CONST
tags
genTypeContent TypeName
typeName (DataInputObject FieldsDefinition IN CONST
fields) =
  [ServerConstructorDefinition] -> BuildPlan
ConsIN forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName
-> [ServerFieldDefinition] -> [ServerConstructorDefinition]
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 -> ServerQ m ServerFieldDefinition
toNonResolverServerField (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} =
  [ServerTypeDefinition]
-> [ServerConstructorDefinition] -> 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 :: * -> *).
Monad m =>
FieldsDefinition OUT CONST -> ServerQ m [ServerTypeDefinition]
genArgumentTypes FieldsDefinition OUT CONST
interfaceFields forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
Monad m =>
TypeName -> ServerQ m [ServerTypeDefinition]
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 =>
TypeName -> m a -> m a
inType
              TypeName
interfaceName
              ( TypeName
-> [ServerFieldDefinition] -> [ServerConstructorDefinition]
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 -> ServerQ m ServerFieldDefinition
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} =
  [ServerTypeDefinition]
-> [ServerConstructorDefinition] -> BuildPlan
ConsOUT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
FieldsDefinition OUT CONST -> ServerQ m [ServerTypeDefinition]
genArgumentTypes FieldsDefinition OUT CONST
objectFields
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( TypeName
-> [ServerFieldDefinition] -> [ServerConstructorDefinition]
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 -> ServerQ m ServerFieldDefinition
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
$ [ServerTypeDefinition]
-> [ServerConstructorDefinition] -> BuildPlan
ConsOUT [] (UnionMember OUT CONST -> ServerConstructorDefinition
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 -> ServerConstructorDefinition
unionCon UnionMember {TypeName
memberName :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
memberName :: TypeName
memberName} = TypeName -> TypeName -> ServerConstructorDefinition
mkUnionFieldDefinition TypeName
typeName TypeName
memberName

mkUnionFieldDefinition :: TypeName -> TypeName -> ServerConstructorDefinition
mkUnionFieldDefinition :: TypeName -> TypeName -> ServerConstructorDefinition
mkUnionFieldDefinition TypeName
typeName TypeName
memberName =
  ServerConstructorDefinition
    { TypeName
constructorName :: TypeName
constructorName :: TypeName
constructorName,
      constructorFields :: [ServerFieldDefinition]
constructorFields =
        [ ServerFieldDefinition
            { fieldName :: FieldName
fieldName = coerce :: forall a b. Coercible a b => a -> b
coerce (TypeName
"un" forall a. Semigroup a => a -> a -> a
<> TypeName
constructorName),
              fieldType :: Text
fieldType = TypeName -> Text
toHaskellTypeName TypeName
memberName,
              wrappers :: [FIELD_TYPE_WRAPPER]
wrappers = [FIELD_TYPE_WRAPPER
PARAMETRIZED]
            }
        ]
    }
  where
    constructorName :: TypeName
constructorName = forall (t :: NAME). [Name t] -> TypeName -> TypeName
camelCaseTypeName [TypeName
typeName] TypeName
memberName

genArgumentTypes :: Monad m => FieldsDefinition OUT CONST -> ServerQ m [ServerTypeDefinition]
genArgumentTypes :: forall (m :: * -> *).
Monad m =>
FieldsDefinition OUT CONST -> ServerQ m [ServerTypeDefinition]
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 :: * -> *).
Monad m =>
FieldDefinition OUT CONST -> ServerQ m [ServerTypeDefinition]
genArgumentType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

genArgumentType :: Monad m => FieldDefinition OUT CONST -> ServerQ m [ServerTypeDefinition]
genArgumentType :: forall (m :: * -> *).
Monad m =>
FieldDefinition OUT CONST -> ServerQ m [ServerTypeDefinition]
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 =>
TypeName -> m a -> m a
inType 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
        [ServerFieldDefinition]
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 -> ServerQ m ServerFieldDefinition
toNonResolverServerField [FieldDefinition IN CONST]
argumentFields
        let tKind :: TypeKind
tKind = TypeKind
KindInputObject
        forall (f :: * -> *) a. Applicative f => a -> f a
pure
          [ ServerTypeDefinition
              { tName :: Text
tName = TypeName -> Text
toHaskellTypeName TypeName
tName,
                TypeKind
tKind :: TypeKind
tKind :: TypeKind
tKind,
                tCons :: [ServerConstructorDefinition]
tCons = TypeName
-> [ServerFieldDefinition] -> [ServerConstructorDefinition]
mkObjectCons TypeName
tName [ServerFieldDefinition]
fields,
                derives :: [DerivingClass]
derives = Bool -> [DerivingClass]
derivesClasses Bool
False,
                typeParameters :: [Text]
typeParameters = [],
                gql :: Maybe GQLTypeDefinition
gql =
                  forall a. a -> Maybe a
Just
                    ( GQLTypeDefinition
                        { gqlKind :: Kind
gqlKind = Kind
Type,
                          gqlTypeDescription :: Maybe Text
gqlTypeDescription = forall a. Maybe a
Nothing,
                          gqlTypeDescriptions :: Map Text Text
gqlTypeDescriptions = forall l. IsList l => [Item l] -> l
fromList (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (Text, Text)
mkFieldDescription [FieldDefinition IN CONST]
argumentFields),
                          gqlTypeDirectives :: Map Text (Directives CONST)
gqlTypeDirectives = forall l. IsList l => [Item l] -> l
fromList (forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> (Text, Directives s)
mkFieldDirective forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldDefinition IN CONST]
argumentFields),
                          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)
                        }
                    )
              }
          ]
genArgumentType FieldDefinition OUT CONST
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []

mkFieldDescription :: FieldDefinition cat s -> Maybe (Text, Description)
mkFieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (Text, Text)
mkFieldDescription FieldDefinition {Maybe Text
Maybe (FieldContent TRUE cat s)
TypeRef
FieldName
Directives s
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Text
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives s
fieldDirectives :: Directives s
fieldContent :: Maybe (FieldContent TRUE cat s)
fieldType :: TypeRef
fieldName :: FieldName
fieldDescription :: Maybe Text
fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
..} = (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
fieldName,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
fieldDescription

mkFieldDirective :: FieldDefinition cat s -> (Text, Directives s)
mkFieldDirective :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> (Text, Directives s)
mkFieldDirective FieldDefinition {Maybe Text
Maybe (FieldContent TRUE cat s)
TypeRef
FieldName
Directives s
fieldDirectives :: Directives s
fieldContent :: Maybe (FieldContent TRUE cat s)
fieldType :: TypeRef
fieldName :: FieldName
fieldDescription :: Maybe Text
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Text
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives s
fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
..} = (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
fieldName, Directives s
fieldDirectives)

---

getDesc :: TypeDefinition c s -> Map Token Description
getDesc :: forall (c :: TypeCategory) (s :: Stage).
TypeDefinition c s -> Map Text Text
getDesc = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a v. Meta a v => a -> [(Text, v)]
get

getDirs :: TypeDefinition c s -> Map Token (Directives s)
getDirs :: forall (c :: TypeCategory) (s :: Stage).
TypeDefinition c s -> Map Text (Directives s)
getDirs = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a v. Meta a v => a -> [(Text, v)]
get

class Meta a v where
  get :: a -> [(Token, v)]

instance (Meta a v) => Meta (Maybe a) v where
  get :: Maybe a -> [(Text, v)]
get (Just a
x) = forall a v. Meta a v => a -> [(Text, v)]
get a
x
  get Maybe a
_ = []

instance
  ( Meta (FieldsDefinition IN s) v,
    Meta (FieldsDefinition OUT s) v,
    Meta (DataEnumValue s) v
  ) =>
  Meta (TypeDefinition c s) v
  where
  get :: TypeDefinition c s -> [(Text, v)]
get TypeDefinition {TypeContent TRUE c s
typeContent :: TypeContent TRUE c s
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent} = forall a v. Meta a v => a -> [(Text, v)]
get TypeContent TRUE c s
typeContent

instance
  ( Meta (FieldsDefinition IN s) v,
    Meta (FieldsDefinition OUT s) v,
    Meta (DataEnumValue s) v
  ) =>
  Meta (TypeContent a c s) v
  where
  get :: TypeContent a c s -> [(Text, v)]
get DataObject {FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields} = forall a v. Meta a v => a -> [(Text, v)]
get FieldsDefinition OUT s
objectFields
  get DataInputObject {FieldsDefinition IN s
inputObjectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields} = forall a v. Meta a v => a -> [(Text, v)]
get FieldsDefinition IN s
inputObjectFields
  get DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
interfaceFields} = forall a v. Meta a v => a -> [(Text, v)]
get FieldsDefinition OUT s
interfaceFields
  get DataEnum {DataEnum s
enumMembers :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent LEAF a s -> DataEnum s
enumMembers :: DataEnum s
enumMembers} = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a v. Meta a v => a -> [(Text, v)]
get DataEnum s
enumMembers
  get TypeContent a c s
_ = []

instance Meta (DataEnumValue s) Description where
  get :: DataEnumValue s -> [(Text, Text)]
get DataEnumValue {TypeName
enumName :: TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName, enumDescription :: forall (s :: Stage). DataEnumValue s -> Maybe Text
enumDescription = Just Text
x} = [(forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
enumName, Text
x)]
  get DataEnumValue s
_ = []

instance Meta (DataEnumValue s) (Directives s) where
  get :: DataEnumValue s -> [(Text, Directives s)]
get DataEnumValue {TypeName
enumName :: TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName, Directives s
enumDirectives :: forall (s :: Stage). DataEnumValue s -> Directives s
enumDirectives :: Directives s
enumDirectives}
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Directives s
enumDirectives = []
    | Bool
otherwise = [(forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
enumName, Directives s
enumDirectives)]

instance
  Meta (FieldDefinition c s) v =>
  Meta (FieldsDefinition c s) v
  where
  get :: FieldsDefinition c s -> [(Text, v)]
get = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a v. Meta a v => a -> [(Text, v)]
get forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance Meta (FieldDefinition c s) Description where
  get :: FieldDefinition c s -> [(Text, Text)]
get FieldDefinition {FieldName
fieldName :: FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName, fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Text
fieldDescription = Just Text
x} = [(forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
fieldName, Text
x)]
  get FieldDefinition c s
_ = []

instance Meta (FieldDefinition c s) (Directives s) where
  get :: FieldDefinition c s -> [(Text, Directives s)]
get FieldDefinition {FieldName
fieldName :: FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName, Directives s
fieldDirectives :: Directives s
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives s
fieldDirectives}
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Directives s
fieldDirectives = []
    | Bool
otherwise = [(forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
fieldName, Directives s
fieldDirectives)]

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 :: FieldsDefinition IN s
inputObjectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent INPUT_OBJECT a s -> 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, 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