{-# 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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [TyVarBndr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TyVarBndr] -> Bool) -> [TyVarBndr] -> Bool
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 (Info -> Bool) -> Q Info -> Q Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Q Info
reify (TypeName -> Name
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
_ = Bool -> GQLResult Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  printWarnings :: [GQLError] -> GQLResult ()
printWarnings [GQLError]
_ = () -> GQLResult ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

parseServerTypeDefinitions :: CodeGenMonad m => CodeGenConfig -> ByteString -> m [ServerTypeDefinition]
parseServerTypeDefinitions :: CodeGenConfig -> ByteString -> m [ServerTypeDefinition]
parseServerTypeDefinitions CodeGenConfig
ctx ByteString
txt =
  case ByteString -> GQLResult [TypeDefinition ANY CONST]
parseTypeDefinitions ByteString
txt of
    Failure NonEmpty GQLError
errors -> String -> m [ServerTypeDefinition]
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} -> [GQLError] -> m ()
forall (m :: * -> *). CodeGenMonad m => [GQLError] -> m ()
printWarnings [GQLError]
warnings m () -> m [ServerTypeDefinition] -> m [ServerTypeDefinition]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> [TypeDefinition ANY CONST] -> m [ServerTypeDefinition]
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 :: Bool -> [TypeDefinition ANY CONST] -> m [ServerTypeDefinition]
toTHDefinitions Bool
namespace [TypeDefinition ANY CONST]
schema = [[ServerTypeDefinition]] -> [ServerTypeDefinition]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ServerTypeDefinition]] -> [ServerTypeDefinition])
-> m [[ServerTypeDefinition]] -> m [ServerTypeDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeDefinition ANY CONST -> m [ServerTypeDefinition])
-> [TypeDefinition ANY CONST] -> m [[ServerTypeDefinition]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TypeDefinition ANY CONST -> m [ServerTypeDefinition]
forall (m :: * -> *).
CodeGenMonad m =>
TypeDefinition ANY CONST -> m [ServerTypeDefinition]
generateTypes [TypeDefinition ANY CONST]
schema
  where
    generateTypes :: CodeGenMonad m => TypeDefinition ANY CONST -> m [ServerTypeDefinition]
    generateTypes :: TypeDefinition ANY CONST -> m [ServerTypeDefinition]
generateTypes TypeDefinition ANY CONST
typeDef =
      ReaderT (TypeContext CONST) m [ServerTypeDefinition]
-> TypeContext CONST -> m [ServerTypeDefinition]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
        (TypeDefinition ANY CONST
-> ReaderT (TypeContext CONST) m [ServerTypeDefinition]
forall (m :: * -> *).
CodeGenMonad m =>
TypeDefinition ANY CONST -> ServerQ m [ServerTypeDefinition]
genTypeDefinition TypeDefinition ANY CONST
typeDef)
        TypeContext :: forall (s :: Stage).
(FieldName -> TypeName)
-> [TypeDefinition ANY s]
-> TypeName
-> Bool
-> Maybe TypeKind
-> TypeContext s
TypeContext
          { toArgsTypeName :: FieldName -> TypeName
toArgsTypeName = Bool -> TypeName -> FieldName -> TypeName
mkArgsTypeName Bool
namespace (TypeDefinition ANY CONST -> TypeName
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 = TypeDefinition ANY CONST -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition ANY CONST
typeDef,
            currentKind :: Maybe TypeKind
currentKind = TypeKind -> Maybe TypeKind
forall a. a -> Maybe a
Just (TypeDefinition ANY CONST -> TypeKind
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 :: TypeName -> m a -> m a
inType TypeName
currentTypeName = (TypeContext s -> TypeContext s) -> m a -> m a
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 = Maybe TypeKind
forall a. Maybe a
Nothing})

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

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

genTypeDefinition ::
  CodeGenMonad m =>
  TypeDefinition ANY CONST ->
  ServerQ m [ServerTypeDefinition]
genTypeDefinition :: 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 Description
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Description
typeDescription :: Maybe Description
typeDescription
    } = BuildPlan -> [ServerTypeDefinition]
withType (BuildPlan -> [ServerTypeDefinition])
-> ReaderT (TypeContext CONST) m BuildPlan
-> ServerQ m [ServerTypeDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeName
-> TypeContent TRUE ANY CONST
-> ReaderT (TypeContext CONST) m BuildPlan
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 = TypeDefinition ANY CONST -> TypeKind
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeKind
kindOf TypeDefinition ANY CONST
typeDef
      tName :: Description
tName = TypeName -> Description
toHaskellTypeName TypeName
typeName
      gql :: Maybe GQLTypeDefinition
gql =
        GQLTypeDefinition -> Maybe GQLTypeDefinition
forall a. a -> Maybe a
Just
          GQLTypeDefinition :: Kind
-> Maybe Description
-> Map Description Description
-> Map Description (Directives CONST)
-> Map Description (Value CONST)
-> GQLTypeDefinition
GQLTypeDefinition
            { gqlTypeDescription :: Maybe Description
gqlTypeDescription = Maybe Description
typeDescription,
              gqlTypeDescriptions :: Map Description Description
gqlTypeDescriptions = TypeDefinition ANY CONST -> Map Description Description
forall (c :: TypeCategory) (s :: Stage).
TypeDefinition c s -> Map Description Description
getDesc TypeDefinition ANY CONST
typeDef,
              gqlTypeDirectives :: Map Description (Directives CONST)
gqlTypeDirectives = TypeDefinition ANY CONST -> Map Description (Directives CONST)
forall (c :: TypeCategory) (s :: Stage).
TypeDefinition c s -> Map Description (Directives s)
getDirs TypeDefinition ANY CONST
typeDef,
              gqlKind :: Kind
gqlKind = TypeKind -> Kind
derivingKind TypeKind
tKind,
              gqlTypeDefaultValues :: Map Description (Value CONST)
gqlTypeDefaultValues =
                [Item (Map Description (Value CONST))]
-> Map Description (Value CONST)
forall l. IsList l => [Item l] -> l
fromList
                  ([Item (Map Description (Value CONST))]
 -> Map Description (Value CONST))
-> [Item (Map Description (Value CONST))]
-> Map Description (Value CONST)
forall a b. (a -> b) -> a -> b
$ (FieldDefinition IN CONST -> Maybe (Description, Value CONST))
-> [FieldDefinition IN CONST] -> [(Description, Value CONST)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FieldDefinition IN CONST -> Maybe (Description, Value CONST)
forall (c :: TypeCategory) (s :: Stage).
FieldDefinition c s -> Maybe (Description, Value s)
getDefaultValue
                  ([FieldDefinition IN CONST] -> [(Description, Value CONST)])
-> [FieldDefinition IN CONST] -> [(Description, Value CONST)]
forall a b. (a -> b) -> a -> b
$ TypeDefinition ANY CONST -> [FieldDefinition IN CONST]
forall (c :: TypeCategory) (s :: Stage).
TypeDefinition c s -> [FieldDefinition IN s]
getInputFields TypeDefinition ANY CONST
typeDef
            }
      typeParameters :: [Description]
typeParameters
        | TypeKind -> Bool
forall t. Strictness t => t -> Bool
isResolverType TypeKind
tKind = [Description
"m"]
        | Bool
otherwise = []
      derives :: [DerivingClass]
derives = Bool -> [DerivingClass]
derivesClasses (TypeKind -> Bool
forall t. Strictness t => t -> Bool
isResolverType TypeKind
tKind)
      -------------------------
      withType :: BuildPlan -> [ServerTypeDefinition]
withType (ConsIN [ServerConstructorDefinition]
tCons) = [ServerTypeDefinition :: Description
-> [Description]
-> [ServerConstructorDefinition]
-> TypeKind
-> [DerivingClass]
-> Maybe GQLTypeDefinition
-> ServerTypeDefinition
ServerTypeDefinition {[Description]
[ServerConstructorDefinition]
[DerivingClass]
Maybe GQLTypeDefinition
Description
TypeKind
gql :: Maybe GQLTypeDefinition
derives :: [DerivingClass]
tKind :: TypeKind
tCons :: [ServerConstructorDefinition]
typeParameters :: [Description]
tName :: Description
tCons :: [ServerConstructorDefinition]
derives :: [DerivingClass]
typeParameters :: [Description]
gql :: Maybe GQLTypeDefinition
tName :: Description
tKind :: TypeKind
..}]
      withType (ConsOUT [ServerTypeDefinition]
others [ServerConstructorDefinition]
tCons) = ServerTypeDefinition :: Description
-> [Description]
-> [ServerConstructorDefinition]
-> TypeKind
-> [DerivingClass]
-> Maybe GQLTypeDefinition
-> ServerTypeDefinition
ServerTypeDefinition {[Description]
[ServerConstructorDefinition]
[DerivingClass]
Maybe GQLTypeDefinition
Description
TypeKind
tCons :: [ServerConstructorDefinition]
gql :: Maybe GQLTypeDefinition
derives :: [DerivingClass]
tKind :: TypeKind
tCons :: [ServerConstructorDefinition]
typeParameters :: [Description]
tName :: Description
derives :: [DerivingClass]
typeParameters :: [Description]
gql :: Maybe GQLTypeDefinition
tName :: Description
tKind :: TypeKind
..} ServerTypeDefinition
-> [ServerTypeDefinition] -> [ServerTypeDefinition]
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 DerivingClass -> [DerivingClass] -> [DerivingClass]
forall a. a -> [a] -> [a]
: [DerivingClass
SHOW | Bool -> Bool
not Bool
isResolver]

mkObjectCons :: TypeName -> [ServerFieldDefinition] -> [ServerConstructorDefinition]
mkObjectCons :: TypeName
-> [ServerFieldDefinition] -> [ServerConstructorDefinition]
mkObjectCons TypeName
name = ServerConstructorDefinition -> [ServerConstructorDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerConstructorDefinition -> [ServerConstructorDefinition])
-> ([ServerFieldDefinition] -> ServerConstructorDefinition)
-> [ServerFieldDefinition]
-> [ServerConstructorDefinition]
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 TypeName -> TypeName -> TypeName
forall a. Semigroup a => a -> a -> a
<> TypeName
argTName
  | Bool
otherwise = TypeName
argTName
  where
    argTName :: TypeName
argTName = [FieldName] -> TypeName -> TypeName
forall (t :: NAME). [Name t] -> TypeName -> TypeName
camelCaseTypeName [FieldName
fieldName] TypeName
"Args"

isParametrizedResolverType :: CodeGenMonad m => TypeName -> [TypeDefinition ANY s] -> m Bool
isParametrizedResolverType :: TypeName -> [TypeDefinition ANY s] -> m Bool
isParametrizedResolverType TypeName
"__TypeKind" [TypeDefinition ANY s]
_ = Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isParametrizedResolverType TypeName
"Boolean" [TypeDefinition ANY s]
_ = Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isParametrizedResolverType TypeName
"String" [TypeDefinition ANY s]
_ = Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isParametrizedResolverType TypeName
"Int" [TypeDefinition ANY s]
_ = Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isParametrizedResolverType TypeName
"Float" [TypeDefinition ANY s]
_ = Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isParametrizedResolverType TypeName
name [TypeDefinition ANY s]
lib = case (TypeDefinition ANY s -> TypeName)
-> TypeName
-> [TypeDefinition ANY s]
-> Maybe (TypeDefinition ANY s)
forall k a. Eq k => (a -> k) -> k -> [a] -> Maybe a
lookupWith TypeDefinition ANY s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeName
name [TypeDefinition ANY s]
lib of
  Just TypeDefinition ANY s
x -> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeDefinition ANY s -> Bool
forall t. Strictness t => t -> Bool
isResolverType TypeDefinition ANY s
x)
  Maybe (TypeDefinition ANY s)
Nothing -> TypeName -> m Bool
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 :: 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 <- m Bool -> ReaderT (TypeContext CONST) m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ReaderT (TypeContext CONST) m Bool)
-> ([TypeDefinition ANY CONST] -> m Bool)
-> [TypeDefinition ANY CONST]
-> ReaderT (TypeContext CONST) m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> [TypeDefinition ANY CONST] -> m Bool
forall (m :: * -> *) (s :: Stage).
CodeGenMonad m =>
TypeName -> [TypeDefinition ANY s] -> m Bool
isParametrizedResolverType TypeName
typeConName ([TypeDefinition ANY CONST] -> ReaderT (TypeContext CONST) m Bool)
-> ReaderT (TypeContext CONST) m [TypeDefinition ANY CONST]
-> ReaderT (TypeContext CONST) m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (TypeContext CONST -> [TypeDefinition ANY CONST])
-> ReaderT (TypeContext CONST) m [TypeDefinition ANY CONST]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TypeContext CONST -> [TypeDefinition ANY CONST]
forall (s :: Stage). TypeContext s -> [TypeDefinition ANY s]
schema
    FieldName -> TypeName
genName <- (TypeContext CONST -> FieldName -> TypeName)
-> ReaderT (TypeContext CONST) m (FieldName -> TypeName)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TypeContext CONST -> FieldName -> TypeName
forall (s :: Stage). TypeContext s -> FieldName -> TypeName
toArgsTypeName
    Maybe TypeKind
kind <- (TypeContext CONST -> Maybe TypeKind)
-> ReaderT (TypeContext CONST) m (Maybe TypeKind)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TypeContext CONST -> Maybe TypeKind
forall (s :: Stage). TypeContext s -> Maybe TypeKind
currentKind
    FieldName
fieldName <- FieldName -> ServerQ m FieldName
forall (m :: * -> *). Monad m => FieldName -> ServerQ m FieldName
genFieldName FieldName
fName
    ServerFieldDefinition -> ServerQ m ServerFieldDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ServerFieldDefinition :: Description
-> FieldName -> [FIELD_TYPE_WRAPPER] -> ServerFieldDefinition
ServerFieldDefinition
        { fieldType :: Description
fieldType = TypeName -> Description
toHaskellTypeName TypeName
typeConName,
          wrappers :: [FIELD_TYPE_WRAPPER]
wrappers =
            FieldName
-> (FieldName -> TypeName)
-> [ArgumentDefinition CONST]
-> [FIELD_TYPE_WRAPPER]
forall (s :: Stage).
FieldName
-> (FieldName -> TypeName)
-> [ArgumentDefinition s]
-> [FIELD_TYPE_WRAPPER]
mkFieldArguments FieldName
fName FieldName -> TypeName
genName (Maybe (FieldContent TRUE OUT CONST) -> [ArgumentDefinition CONST]
forall (bool :: Bool) (cat :: TypeCategory) (s :: Stage).
Maybe (FieldContent bool cat s) -> [ArgumentDefinition s]
toArgList Maybe (FieldContent TRUE OUT CONST)
fieldContent)
              [FIELD_TYPE_WRAPPER]
-> [FIELD_TYPE_WRAPPER] -> [FIELD_TYPE_WRAPPER]
forall a. Semigroup a => a -> a -> a
<> [FIELD_TYPE_WRAPPER
SUBSCRIPTION | (TypeKind -> Bool) -> Maybe TypeKind -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeKind -> Bool
isSubscription Maybe TypeKind
kind Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True]
              [FIELD_TYPE_WRAPPER]
-> [FIELD_TYPE_WRAPPER] -> [FIELD_TYPE_WRAPPER]
forall a. Semigroup a => a -> a -> a
<> [FIELD_TYPE_WRAPPER
MONAD]
              [FIELD_TYPE_WRAPPER]
-> [FIELD_TYPE_WRAPPER] -> [FIELD_TYPE_WRAPPER]
forall a. Semigroup a => a -> a -> a
<> [TypeWrapper -> FIELD_TYPE_WRAPPER
GQL_WRAPPER TypeWrapper
typeWrappers]
              [FIELD_TYPE_WRAPPER]
-> [FIELD_TYPE_WRAPPER] -> [FIELD_TYPE_WRAPPER]
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 :: 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 :: Maybe (FieldContent bool cat s) -> [ArgumentDefinition s]
toArgList (Just (FieldArgs ArgumentsDefinition s
args)) = ArgumentsDefinition s -> [ArgumentDefinition s]
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 :: TypeName -> ServerQ m [ServerTypeDefinition]
genInterfaceUnion TypeName
interfaceName =
  [TypeName] -> [ServerTypeDefinition]
mkInterface ([TypeName] -> [ServerTypeDefinition])
-> ([TypeDefinition ANY CONST] -> [TypeName])
-> [TypeDefinition ANY CONST]
-> [ServerTypeDefinition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeDefinition ANY CONST -> TypeName)
-> [TypeDefinition ANY CONST] -> [TypeName]
forall a b. (a -> b) -> [a] -> [b]
map TypeDefinition ANY CONST -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName ([TypeDefinition ANY CONST] -> [TypeName])
-> ([TypeDefinition ANY CONST] -> [TypeDefinition ANY CONST])
-> [TypeDefinition ANY CONST]
-> [TypeName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeDefinition ANY CONST -> Maybe (TypeDefinition ANY CONST))
-> [TypeDefinition ANY CONST] -> [TypeDefinition ANY CONST]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TypeName
-> TypeDefinition ANY CONST -> Maybe (TypeDefinition ANY CONST)
forall (c :: TypeCategory) (s :: Stage).
TypeName -> TypeDefinition c s -> Maybe (TypeDefinition c s)
isPossibleInterfaceType TypeName
interfaceName)
    ([TypeDefinition ANY CONST] -> [ServerTypeDefinition])
-> ReaderT (TypeContext CONST) m [TypeDefinition ANY CONST]
-> ServerQ m [ServerTypeDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeContext CONST -> [TypeDefinition ANY CONST])
-> ReaderT (TypeContext CONST) m [TypeDefinition ANY CONST]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TypeContext CONST -> [TypeDefinition ANY CONST]
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 :: Description
-> [Description]
-> [ServerConstructorDefinition]
-> TypeKind
-> [DerivingClass]
-> Maybe GQLTypeDefinition
-> ServerTypeDefinition
ServerTypeDefinition
          { tName :: Description
tName = TypeName -> Description
toHaskellTypeName TypeName
tName,
            tCons :: [ServerConstructorDefinition]
tCons = (TypeName -> ServerConstructorDefinition)
-> [TypeName] -> [ServerConstructorDefinition]
forall a b. (a -> b) -> [a] -> [b]
map (TypeName -> TypeName -> ServerConstructorDefinition
mkUnionFieldDefinition TypeName
tName) [TypeName]
members,
            TypeKind
tKind :: TypeKind
tKind :: TypeKind
tKind,
            typeParameters :: [Description]
typeParameters = [Description
"m"],
            derives :: [DerivingClass]
derives = Bool -> [DerivingClass]
derivesClasses Bool
True,
            gql :: Maybe GQLTypeDefinition
gql = Maybe GQLTypeDefinition
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 :: 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} <- ReaderT (TypeContext CONST) m (TypeContext CONST)
forall r (m :: * -> *). MonadReader r m => m r
ask
  FieldName -> ServerQ m FieldName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldName -> ServerQ m FieldName)
