morpheus-graphql-code-gen 0.27.3 → 0.28.0
raw patch · 4 files changed
+86/−77 lines, 4 filesdep ~bytestringdep ~containersdep ~filepathPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: bytestring, containers, filepath, morpheus-graphql-client, morpheus-graphql-code-gen, morpheus-graphql-code-gen-utils, morpheus-graphql-core, morpheus-graphql-server, optparse-applicative
API changes (from Hackage documentation)
Files
- morpheus-graphql-code-gen.cabal +16/−16
- src/Data/Morpheus/CodeGen/Server/Internal/AST.hs +7/−2
- src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs +45/−43
- src/Data/Morpheus/CodeGen/Server/Interpreting/Utils.hs +18/−16
morpheus-graphql-code-gen.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.0.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: morpheus-graphql-code-gen-version: 0.27.3+version: 0.28.0 synopsis: Morpheus GraphQL CLI description: code generator for Morpheus GraphQL category: web, graphql, cli@@ -41,12 +41,12 @@ ghc-options: -Wall build-depends: base >=4.7.0 && <5.0.0- , bytestring >=0.10.4 && <0.12.0- , containers >=0.4.2.1 && <0.7.0+ , bytestring >=0.10.4 && <0.15.0+ , containers >=0.4.2.1 && <=0.7 , file-embed >=0.0.10 && <1.0.0- , morpheus-graphql-code-gen-utils >=0.27.0 && <0.28.0- , morpheus-graphql-core >=0.27.0 && <0.28.0- , morpheus-graphql-server >=0.27.0 && <0.28.0+ , morpheus-graphql-code-gen-utils >=0.28.0 && <0.29.0+ , morpheus-graphql-core >=0.28.0 && <0.29.0+ , morpheus-graphql-server >=0.28.0 && <0.29.0 , prettyprinter >=1.7.0 && <2.0.0 , relude >=0.3.0 && <2.0.0 , template-haskell >=2.0.0 && <3.0.0@@ -68,16 +68,16 @@ build-depends: Glob >=0.7.0 && <1.0.0 , base >=4.7.0 && <5.0.0- , bytestring >=0.10.4 && <0.12.0- , containers >=0.4.2.1 && <0.7.0+ , bytestring >=0.10.4 && <0.15.0+ , containers >=0.4.2.1 && <=0.7 , file-embed >=0.0.10 && <1.0.0- , filepath >=1.1.0 && <1.5.0- , morpheus-graphql-client- , morpheus-graphql-code-gen- , morpheus-graphql-code-gen-utils- , morpheus-graphql-core >=0.27.0 && <0.28.0- , morpheus-graphql-server >=0.27.0 && <0.28.0- , optparse-applicative >=0.12.0 && <0.18.0+ , filepath >=1.1.0 && <=1.5.2.0+ , morpheus-graphql-client >=0.28.0 && <0.29.0+ , morpheus-graphql-code-gen >=0.28.0 && <0.29.0+ , morpheus-graphql-code-gen-utils >=0.28.0 && <0.29.0+ , morpheus-graphql-core >=0.28.0 && <0.29.0+ , morpheus-graphql-server >=0.28.0 && <0.29.0+ , optparse-applicative >=0.12.0 && <0.20.0 , prettyprinter >=1.7.0 && <2.0.0 , relude >=0.3.0 && <2.0.0 , template-haskell >=2.0.0 && <3.0.0
src/Data/Morpheus/CodeGen/Server/Internal/AST.hs view
@@ -39,7 +39,7 @@ (.<>), ) import Data.Morpheus.CodeGen.TH (PrintDec (..), PrintExp (..), ToName (..), apply, m', m_, printTypeSynonym)-import Data.Morpheus.Server.Types (SCALAR, TYPE, TypeGuard, enumDirective, fieldDirective, typeDirective)+import Data.Morpheus.Server.Types (DIRECTIVE, SCALAR, TYPE, TypeGuard, enumDirective, fieldDirective, typeDirective) import Data.Morpheus.Types.Internal.AST ( CONST, DirectiveLocation (..),@@ -51,11 +51,13 @@ Value, unpackName, )-import Data.Text.Prettyprint.Doc (concatWith, indent, line) import Language.Haskell.TH.Lib (appE, varE) import Prettyprinter ( Pretty (..), align,+ concatWith,+ indent,+ line, pretty, (<+>), )@@ -65,15 +67,18 @@ data Kind = Scalar | Type+ | Directive deriving (Show, Eq) instance Pretty Kind where pretty Type = "TYPE" pretty Scalar = "SCALAR"+ pretty Directive = "DIRECTIVE" instance ToName Kind where toName Scalar = ''SCALAR toName Type = ''TYPE+ toName Directive = ''DIRECTIVE data ServerDirectiveUsage = TypeDirectiveUsage TypeValue
src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs view
@@ -96,7 +96,7 @@ ) import Relude hiding (ByteString, get) -parseServerTypeDefinitions :: CodeGenMonad m => CodeGenConfig -> ByteString -> m ([ServerDeclaration], Flags)+parseServerTypeDefinitions :: (CodeGenMonad m) => CodeGenConfig -> ByteString -> m ([ServerDeclaration], Flags) parseServerTypeDefinitions ctx txt = case parseDefinitions txt of Failure errors -> fail (renderGQLErrors errors)@@ -108,7 +108,7 @@ <> [FlagExternal (unpackName $ getFullName $ typeClassTarget v) | GQLTypeInstance Scalar v <- xs] toTHDefinitions ::- CodeGenMonad m =>+ (CodeGenMonad m) => Bool -> [RawTypeDefinition] -> m ([ServerDeclaration], Flags)@@ -118,7 +118,7 @@ where typeDefinitions = [td | RawTypeDefinition td <- defs] directiveDefinitions = [td | RawDirectiveDefinition td <- defs]- generateTypes :: CodeGenMonad m => RawTypeDefinition -> m ([ServerDeclaration], Flags)+ generateTypes :: (CodeGenMonad m) => RawTypeDefinition -> m ([ServerDeclaration], Flags) generateTypes (RawTypeDefinition typeDef) = runCodeGenT (genTypeDefinition typeDef)@@ -130,40 +130,13 @@ currentKind = Just (kindOf typeDef), hasNamespace = namespace }- generateTypes (RawDirectiveDefinition DirectiveDefinition {..}) =+ generateTypes (RawDirectiveDefinition dirDef) = runCodeGenT- ( do- fields <- traverse renderDataField (argument <$> toList directiveDefinitionArgs)- let typename = coerce directiveDefinitionName- namespaceDirs <- getNamespaceDirs (unpackName typename)- let cgTypeName = fromTypeName typename- pure- [ DataType- CodeGenType- { cgTypeName,- cgConstructors = [CodeGenConstructor (fromTypeName typename) fields],- cgDerivations = [SHOW, GENERIC]- },- GQLDirectiveInstance- TypeClassInstance- { typeClassName = ''GQLDirective,- typeClassContext = [],- typeClassTarget = cgTypeName,- assoc = [(''DIRECTIVE_LOCATIONS, AssociatedLocations directiveDefinitionLocations)],- typeClassMethods = []- },- gqlTypeToInstance- GQLTypeDefinition- { gqlTarget = cgTypeName,- gqlKind = Type,- gqlTypeDirectiveUses = namespaceDirs- }- ]- )+ (genDirectiveDefinition dirDef) ServerCodeGenContext { toArgsTypeName = coerce, typeDefinitions,- currentTypeName = Just (coerce directiveDefinitionName),+ currentTypeName = Just (coerce directiveDefinitionName dirDef), directiveDefinitions, currentKind = Nothing, hasNamespace = namespace@@ -176,8 +149,37 @@ mkPossibleTypesName :: TypeName -> TypeName mkPossibleTypesName = ("PossibleTypes" <>) +genDirectiveDefinition :: (CodeGenM m) => DirectiveDefinition CONST -> m [ServerDeclaration]+genDirectiveDefinition DirectiveDefinition {..} = do+ fields <- traverse (renderDataField . argument) (toList directiveDefinitionArgs)+ let typename = coerce directiveDefinitionName+ namespaceDirs <- getNamespaceDirs (unpackName typename)+ let cgTypeName = fromTypeName typename+ pure+ [ DataType+ CodeGenType+ { cgTypeName,+ cgConstructors = [CodeGenConstructor (fromTypeName typename) fields],+ cgDerivations = [SHOW, GENERIC]+ },+ GQLDirectiveInstance+ TypeClassInstance+ { typeClassName = ''GQLDirective,+ typeClassContext = [],+ typeClassTarget = cgTypeName,+ assoc = [(''DIRECTIVE_LOCATIONS, AssociatedLocations directiveDefinitionLocations)],+ typeClassMethods = []+ },+ gqlTypeToInstance+ GQLTypeDefinition+ { gqlTarget = cgTypeName,+ gqlKind = Directive,+ gqlTypeDirectiveUses = namespaceDirs+ }+ ]+ genTypeDefinition ::- CodeGenM m =>+ (CodeGenM m) => TypeDefinition ANY CONST -> m [ServerDeclaration] genTypeDefinition@@ -233,7 +235,7 @@ argTName = camelCaseTypeName [fieldName] "Args" mkObjectField ::- CodeGenM m =>+ (CodeGenM m) => FieldDefinition OUT CONST -> m CodeGenField mkObjectField@@ -261,7 +263,7 @@ .. } -mkFieldArguments :: CodeGenM m => FieldName -> (FieldName -> TypeName) -> [ArgumentDefinition s] -> m [FIELD_TYPE_WRAPPER]+mkFieldArguments :: (CodeGenM m) => FieldName -> (FieldName -> TypeName) -> [ArgumentDefinition s] -> m [FIELD_TYPE_WRAPPER] mkFieldArguments _ _ [] = pure [] mkFieldArguments _@@ -295,7 +297,7 @@ ] } -genInterfaceUnion :: CodeGenM m => TypeName -> m [ServerDeclaration]+genInterfaceUnion :: (CodeGenM m) => TypeName -> m [ServerDeclaration] genInterfaceUnion interfaceName = asks typeDefinitions >>= mkInterface . map typeName . mapMaybe (isPossibleInterfaceType interfaceName) where@@ -323,12 +325,12 @@ mkGuardWithPossibleType = InterfaceType . InterfaceDefinition interfaceName (mkInterfaceName interfaceName) tName = mkPossibleTypesName interfaceName -mkConsEnum :: CodeGenM m => DataEnumValue CONST -> m CodeGenConstructor+mkConsEnum :: (CodeGenM m) => DataEnumValue CONST -> m CodeGenConstructor mkConsEnum DataEnumValue {enumName} = do constructorName <- getEnumName enumName pure CodeGenConstructor {constructorName, constructorFields = []} -renderDataField :: CodeGenM m => FieldDefinition c CONST -> m CodeGenField+renderDataField :: (CodeGenM m) => FieldDefinition c CONST -> m CodeGenField renderDataField FieldDefinition {fieldType = TypeRef {typeConName, typeWrappers}, fieldName = fName} = do fieldName <- getFieldName fName let wrappers = [GQL_WRAPPER typeWrappers]@@ -336,7 +338,7 @@ let fieldIsNullable = isNullable typeWrappers pure CodeGenField {..} -genTypeContent :: CodeGenM m => TypeName -> TypeContent TRUE ANY CONST -> m BuildPlan+genTypeContent :: (CodeGenM m) => TypeName -> TypeContent TRUE ANY CONST -> m BuildPlan genTypeContent _ DataScalar {} = pure (ConsIN []) genTypeContent _ (DataEnum tags) = ConsIN <$> traverse mkConsEnum tags genTypeContent typeName (DataInputObject fields) =@@ -364,7 +366,7 @@ where unionCon UnionMember {memberName} = mkUnionFieldDefinition typeName memberName -mkUnionFieldDefinition :: CodeGenM m => TypeName -> TypeName -> m CodeGenConstructor+mkUnionFieldDefinition :: (CodeGenM m) => TypeName -> TypeName -> m CodeGenConstructor mkUnionFieldDefinition typeName memberName = do fieldType <- getFieldTypeName memberName pure $@@ -382,10 +384,10 @@ where constructorName = CodeGenTypeName [coerce typeName] [] memberName -genArgumentTypes :: CodeGenM m => FieldsDefinition OUT CONST -> m [ServerDeclaration]+genArgumentTypes :: (CodeGenM m) => FieldsDefinition OUT CONST -> m [ServerDeclaration] genArgumentTypes = fmap concat . traverse genArgumentType . toList -genArgumentType :: CodeGenM m => FieldDefinition OUT CONST -> m [ServerDeclaration]+genArgumentType :: (CodeGenM m) => FieldDefinition OUT CONST -> m [ServerDeclaration] genArgumentType FieldDefinition { fieldName,
src/Data/Morpheus/CodeGen/Server/Interpreting/Utils.hs view
@@ -60,14 +60,14 @@ ( Dec (..), Info (..), Q,- TyVarBndr, reify, )+import qualified Language.Haskell.TH as TH import Relude hiding (ByteString, get) class (MonadReader ServerCodeGenContext m, Monad m, MonadFail m, CodeGenMonad m, MonadState Flags m) => CodeGenM m -instance CodeGenMonad m => CodeGenM (CodeGenT ServerCodeGenContext m)+instance (CodeGenMonad m) => CodeGenM (CodeGenT ServerCodeGenContext m) data ServerCodeGenContext = ServerCodeGenContext { toArgsTypeName :: FieldName -> TypeName,@@ -78,17 +78,17 @@ hasNamespace :: Bool } -checkTypeExistence :: CodeGenM m => TypeName -> m ()+checkTypeExistence :: (CodeGenM m) => TypeName -> m () checkTypeExistence name = do exists <- isJust <$> lookupType name if exists then pure () else requireExternal (unpackName name) -getFieldTypeName :: CodeGenM m => TypeName -> m TypeName+getFieldTypeName :: (CodeGenM m) => TypeName -> m TypeName getFieldTypeName name = checkTypeExistence name $> packName (toHaskellTypeName name) -getFieldName :: CodeGenM m => FieldName -> m FieldName+getFieldName :: (CodeGenM m) => FieldName -> m FieldName getFieldName fieldName = do ServerCodeGenContext {hasNamespace, currentTypeName} <- ask pure $@@ -96,7 +96,7 @@ then maybe fieldName (`camelCaseFieldName` fieldName) currentTypeName else fieldName -getEnumName :: MonadReader ServerCodeGenContext m => TypeName -> m CodeGenTypeName+getEnumName :: (MonadReader ServerCodeGenContext m) => TypeName -> m CodeGenTypeName getEnumName enumName = do ServerCodeGenContext {hasNamespace, currentTypeName} <- ask pure $@@ -108,7 +108,7 @@ isParametrizedType :: TypeName -> m Bool printWarnings :: [GQLError] -> m () -instance CodeGenMonad m => CodeGenMonad (CodeGenT ctx m) where+instance (CodeGenMonad m) => CodeGenMonad (CodeGenT ctx m) where isParametrizedType = lift . isParametrizedType printWarnings = lift . printWarnings @@ -122,10 +122,12 @@ -- Utils: is Parametrized type -#if MIN_VERSION_template_haskell(2,17,0)-getTypeVariables :: Dec -> [TyVarBndr ()]+#if MIN_VERSION_template_haskell(2,21,0)+getTypeVariables :: Dec -> [TH.TyVarBndr TH.BndrVis]+#elif MIN_VERSION_template_haskell(2,17,0)+getTypeVariables :: Dec -> [TH.TyVarBndr ()] #else-getTypeVariables :: Dec -> [TyVarBndr]+getTypeVariables :: Dec -> [TH.TyVarBndr] #endif getTypeVariables (DataD _ _ args _ _ _) = args getTypeVariables (NewtypeD _ _ args _ _ _) = args@@ -136,7 +138,7 @@ isParametrizedHaskellType (TyConI x) = not $ null $ getTypeVariables x isParametrizedHaskellType _ = False -isParametrizedResolverType :: CodeGenM m => TypeName -> [TypeDefinition ANY s] -> m Bool+isParametrizedResolverType :: (CodeGenM m) => TypeName -> [TypeDefinition ANY s] -> m Bool isParametrizedResolverType "__TypeKind" _ = pure False isParametrizedResolverType "Boolean" _ = pure False isParametrizedResolverType "String" _ = pure False@@ -146,19 +148,19 @@ Just x -> pure (isResolverType x) Nothing -> isParametrizedType name -isParamResolverType :: CodeGenM m => TypeName -> m Bool+isParamResolverType :: (CodeGenM m) => TypeName -> m Bool isParamResolverType typeConName = isParametrizedResolverType typeConName =<< asks typeDefinitions -notFoundError :: MonadFail m => String -> String -> m a+notFoundError :: (MonadFail m) => String -> String -> m a notFoundError name at = fail $ "can't found " <> name <> "at " <> at <> "!" -lookupType :: CodeGenM m => TypeName -> m (Maybe (TypeDefinition ANY CONST))+lookupType :: (CodeGenM m) => TypeName -> m (Maybe (TypeDefinition ANY CONST)) lookupType name = do types <- asks typeDefinitions pure $ find (\t -> typeName t == name) types -lookupFieldType :: CodeGenM m => TypeName -> FieldName -> m TypeRef+lookupFieldType :: (CodeGenM m) => TypeName -> FieldName -> m TypeRef lookupFieldType name fieldName = do TypeDefinition {typeContent} <- lookupType name >>= maybe (notFoundError (show name) "type definitions") pure case typeContent of@@ -171,5 +173,5 @@ isSubscription (KIND_OBJECT (Just OPERATION_SUBSCRIPTION)) = True isSubscription _ = False -inType :: MonadReader ServerCodeGenContext m => Maybe TypeName -> m a -> m a+inType :: (MonadReader ServerCodeGenContext m) => Maybe TypeName -> m a -> m a inType name = local (\x -> x {currentTypeName = name, currentKind = Nothing})