diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,76 +1,3 @@ # Morpheus GraphQL Code Gen -Morpheus GraphQL Code Gen helps you to generate GraphQL APIs . - -Morpheus GraphQL CLI is still in an early stage of development, so any feedback is more than welcome, and we appreciate any contribution! -Just open an issue here on GitHub, or join [our Slack channel](https://morpheus-graphql-slack-invite.herokuapp.com/) to get in touch. - -## Getting Started - -Generating dummy Morpheus Api from `schema.gql` - -```ssh -morpheus build src/*.gql --root src -``` - -_src/schema.gql_ - -```gql -type Query { - deity(name: String!): Deity - deities: [Deity!]! -} - -""" -deity description -""" -type Deity { - """ - name description - """ - name: String! - power: String -} -``` - -_src/Schema.hs_ - -```haskell -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} - -module Schema where - -import Data.Data (Typeable) -import Data.Map (empty, fromList) -import Data.Morpheus.Kind (TYPE) -import Data.Morpheus.Types -import Data.Text (Text) -import GHC.Generics (Generic) - ----- GQL Query ------------------------------- -data Query m = Query - { queryDeity :: Arg "name" Text -> m (Maybe (Deity m)), - queryDeities :: m [Deity m] - } - deriving (Generic) - -instance (Typeable m) => GQLType (Query m) where - type KIND (Query m) = TYPE - ----- GQL Deity ------------------------------- -data Deity m = Deity - { deityName :: m Text, - deityPower :: m (Maybe Text) - } - deriving (Generic) - -instance (Typeable m) => GQLType (Deity m) where - type KIND (Deity m) = TYPE - description _ = Just "\ndeity description\n" - getDescriptions _ = fromList [("name", "\n name description\n ")] -``` +generates Morpheus APIs from GraphQL documents (see [Code Gen Docs](https://morpheusgraphql.com/code-gen)). diff --git a/app/CLI/Generator.hs b/app/CLI/Generator.hs --- a/app/CLI/Generator.hs +++ b/app/CLI/Generator.hs @@ -41,12 +41,8 @@ ModuleDefinition { moduleName, imports = - [ ("Data.Data", ["Typeable"]), - ("Data.Morpheus.Kind", ["TYPE"]), - ("Data.Morpheus.Types", ["*"]), - ("Data.Morpheus", []), - ("Data.Text", ["Text"]), - ("GHC.Generics", ["Generic"]) + [ ("Data.Morpheus.Server.CodeGen.Internal", ["*"]), + ("Data.Morpheus.Server.Types", ["*"]) ] <> map (,["*"]) globalImports, extensions = diff --git a/morpheus-graphql-code-gen.cabal b/morpheus-graphql-code-gen.cabal --- a/morpheus-graphql-code-gen.cabal +++ b/morpheus-graphql-code-gen.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: morpheus-graphql-code-gen -version: 0.24.3 +version: 0.25.0 synopsis: Morpheus GraphQL CLI description: code generator for Morpheus GraphQL category: web, graphql, cli @@ -44,9 +44,9 @@ , bytestring >=0.10.4 && <0.12.0 , containers >=0.4.2.1 && <0.7.0 , file-embed >=0.0.10 && <1.0.0 - , morpheus-graphql-code-gen-utils >=0.24.0 && <0.25.0 - , morpheus-graphql-core >=0.24.0 && <0.25.0 - , morpheus-graphql-server >=0.24.0 && <0.25.0 + , morpheus-graphql-code-gen-utils >=0.25.0 && <0.26.0 + , morpheus-graphql-core >=0.25.0 && <0.26.0 + , morpheus-graphql-server >=0.25.0 && <0.26.0 , prettyprinter >=1.7.0 && <2.0.0 , relude >=0.3.0 && <2.0.0 , template-haskell >=2.0.0 && <3.0.0 @@ -75,8 +75,8 @@ , morpheus-graphql-client , morpheus-graphql-code-gen , morpheus-graphql-code-gen-utils - , morpheus-graphql-core >=0.24.0 && <0.25.0 - , morpheus-graphql-server >=0.24.0 && <0.25.0 + , morpheus-graphql-core >=0.25.0 && <0.26.0 + , morpheus-graphql-server >=0.25.0 && <0.26.0 , optparse-applicative >=0.12.0 && <0.18.0 , prettyprinter >=1.7.0 && <2.0.0 , relude >=0.3.0 && <2.0.0 diff --git a/src/Data/Morpheus/CodeGen/Server/Internal/AST.hs b/src/Data/Morpheus/CodeGen/Server/Internal/AST.hs --- a/src/Data/Morpheus/CodeGen/Server/Internal/AST.hs +++ b/src/Data/Morpheus/CodeGen/Server/Internal/AST.hs @@ -94,8 +94,7 @@ data GQLTypeDefinition = GQLTypeDefinition { gqlTarget :: CodeGenTypeName, gqlKind :: Kind, - gqlTypeDirectiveUses :: [ServerDirectiveUsage], - gqlTypeDefaultValues :: Map Text (Value CONST) + gqlTypeDirectiveUses :: [ServerDirectiveUsage] } deriving (Show) @@ -146,7 +145,7 @@ pretty (GQLTypeInstance kind gql) | kind == Scalar = "" | otherwise = pretty gql - pretty (GQLDirectiveInstance _) = "TODO: not supported" + pretty (GQLDirectiveInstance _) = "" newtype CodeGenConfig = CodeGenConfig {namespace :: Bool} diff --git a/src/Data/Morpheus/CodeGen/Server/Interpreting/Directive.hs b/src/Data/Morpheus/CodeGen/Server/Interpreting/Directive.hs --- a/src/Data/Morpheus/CodeGen/Server/Interpreting/Directive.hs +++ b/src/Data/Morpheus/CodeGen/Server/Interpreting/Directive.hs @@ -10,12 +10,14 @@ ( getDirs, getNamespaceDirs, dirRename, + getDefaultValueDir, ) where import Data.Char (isUpper) import Data.Morpheus.CodeGen.Internal.AST - ( getFullName, + ( PrintableValue (..), + getFullName, ) import Data.Morpheus.CodeGen.Server.Internal.AST (ServerDirectiveUsage (..), TypeValue (..), unpackName) import Data.Morpheus.CodeGen.Server.Interpreting.Utils @@ -36,6 +38,7 @@ Description, Directive (Directive, directiveArgs, directiveName), DirectiveDefinition (..), + FieldContent (..), FieldDefinition (..), FieldName, FieldsDefinition, @@ -45,10 +48,24 @@ TypeDefinition (..), TypeName, TypeRef (..), + Value, ) import qualified Data.Morpheus.Types.Internal.AST as AST import Data.Text (head) import Relude hiding (ByteString, get, head) + +getDefaultValueDir :: (Monad m) => FieldDefinition c CONST -> CodeGenT m [ServerDirectiveUsage] +getDefaultValueDir + FieldDefinition + { fieldName, + fieldContent = Just DefaultInputValue {defaultInputValue} + } = do + name <- getFieldName fieldName + pure [FieldDirectiveUsage name (defValDirective defaultInputValue)] +getDefaultValueDir _ = pure [] + +defValDirective :: Value CONST -> TypeValue +defValDirective desc = TypeValueObject "DefaultValue" [("defaultValue", PrintableTypeValue $ PrintableValue desc)] getNamespaceDirs :: MonadReader (TypeContext s) m => Text -> m [ServerDirectiveUsage] getNamespaceDirs genTypeName = do diff --git a/src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs b/src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs --- a/src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs +++ b/src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs @@ -36,7 +36,7 @@ ServerDirectiveUsage (..), ServerMethod (..), ) -import Data.Morpheus.CodeGen.Server.Interpreting.Directive (dirRename, getDirs, getNamespaceDirs) +import Data.Morpheus.CodeGen.Server.Interpreting.Directive (dirRename, getDefaultValueDir, getDirs, getNamespaceDirs) import Data.Morpheus.CodeGen.Server.Interpreting.Utils (CodeGenMonad (printWarnings), CodeGenT, TypeContext (..), getEnumName, getFieldName, inType, isParamResolverType, isSubscription) import Data.Morpheus.CodeGen.TH (ToName (..)) import Data.Morpheus.CodeGen.Utils @@ -74,7 +74,6 @@ packName, unpackName, ) -import qualified Data.Morpheus.Types.Internal.AST as AST import Relude hiding (ByteString, get) parseServerTypeDefinitions :: CodeGenMonad m => CodeGenConfig -> ByteString -> m [ServerDeclaration] @@ -130,7 +129,6 @@ GQLTypeDefinition { gqlTarget = cgTypeName, gqlKind = Type, - gqlTypeDefaultValues = mempty, gqlTypeDirectiveUses = namespaceDirs } ] @@ -171,19 +169,15 @@ cgTypeName = CodeGenTypeName [] ["m" | isResolverType tKind] hsTypeName renameDir = [TypeDirectiveUsage (dirRename originalTypeName) | originalTypeName /= hsTypeName] deriveGQL = do + defaultValueDirs <- concat <$> traverse getDefaultValueDir (getInputFields typeDef) namespaceDirs <- getNamespaceDirs (unpackName hsTypeName) dirs <- getDirs typeDef - -- TODO: here pure $ gqlTypeToInstance GQLTypeDefinition { gqlTarget = cgTypeName, - gqlTypeDirectiveUses = renameDir <> namespaceDirs <> dirs, - gqlKind = derivingKind tKind, - gqlTypeDefaultValues = - fromList $ - mapMaybe getDefaultValue $ - getInputFields typeDef + gqlTypeDirectiveUses = renameDir <> namespaceDirs <> dirs <> defaultValueDirs, + gqlKind = derivingKind tKind } cgDerivations = derivesClasses (isResolverType tKind) ------------------------- @@ -265,8 +259,9 @@ typeClassTarget = gqlTarget, assoc = [(''KIND, AssociatedTypeName (toName gqlKind))], typeClassMethods = - [('defaultValues, ProxyArgument, ServerMethodDefaultValues gqlTypeDefaultValues) | not (null gqlTypeDefaultValues)] - <> [('directives, ProxyArgument, ServerMethodDirectives gqlTypeDirectiveUses) | not (null gqlTypeDirectiveUses)] + [ ('directives, ProxyArgument, ServerMethodDirectives gqlTypeDirectiveUses) + | not (null gqlTypeDirectiveUses) + ] } genInterfaceUnion :: Monad m => TypeName -> CodeGenT m [ServerDeclaration] @@ -288,8 +283,7 @@ GQLTypeDefinition { gqlTarget = possTypeName, gqlKind = Type, - gqlTypeDirectiveUses = empty, - gqlTypeDefaultValues = mempty + gqlTypeDirectiveUses = empty } ] where @@ -376,6 +370,7 @@ namespaceDirs <- getNamespaceDirs typename dirs <- concat <$> traverse getDirs argumentFields let cgTypeName = fromTypeName (packName typename) + defaultValueDirs <- concat <$> traverse getDefaultValueDir argumentFields pure [ DataType CodeGenType @@ -387,8 +382,7 @@ GQLTypeDefinition { gqlTarget = cgTypeName, gqlKind = Type, - gqlTypeDefaultValues = fromList (mapMaybe getDefaultValue argumentFields), - gqlTypeDirectiveUses = namespaceDirs <> dirs + gqlTypeDirectiveUses = namespaceDirs <> dirs <> defaultValueDirs } ] genArgumentType _ = pure [] @@ -396,11 +390,3 @@ getInputFields :: TypeDefinition c s -> [FieldDefinition IN s] getInputFields TypeDefinition {typeContent = DataInputObject {inputObjectFields}} = toList inputObjectFields getInputFields _ = [] - -getDefaultValue :: FieldDefinition c s -> Maybe (Text, AST.Value s) -getDefaultValue - FieldDefinition - { fieldName, - fieldContent = Just DefaultInputValue {defaultInputValue} - } = Just (unpackName fieldName, defaultInputValue) -getDefaultValue _ = Nothing