-> FieldName -> ServerQ m FieldName
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 :: TypeName
-> DataEnumValue CONST -> ServerQ m ServerConstructorDefinition
mkConsEnum TypeName
name DataEnumValue {TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName :: TypeName
enumName} = do
  Bool
namespace <- (TypeContext CONST -> Bool) -> ReaderT (TypeContext CONST) m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TypeContext CONST -> Bool
forall (s :: Stage). TypeContext s -> Bool
hasNamespace
  ServerConstructorDefinition
-> ServerQ m ServerConstructorDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ServerConstructorDefinition :: TypeName -> [ServerFieldDefinition] -> ServerConstructorDefinition
ServerConstructorDefinition
      { constructorName :: TypeName
constructorName =
          if Bool
namespace
            then [TypeName] -> TypeName -> TypeName
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 :: 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 <- FieldName -> ServerQ m FieldName
forall (m :: * -> *). Monad m => FieldName -> ServerQ m FieldName
genFieldName FieldName
fName
    ServerFieldDefinition -> ServerQ m ServerFieldDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerFieldDefinition -> ServerQ m ServerFieldDefinition)
-> ServerFieldDefinition -> ServerQ m ServerFieldDefinition
forall a b. (a -> b) -> a -> b
$
      ServerFieldDefinition :: Description
-> FieldName -> [FIELD_TYPE_WRAPPER] -> ServerFieldDefinition
ServerFieldDefinition
        { fieldType :: Description
fieldType = TypeName -> Description
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 :: TypeName -> TypeContent TRUE ANY CONST -> ServerQ m BuildPlan
genTypeContent TypeName
_ DataScalar {} = BuildPlan -> ServerQ m BuildPlan
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ServerConstructorDefinition] -> BuildPlan
ConsIN [])
genTypeContent TypeName
typeName (DataEnum DataEnum CONST
tags) = [ServerConstructorDefinition] -> BuildPlan
ConsIN ([ServerConstructorDefinition] -> BuildPlan)
-> ReaderT (TypeContext CONST) m [ServerConstructorDefinition]
-> ServerQ m BuildPlan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DataEnumValue CONST
 -> ReaderT (TypeContext CONST) m ServerConstructorDefinition)
-> DataEnum CONST
-> ReaderT (TypeContext CONST) m [ServerConstructorDefinition]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (TypeName
-> DataEnumValue CONST
-> ReaderT (TypeContext CONST) m ServerConstructorDefinition
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 ([ServerConstructorDefinition] -> BuildPlan)
-> ([ServerFieldDefinition] -> [ServerConstructorDefinition])
-> [ServerFieldDefinition]
-> BuildPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName
-> [ServerFieldDefinition] -> [ServerConstructorDefinition]
mkObjectCons TypeName
typeName ([ServerFieldDefinition] -> BuildPlan)
-> ReaderT (TypeContext CONST) m [ServerFieldDefinition]
-> ServerQ m BuildPlan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldDefinition IN CONST
 -> ReaderT (TypeContext CONST) m ServerFieldDefinition)
-> [FieldDefinition IN CONST]
-> ReaderT (TypeContext CONST) m [ServerFieldDefinition]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldDefinition IN CONST
-> ReaderT (TypeContext CONST) m ServerFieldDefinition
forall (m :: * -> *) (c :: TypeCategory).
Monad m =>
FieldDefinition c CONST -> ServerQ m ServerFieldDefinition
toNonResolverServerField (FieldsDefinition IN CONST -> [FieldDefinition IN CONST]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FieldsDefinition IN CONST
fields)
genTypeContent TypeName
_ DataInputUnion {} = String -> ServerQ m BuildPlan
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Input Unions not Supported"
genTypeContent TypeName
typeName DataInterface {FieldsDefinition OUT CONST
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT CONST
interfaceFields} =
  [ServerTypeDefinition]
-> [ServerConstructorDefinition] -> BuildPlan
ConsOUT
    ([ServerTypeDefinition]
 -> [ServerConstructorDefinition] -> BuildPlan)
-> ReaderT (TypeContext CONST) m [ServerTypeDefinition]
-> ReaderT
     (TypeContext CONST) m ([ServerConstructorDefinition] -> BuildPlan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([ServerTypeDefinition]
-> [ServerTypeDefinition] -> [ServerTypeDefinition]
forall a. Semigroup a => a -> a -> a
(<>) ([ServerTypeDefinition]
 -> [ServerTypeDefinition] -> [ServerTypeDefinition])
-> ReaderT (TypeContext CONST) m [ServerTypeDefinition]
-> ReaderT
     (TypeContext CONST)
     m
     ([ServerTypeDefinition] -> [ServerTypeDefinition])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldsDefinition OUT CONST
-> ReaderT (TypeContext CONST) m [ServerTypeDefinition]
forall (m :: * -> *).
Monad m =>
FieldsDefinition OUT CONST -> ServerQ m [ServerTypeDefinition]
genArgumentTypes FieldsDefinition OUT CONST
interfaceFields ReaderT
  (TypeContext CONST)
  m
  ([ServerTypeDefinition] -> [ServerTypeDefinition])
-> ReaderT (TypeContext CONST) m [ServerTypeDefinition]
-> ReaderT (TypeContext CONST) m [ServerTypeDefinition]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeName -> ReaderT (TypeContext CONST) m [ServerTypeDefinition]
forall (m :: * -> *).
Monad m =>
TypeName -> ServerQ m [ServerTypeDefinition]
genInterfaceUnion TypeName
typeName)
    ReaderT
  (TypeContext CONST) m ([ServerConstructorDefinition] -> BuildPlan)
-> ReaderT (TypeContext CONST) m [ServerConstructorDefinition]
-> ServerQ m BuildPlan
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( do
            let interfaceName :: TypeName
interfaceName = TypeName -> TypeName
mkInterfaceName TypeName
typeName
            TypeName
-> ReaderT (TypeContext CONST) m [ServerConstructorDefinition]
-> ReaderT (TypeContext CONST) m [ServerConstructorDefinition]
forall (s :: Stage) (m :: * -> *) a.
MonadReader (TypeContext s) m =>
TypeName -> m a -> m a
inType
              TypeName
interfaceName
              ( TypeName
-> [ServerFieldDefinition] -> [ServerConstructorDefinition]
mkObjectCons TypeName
interfaceName
                  ([ServerFieldDefinition] -> [ServerConstructorDefinition])
-> ReaderT (TypeContext CONST) m [ServerFieldDefinition]
-> ReaderT (TypeContext CONST) m [ServerConstructorDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldDefinition OUT CONST
 -> ReaderT (TypeContext CONST) m ServerFieldDefinition)
-> [FieldDefinition OUT CONST]
-> ReaderT (TypeContext CONST) m [ServerFieldDefinition]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldDefinition OUT CONST
-> ReaderT (TypeContext CONST) m ServerFieldDefinition
forall (m :: * -> *).
CodeGenMonad m =>
FieldDefinition OUT CONST -> ServerQ m ServerFieldDefinition
mkObjectField (FieldsDefinition OUT CONST -> [FieldDefinition OUT CONST]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FieldsDefinition OUT CONST
interfaceFields)
              )
        )
genTypeContent TypeName
typeName DataObject {FieldsDefinition OUT CONST
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT CONST
objectFields} =
  [ServerTypeDefinition]
-> [ServerConstructorDefinition] -> BuildPlan
ConsOUT ([ServerTypeDefinition]
 -> [ServerConstructorDefinition] -> BuildPlan)
-> ReaderT (TypeContext CONST) m [ServerTypeDefinition]
-> ReaderT
     (TypeContext CONST) m ([ServerConstructorDefinition] -> BuildPlan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldsDefinition OUT CONST
-> ReaderT (TypeContext CONST) m [ServerTypeDefinition]
forall (m :: * -> *).
Monad m =>
FieldsDefinition OUT CONST -> ServerQ m [ServerTypeDefinition]
genArgumentTypes FieldsDefinition OUT CONST
objectFields
    ReaderT
  (TypeContext CONST) m ([ServerConstructorDefinition] -> BuildPlan)
-> ReaderT (TypeContext CONST) m [ServerConstructorDefinition]
-> ServerQ m BuildPlan
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( TypeName
-> [ServerFieldDefinition] -> [ServerConstructorDefinition]
mkObjectCons TypeName
typeName
            ([ServerFieldDefinition] -> [ServerConstructorDefinition])
-> ReaderT (TypeContext CONST) m [ServerFieldDefinition]
-> ReaderT (TypeContext CONST) m [ServerConstructorDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldDefinition OUT CONST
 -> ReaderT (TypeContext CONST) m ServerFieldDefinition)
-> [FieldDefinition OUT CONST]
-> ReaderT (TypeContext CONST) m [ServerFieldDefinition]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldDefinition OUT CONST
-> ReaderT (TypeContext CONST) m ServerFieldDefinition
forall (m :: * -> *).
CodeGenMonad m =>
FieldDefinition OUT CONST -> ServerQ m ServerFieldDefinition
mkObjectField (FieldsDefinition OUT CONST -> [FieldDefinition OUT CONST]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FieldsDefinition OUT CONST
objectFields)
        )
genTypeContent TypeName
typeName (DataUnion UnionTypeDefinition OUT CONST
members) =
  BuildPlan -> ServerQ m BuildPlan
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BuildPlan -> ServerQ m BuildPlan)
-> BuildPlan -> ServerQ m BuildPlan
forall a b. (a -> b) -> a -> b
$ [ServerTypeDefinition]
-> [ServerConstructorDefinition] -> BuildPlan
ConsOUT [] (UnionMember OUT CONST -> ServerConstructorDefinition
unionCon (UnionMember OUT CONST -> ServerConstructorDefinition)
-> [UnionMember OUT CONST] -> [ServerConstructorDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnionTypeDefinition OUT CONST -> [UnionMember OUT CONST]
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 -> [ServerFieldDefinition] -> ServerConstructorDefinition
ServerConstructorDefinition
    { TypeName
constructorName :: TypeName
constructorName :: TypeName
constructorName,
      constructorFields :: [ServerFieldDefinition]
constructorFields =
        [ ServerFieldDefinition :: Description
-> FieldName -> [FIELD_TYPE_WRAPPER] -> ServerFieldDefinition
ServerFieldDefinition
            { fieldName :: FieldName
fieldName = TypeName -> FieldName
coerce (TypeName
"un" TypeName -> TypeName -> TypeName
forall a. Semigroup a => a -> a -> a
<> TypeName
constructorName),
              fieldType :: Description
fieldType = TypeName -> Description
toHaskellTypeName TypeName
memberName,
              wrappers :: [FIELD_TYPE_WRAPPER]
wrappers = [FIELD_TYPE_WRAPPER
PARAMETRIZED]
            }
        ]
    }
  where
    constructorName :: TypeName
constructorName = [TypeName] -> TypeName -> TypeName
forall (t :: NAME). [Name t] -> TypeName -> TypeName
camelCaseTypeName [TypeName
typeName] TypeName
memberName

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

genArgumentType :: Monad m => FieldDefinition OUT CONST -> ServerQ m [ServerTypeDefinition]
genArgumentType :: 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)
    }
    | ArgumentsDefinition CONST -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ArgumentsDefinition CONST
arguments Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = do
      TypeName
tName <- (FieldName
fieldName FieldName -> (FieldName -> TypeName) -> TypeName
forall a b. a -> (a -> b) -> b
&) ((FieldName -> TypeName) -> TypeName)
-> ReaderT (TypeContext CONST) m (FieldName -> TypeName)
-> ReaderT (TypeContext CONST) m TypeName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeContext CONST -> FieldName -> TypeName)
-> ReaderT (TypeContext CONST) m (FieldName -> TypeName)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TypeContext CONST -> FieldName -> TypeName
forall (s :: Stage). TypeContext s -> FieldName -> TypeName
toArgsTypeName
      TypeName
-> ServerQ m [ServerTypeDefinition]
-> ServerQ m [ServerTypeDefinition]
forall (s :: Stage) (m :: * -> *) a.
MonadReader (TypeContext s) m =>
TypeName -> m a -> m a
inType TypeName
tName (ServerQ m [ServerTypeDefinition]
 -> ServerQ m [ServerTypeDefinition])
-> ServerQ m [ServerTypeDefinition]
-> ServerQ m [ServerTypeDefinition]
forall a b. (a -> b) -> a -> b
$ do
        let argumentFields :: [FieldDefinition IN CONST]
argumentFields = ArgumentDefinition CONST -> FieldDefinition IN CONST
forall (s :: Stage). ArgumentDefinition s -> FieldDefinition IN s
argument (ArgumentDefinition CONST -> FieldDefinition IN CONST)
-> [ArgumentDefinition CONST] -> [FieldDefinition IN CONST]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArgumentsDefinition CONST -> [ArgumentDefinition CONST]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ArgumentsDefinition CONST
arguments
        [ServerFieldDefinition]
fields <- (FieldDefinition IN CONST
 -> ReaderT (TypeContext CONST) m ServerFieldDefinition)
-> [FieldDefinition IN CONST]
-> ReaderT (TypeContext CONST) m [ServerFieldDefinition]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldDefinition IN CONST
-> ReaderT (TypeContext CONST) m ServerFieldDefinition
forall (m :: * -> *) (c :: TypeCategory).
Monad m =>
FieldDefinition c CONST -> ServerQ m ServerFieldDefinition
toNonResolverServerField [FieldDefinition IN CONST]
argumentFields
        let tKind :: TypeKind
tKind = TypeKind
KindInputObject
        [ServerTypeDefinition] -> ServerQ m [ServerTypeDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          [ ServerTypeDefinition :: Description
-> [Description]
-> [ServerConstructorDefinition]
-> TypeKind
-> [DerivingClass]
-> Maybe GQLTypeDefinition
-> ServerTypeDefinition
ServerTypeDefinition
              { tName :: Description
tName = TypeName -> Description
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 :: [Description]
typeParameters = [],
                gql :: Maybe GQLTypeDefinition
gql =
                  GQLTypeDefinition -> Maybe GQLTypeDefinition
forall a. a -> Maybe a
Just
                    ( GQLTypeDefinition :: Kind
-> Maybe Description
-> Map Description Description
-> Map Description (Directives CONST)
-> Map Description (Value CONST)
-> GQLTypeDefinition
GQLTypeDefinition
                        { gqlKind :: Kind
gqlKind = Kind
Type,
                          gqlTypeDescription :: Maybe Description
gqlTypeDescription = Maybe Description
forall a. Maybe a
Nothing,
                          gqlTypeDescriptions :: Map Description Description
gqlTypeDescriptions = [Item (Map Description Description)] -> Map Description Description
forall l. IsList l => [Item l] -> l
fromList ((FieldDefinition IN CONST -> Maybe (Description, Description))
-> [FieldDefinition IN CONST] -> [(Description, Description)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FieldDefinition IN CONST -> Maybe (Description, Description)
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (Description, Description)
mkFieldDescription [FieldDefinition IN CONST]
argumentFields),
                          gqlTypeDirectives :: Map Description (Directives CONST)
gqlTypeDirectives = [Item (Map Description (Directives CONST))]
-> Map Description (Directives CONST)
forall l. IsList l => [Item l] -> l
fromList (FieldDefinition IN CONST -> (Description, Directives CONST)
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> (Description, Directives s)
mkFieldDirective (FieldDefinition IN CONST -> (Description, Directives CONST))
-> [FieldDefinition IN CONST] -> [(Description, Directives CONST)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldDefinition IN CONST]
argumentFields),
                          gqlTypeDefaultValues :: Map Description (Value CONST)
gqlTypeDefaultValues = [Item (Map Description (Value CONST))]
-> Map Description (Value CONST)
forall l. IsList l => [Item l] -> l
fromList ((FieldDefinition IN CONST -> Maybe (Description, Value CONST))
-> [FieldDefinition IN CONST] -> [(Description, Value CONST)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FieldDefinition IN CONST -> Maybe (Description, Value CONST)
forall (c :: TypeCategory) (s :: Stage).
FieldDefinition c s -> Maybe (Description, Value s)
getDefaultValue [FieldDefinition IN CONST]
argumentFields)
                        }
                    )
              }
          ]
genArgumentType FieldDefinition OUT CONST
_ = [ServerTypeDefinition] -> ServerQ m [ServerTypeDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

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

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

---

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

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

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

instance (Meta a v) => Meta (Maybe a) v where
  get :: Maybe a -> [(Description, v)]
get (Just a
x) = a -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, 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 -> [(Description, 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} = TypeContent TRUE c s -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, 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 -> [(Description, v)]
get DataObject {FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields} = FieldsDefinition OUT s -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, v)]
get FieldsDefinition OUT s
objectFields
  get DataInputObject {FieldsDefinition IN s
inputObjectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields} = FieldsDefinition IN s -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, v)]
get FieldsDefinition IN s
inputObjectFields
  get DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
interfaceFields} = FieldsDefinition OUT s -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, v)]
get FieldsDefinition OUT s
interfaceFields
  get DataEnum {DataEnum s
enumMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF a s -> DataEnum s
enumMembers :: DataEnum s
enumMembers} = (DataEnumValue s -> [(Description, v)])
-> DataEnum s -> [(Description, v)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DataEnumValue s -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, v)]
get DataEnum s
enumMembers
  get TypeContent a c s
_ = []

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

instance Meta (DataEnumValue s) (Directives s) where
  get :: DataEnumValue s -> [(Description, 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}
    | Directives s -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Directives s
enumDirectives = []
    | Bool
otherwise = [(TypeName -> Description
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 -> [(Description, v)]
get = (FieldDefinition c s -> [(Description, v)])
-> [FieldDefinition c s] -> [(Description, v)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FieldDefinition c s -> [(Description, v)]
forall a v. Meta a v => a -> [(Description, v)]
get ([FieldDefinition c s] -> [(Description, v)])
-> (FieldsDefinition c s -> [FieldDefinition c s])
-> FieldsDefinition c s
-> [(Description, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldsDefinition c s -> [FieldDefinition c s]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance Meta (FieldDefinition c s) Description where
  get :: FieldDefinition c s -> [(Description, Description)]
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 Description
fieldDescription = Just Description
x} = [(FieldName -> Description
forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
fieldName, Description
x)]
  get FieldDefinition c s
_ = []

instance Meta (FieldDefinition c s) (Directives s) where
  get :: FieldDefinition c s -> [(Description, 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}
    | Directives s -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Directives s
fieldDirectives = []
    | Bool
otherwise = [(FieldName -> Description
forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
fieldName, Directives s
fieldDirectives)]

getInputFields :: TypeDefinition c s -> [FieldDefinition IN s]
getInputFields :: 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 (a :: TypeCategory) (s :: Stage).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
inputObjectFields}} = FieldsDefinition IN s -> [FieldDefinition IN s]
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 :: FieldDefinition c s -> Maybe (Description, 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 (cat :: TypeCategory) (s :: Stage).
FieldContent (IN <=? cat) cat s -> Value s
defaultInputValue :: Value s
defaultInputValue}
    } = (Description, Value s) -> Maybe (Description, Value s)
forall a. a -> Maybe a
Just (FieldName -> Description
forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
fieldName, Value s
defaultInputValue)
getDefaultValue FieldDefinition c s
_ = Maybe (Description, Value s)
forall a. Maybe a
Nothing