diff --git a/morpheus-graphql.cabal b/morpheus-graphql.cabal --- a/morpheus-graphql.cabal +++ b/morpheus-graphql.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: morpheus-graphql -version: 0.19.3 +version: 0.20.0 synopsis: Morpheus GraphQL description: Build GraphQL APIs with your favourite functional language! category: web, graphql @@ -112,6 +112,8 @@ test/Feature/Holistic/holistic/selection/unknownField/query.gql test/Feature/Holistic/schema-ext.gql test/Feature/Holistic/schema.gql + test/Feature/Inference/object-and-enum/introspection/query.gql + test/Feature/Inference/object-and-enum/resolving/query.gql test/Feature/Inference/tagged-arguments-fail/introspection/query.gql test/Feature/Inference/tagged-arguments-fail/resolving/query.gql test/Feature/Inference/tagged-arguments/introspection/query.gql @@ -322,6 +324,8 @@ test/Feature/Holistic/holistic/selection/subscription/singleTopLevelField/fail/response.json test/Feature/Holistic/holistic/selection/subscription/singleTopLevelField/failAnonymous/response.json test/Feature/Holistic/holistic/selection/unknownField/response.json + test/Feature/Inference/object-and-enum/introspection/response.json + test/Feature/Inference/object-and-enum/resolving/response.json test/Feature/Inference/tagged-arguments-fail/introspection/response.json test/Feature/Inference/tagged-arguments-fail/resolving/response.json test/Feature/Inference/tagged-arguments/introspection/response.json @@ -498,20 +502,20 @@ src ghc-options: -Wall build-depends: - aeson >=1.4.4.0 && <3 - , base >=4.7 && <5 - , bytestring >=0.10.4 && <0.11 - , containers >=0.4.2.1 && <0.7 - , morpheus-graphql-app >=0.19.0 && <0.20.0 - , morpheus-graphql-code-gen >=0.19.0 && <0.20.0 - , morpheus-graphql-core >=0.19.0 && <0.20.0 - , mtl >=2.0 && <3.0 - , relude >=0.3.0 && <2.0 - , template-haskell >=2.0 && <3.0 - , text >=1.2.3.0 && <1.3 - , transformers >=0.3 && <0.6 - , unordered-containers >=0.2.8.0 && <0.3 - , vector >=0.12.0.1 && <0.13 + aeson >=1.4.4 && <3.0.0 + , base >=4.7.0 && <5.0.0 + , bytestring >=0.10.4 && <0.12.0 + , containers >=0.4.2.1 && <0.7.0 + , morpheus-graphql-app >=0.20.0 && <0.21.0 + , morpheus-graphql-code-gen >=0.20.0 && <0.21.0 + , morpheus-graphql-core >=0.20.0 && <0.21.0 + , mtl >=2.0.0 && <3.0.0 + , relude >=0.3.0 && <2.0.0 + , template-haskell >=2.0.0 && <3.0.0 + , text >=1.2.3 && <1.3.0 + , transformers >=0.3.0 && <0.6.0 + , unordered-containers >=0.2.8 && <0.3.0 + , vector >=0.12.0.1 && <0.13.0 default-language: Haskell2010 test-suite morpheus-graphql-test @@ -523,6 +527,7 @@ Feature.Collision.NameCollision Feature.Collision.NameCollisionHelper Feature.Holistic.API + Feature.Inference.ObjectAndEnum Feature.Inference.TaggedArguments Feature.Inference.TaggedArgumentsFail Feature.Inference.TypeGuards @@ -551,23 +556,23 @@ test ghc-options: -Wall build-depends: - aeson >=1.4.4.0 && <3 - , base >=4.7 && <5 - , bytestring >=0.10.4 && <0.11 - , containers >=0.4.2.1 && <0.7 + aeson >=1.4.4 && <3.0.0 + , base >=4.7.0 && <5.0.0 + , bytestring >=0.10.4 && <0.12.0 + , containers >=0.4.2.1 && <0.7.0 , morpheus-graphql - , morpheus-graphql-app >=0.19.0 && <0.20.0 - , morpheus-graphql-code-gen >=0.19.0 && <0.20.0 - , morpheus-graphql-core >=0.19.0 && <0.20.0 - , morpheus-graphql-subscriptions >=0.19.0 && <0.20.0 - , morpheus-graphql-tests >=0.19.0 && <0.20.0 - , mtl >=2.0 && <3.0 - , relude >=0.3.0 && <2.0 - , tasty >=0.1 && <1.5 - , tasty-hunit >=0.1 && <1.0 - , template-haskell >=2.0 && <3.0 - , text >=1.2.3.0 && <1.3 - , transformers >=0.3 && <0.6 - , unordered-containers >=0.2.8.0 && <0.3 - , vector >=0.12.0.1 && <0.13 + , morpheus-graphql-app >=0.20.0 && <0.21.0 + , morpheus-graphql-code-gen >=0.20.0 && <0.21.0 + , morpheus-graphql-core >=0.20.0 && <0.21.0 + , morpheus-graphql-subscriptions >=0.20.0 && <0.21.0 + , morpheus-graphql-tests >=0.20.0 && <0.21.0 + , mtl >=2.0.0 && <3.0.0 + , relude >=0.3.0 && <2.0.0 + , tasty >=0.1.0 && <1.5.0 + , tasty-hunit >=0.1.0 && <1.0.0 + , template-haskell >=2.0.0 && <3.0.0 + , text >=1.2.3 && <1.3.0 + , transformers >=0.3.0 && <0.6.0 + , unordered-containers >=0.2.8 && <0.3.0 + , vector >=0.12.0.1 && <0.13.0 default-language: Haskell2010 diff --git a/src/Data/Morpheus/Server/Deriving/Channels.hs b/src/Data/Morpheus/Server/Deriving/Channels.hs --- a/src/Data/Morpheus/Server/Deriving/Channels.hs +++ b/src/Data/Morpheus/Server/Deriving/Channels.hs @@ -1,12 +1,13 @@ {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -40,6 +41,7 @@ toValue, ) import Data.Morpheus.Server.Types.GQLType (GQLType) +import Data.Morpheus.Server.Types.Types (Undefined) import Data.Morpheus.Types.Internal.AST ( FieldName, OUT, @@ -50,7 +52,7 @@ internal, ) import GHC.Generics -import Relude +import Relude hiding (Undefined) newtype DerivedChannel e = DerivedChannel { _unpackChannel :: Channel e @@ -59,7 +61,7 @@ type ChannelRes (e :: Type) = Selection VALID -> ResolverState (DerivedChannel e) type ChannelsConstraint e m (subs :: (Type -> Type) -> Type) = - ExploreConstraint e (subs (Resolver SUBSCRIPTION e m)) + ExploreChannels (IsUndefined (subs (Resolver SUBSCRIPTION e m))) e (subs (Resolver SUBSCRIPTION e m)) channelResolver :: forall e m subs. @@ -72,7 +74,12 @@ channelSelector :: Selection VALID -> ResolverState (DerivedChannel e) - channelSelector = selectBySelection (exploreChannels value) + channelSelector = + selectBySelection + ( exploreChannels + (Proxy @(IsUndefined (subs (Resolver SUBSCRIPTION e m)))) + value + ) selectBySelection :: HashMap FieldName (ChannelRes e) -> @@ -115,20 +122,24 @@ ------------------------------------------------------ -type ExploreConstraint e a = - ( GQLType a, - Generic a, - TypeRep (GetChannel e) (ChannelRes e) (Rep a) - ) +type family IsUndefined a :: Bool where + IsUndefined (Undefined m) = 'True + IsUndefined a = 'False -exploreChannels :: forall e a. ExploreConstraint e a => a -> HashMap FieldName (ChannelRes e) -exploreChannels = - HM.fromList - . convertNode - . toValue - ( TypeConstraint (getChannel . runIdentity) :: TypeConstraint (GetChannel e) (ChannelRes e) Identity - ) - (Proxy @OUT) +class ExploreChannels (t :: Bool) e a where + exploreChannels :: f t -> a -> HashMap FieldName (ChannelRes e) + +instance (GQLType a, Generic a, TypeRep (GetChannel e) (ChannelRes e) (Rep a)) => ExploreChannels 'False e a where + exploreChannels _ = + HM.fromList + . convertNode + . toValue + ( TypeConstraint (getChannel . runIdentity) :: TypeConstraint (GetChannel e) (ChannelRes e) Identity + ) + (Proxy @OUT) + +instance ExploreChannels 'True e (Undefined m) where + exploreChannels _ = pure HM.empty convertNode :: DataType (ChannelRes e) -> [(FieldName, ChannelRes e)] convertNode DataType {tyCons = ConsRep {consFields}} = map toChannels consFields diff --git a/src/Data/Morpheus/Server/Deriving/Encode.hs b/src/Data/Morpheus/Server/Deriving/Encode.hs --- a/src/Data/Morpheus/Server/Deriving/Encode.hs +++ b/src/Data/Morpheus/Server/Deriving/Encode.hs @@ -27,7 +27,6 @@ ObjectTypeResolver, Resolver, ResolverState, - ResolverValue, ResolverValue (..), RootResolverValue (..), getArguments, @@ -172,20 +171,20 @@ { dataTypeName, tyIsUnion, tyCons = cons@ConsRep {consFields, consName} - } - | tyIsUnion = encodeUnion consFields - | otherwise = mkObject dataTypeName (toFieldRes <$> consFields) + } = encodeTypeFields consFields where -- ENUM - encodeUnion :: + encodeTypeFields :: [FieldRep (m (ResolverValue m))] -> ResolverValue m - encodeUnion [] = mkEnum consName + encodeTypeFields [] = mkEnum consName + encodeTypeFields fields + | not tyIsUnion = mkObject dataTypeName (toFieldRes <$> fields) -- Type References -------------------------------------------------------------- - encodeUnion [FieldRep {fieldTypeRef = TypeRef {typeConName}, fieldValue}] - | isUnionRef dataTypeName cons = ResLazy (ResObject (Just typeConName) <$> (fieldValue >>= requireObject)) + encodeTypeFields [FieldRep {fieldTypeRef, fieldValue}] + | isUnionRef dataTypeName cons = ResLazy (ResObject (Just (typeConName fieldTypeRef)) <$> (fieldValue >>= requireObject)) -- Inline Union Types ---------------------------------------------------------------------------- - encodeUnion fields = mkUnion consName (toFieldRes <$> fields) + encodeTypeFields fields = mkUnion consName (toFieldRes <$> fields) -- Types & Constrains ------------------------------------------------------- exploreResolvers :: diff --git a/src/Data/Morpheus/Server/Deriving/Schema.hs b/src/Data/Morpheus/Server/Deriving/Schema.hs --- a/src/Data/Morpheus/Server/Deriving/Schema.hs +++ b/src/Data/Morpheus/Server/Deriving/Schema.hs @@ -88,9 +88,7 @@ import Data.Morpheus.Types.Internal.AST ( ArgumentsDefinition, CONST, - CONST, FieldContent (..), - FieldContent (..), FieldsDefinition, IN, LEAF, @@ -155,14 +153,14 @@ SchemaT OUT ( TypeDefinition OBJECT CONST, - TypeDefinition OBJECT CONST, - TypeDefinition OBJECT CONST + Maybe (TypeDefinition OBJECT CONST), + Maybe (TypeDefinition OBJECT CONST) ) schemaT = (,,) - <$> deriveObjectType (Proxy @(query (Resolver QUERY e m))) - <*> deriveObjectType (Proxy @(mut (Resolver MUTATION e m))) - <*> deriveObjectType (Proxy @(subs (Resolver SUBSCRIPTION e m))) + <$> deriveRoot (Proxy @(query (Resolver QUERY e m))) + <*> deriveMaybeRoot (Proxy @(mut (Resolver MUTATION e m))) + <*> deriveMaybeRoot (Proxy @(subs (Resolver SUBSCRIPTION e m))) -- | Generates internal GraphQL Schema for query validation and introspection rendering class DeriveType (kind :: TypeCategory) (a :: Type) where @@ -273,8 +271,14 @@ deriveOutputType :: DeriveTypeConstraint OUT a => f a -> SchemaT OUT () deriveOutputType = updateByContent deriveTypeContent . outputType -deriveObjectType :: DeriveTypeConstraint OUT a => f a -> SchemaT OUT (TypeDefinition OBJECT CONST) -deriveObjectType = asObjectType (deriveFields . outputType) +deriveRoot :: DeriveTypeConstraint OUT a => f a -> SchemaT OUT (TypeDefinition OBJECT CONST) +deriveRoot = asObjectType (deriveFields . outputType) + +deriveMaybeRoot :: DeriveTypeConstraint OUT a => f a -> SchemaT OUT (Maybe (TypeDefinition OBJECT CONST)) +deriveMaybeRoot proxy + | __isEmptyType proxy = + pure Nothing + | otherwise = Just <$> asObjectType (deriveFields . outputType) proxy fieldContentConstraint :: f kind a -> TypeConstraint (DeriveType kind) (TyContentM kind) Proxy fieldContentConstraint _ = TypeConstraint deriveFieldContent diff --git a/src/Data/Morpheus/Server/Deriving/Schema/TypeContent.hs b/src/Data/Morpheus/Server/Deriving/Schema/TypeContent.hs --- a/src/Data/Morpheus/Server/Deriving/Schema/TypeContent.hs +++ b/src/Data/Morpheus/Server/Deriving/Schema/TypeContent.hs @@ -34,6 +34,6 @@ KindedType kind a -> [ConsRep (TyContent kind)] -> SchemaT kind (TypeContent TRUE kind CONST) -buildTypeContent scope [ConsRep {consFields}] = buildObjectTypeContent scope consFields buildTypeContent scope cons | all isEmptyConstraint cons = buildEnumTypeContent scope (consName <$> cons) +buildTypeContent scope [ConsRep {consFields}] = buildObjectTypeContent scope consFields buildTypeContent scope cons = buildUnionTypeContent scope cons diff --git a/src/Data/Morpheus/Server/Types/SchemaT.hs b/src/Data/Morpheus/Server/Types/SchemaT.hs --- a/src/Data/Morpheus/Server/Types/SchemaT.hs +++ b/src/Data/Morpheus/Server/Types/SchemaT.hs @@ -6,7 +6,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} @@ -92,15 +91,15 @@ SchemaT c ( TypeDefinition OBJECT CONST, - TypeDefinition OBJECT CONST, - TypeDefinition OBJECT CONST + Maybe (TypeDefinition OBJECT CONST), + Maybe (TypeDefinition OBJECT CONST) ) -> GQLResult (Schema CONST) toSchema (SchemaT v) = do ((q, m, s), typeDefs) <- v (typeDefinitions, implements) <- execUpdates (Map.empty, Map.empty) typeDefs types <- map (insertImplements implements) <$> checkTypeCollisions (Map.toList typeDefinitions) - defineSchemaWith types (optionalType q, optionalType m, optionalType s) + defineSchemaWith types (Just q, m, s) insertImplements :: Map TypeName [TypeName] -> TypeDefinition c CONST -> TypeDefinition c CONST insertImplements x TypeDefinition {typeContent = DataObject {..}, ..} = @@ -147,11 +146,6 @@ withSameCategory :: TypeFingerprint -> TypeFingerprint withSameCategory (TypeableFingerprint _ xs) = TypeableFingerprint OUT xs withSameCategory x = x - -optionalType :: TypeDefinition OBJECT CONST -> Maybe (TypeDefinition OBJECT CONST) -optionalType td@TypeDefinition {typeContent = DataObject {objectFields}} - | null objectFields = Nothing - | otherwise = Just td execUpdates :: Monad m => a -> [a -> m a] -> m a execUpdates = foldlM (&) diff --git a/src/Data/Morpheus/Server/Types/Types.hs b/src/Data/Morpheus/Server/Types/Types.hs --- a/src/Data/Morpheus/Server/Types/Types.hs +++ b/src/Data/Morpheus/Server/Types/Types.hs @@ -16,11 +16,9 @@ ( Generic, ) import GHC.TypeLits (Symbol) -import Prelude - ( Show, - ) +import Prelude (Bool, Show) -data Undefined (m :: Type -> Type) = Undefined deriving (Show, Generic) +newtype Undefined (m :: Type -> Type) = Undefined Bool deriving (Show, Generic) data Pair k v = Pair k v deriving (Generic) diff --git a/src/Data/Morpheus/Types.hs b/src/Data/Morpheus/Types.hs --- a/src/Data/Morpheus/Types.hs +++ b/src/Data/Morpheus/Types.hs @@ -23,7 +23,7 @@ RootResolver (..), constRes, constMutRes, - Undefined (..), + Undefined, Resolver, QUERY, MUTATION, @@ -64,6 +64,7 @@ fieldLabelModifier, constructorTagModifier, typeNameModifier, + defaultRootResolver, ) where @@ -220,6 +221,14 @@ mutationResolver :: mutation (Resolver MUTATION event m), subscriptionResolver :: subscription (Resolver SUBSCRIPTION event m) } + +defaultRootResolver :: RootResolver m event Undefined Undefined Undefined +defaultRootResolver = + RootResolver + { queryResolver = Undefined False, + mutationResolver = Undefined False, + subscriptionResolver = Undefined False + } data NamedResolvers diff --git a/test/Feature/Collision/CategoryCollisionFail.hs b/test/Feature/Collision/CategoryCollisionFail.hs --- a/test/Feature/Collision/CategoryCollisionFail.hs +++ b/test/Feature/Collision/CategoryCollisionFail.hs @@ -10,13 +10,15 @@ ) where +import Data.Kind (Type) import Data.Morpheus (interpreter) import Data.Morpheus.Types ( GQLRequest, GQLResponse, GQLType (..), RootResolver (..), - Undefined (..), + Undefined, + defaultRootResolver, ) import Data.Text ( Text, @@ -34,14 +36,14 @@ } deriving (Show, Generic, GQLType) -newtype Query (m :: * -> *) = Query +newtype Query (m :: Type -> Type) = Query { deity :: DeityArgs -> m Deity } deriving (Generic, GQLType) rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver = - RootResolver + defaultRootResolver { queryResolver = Query { deity = @@ -52,9 +54,7 @@ "Morpheus", age = 1000 } - }, - mutationResolver = Undefined, - subscriptionResolver = Undefined + } } api :: GQLRequest -> IO GQLResponse diff --git a/test/Feature/Collision/CategoryCollisionSuccess.hs b/test/Feature/Collision/CategoryCollisionSuccess.hs --- a/test/Feature/Collision/CategoryCollisionSuccess.hs +++ b/test/Feature/Collision/CategoryCollisionSuccess.hs @@ -9,6 +9,7 @@ ) where +import Data.Kind (Type) import Data.Morpheus (interpreter) import Data.Morpheus.Types ( GQLRequest, @@ -16,7 +17,8 @@ GQLType (..), GQLTypeOptions (..), RootResolver (..), - Undefined (..), + Undefined, + defaultRootResolver, ) import Data.Text ( Text, @@ -41,14 +43,14 @@ } deriving (Show, Generic, GQLType) -newtype Query (m :: * -> *) = Query +newtype Query (m :: Type -> Type) = Query { deity :: DeityArgs -> m Deity } deriving (Generic, GQLType) rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver = - RootResolver + defaultRootResolver { queryResolver = Query { deity = @@ -59,9 +61,7 @@ "Morpheus", age = 1000 } - }, - mutationResolver = Undefined, - subscriptionResolver = Undefined + } } api :: GQLRequest -> IO GQLResponse diff --git a/test/Feature/Collision/NameCollision.hs b/test/Feature/Collision/NameCollision.hs --- a/test/Feature/Collision/NameCollision.hs +++ b/test/Feature/Collision/NameCollision.hs @@ -8,8 +8,16 @@ ) where +import Data.Kind (Type) import Data.Morpheus (interpreter) -import Data.Morpheus.Types (GQLRequest, GQLResponse, GQLType (..), RootResolver (..), Undefined (..)) +import Data.Morpheus.Types + ( GQLRequest, + GQLResponse, + GQLType (..), + RootResolver (..), + Undefined, + defaultRootResolver, + ) import Data.Text (Text) import qualified Feature.Collision.NameCollisionHelper as A2 (A (..)) import GHC.Generics (Generic) @@ -20,7 +28,7 @@ } deriving (Generic, GQLType) -data Query (m :: * -> *) = Query +data Query (m :: Type -> Type) = Query { a1 :: A, a2 :: A2.A } @@ -28,10 +36,8 @@ rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver = - RootResolver - { queryResolver = Query {a1 = A "" 0, a2 = A2.A 0}, - mutationResolver = Undefined, - subscriptionResolver = Undefined + defaultRootResolver + { queryResolver = Query {a1 = A "" 0, a2 = A2.A 0} } api :: GQLRequest -> IO GQLResponse diff --git a/test/Feature/Holistic/API.hs b/test/Feature/Holistic/API.hs --- a/test/Feature/Holistic/API.hs +++ b/test/Feature/Holistic/API.hs @@ -36,7 +36,8 @@ RootResolver (..), ScalarValue (..), TypeGuard (..), - Undefined (..), + Undefined, + defaultRootResolver, liftEither, subscribe, ) @@ -44,12 +45,7 @@ import Data.Text (Text) import GHC.Generics (Generic) import Prelude - ( ($), - (*), - (+), - (.), - (<$>), - Applicative (..), + ( Applicative (..), Either (..), Eq (..), IO, @@ -58,6 +54,11 @@ Show (..), String, const, + ($), + (*), + (+), + (.), + (<$>), ) data TestScalar @@ -145,15 +146,13 @@ rootExt :: RootResolver IO EVENT ExtQuery Undefined Undefined rootExt = - RootResolver + defaultRootResolver { queryResolver = ExtQuery { fail1 = liftEither alwaysFail, fail2 = fail "fail with MonadFail", type' = \(Arg TypeInput {data'}) -> pure data' - }, - mutationResolver = Undefined, - subscriptionResolver = Undefined + } } api :: GQLRequest -> IO GQLResponse diff --git a/test/Feature/Inference/ObjectAndEnum.hs b/test/Feature/Inference/ObjectAndEnum.hs new file mode 100644 --- /dev/null +++ b/test/Feature/Inference/ObjectAndEnum.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE TypeFamilies #-} + +module Feature.Inference.ObjectAndEnum + ( api, + ) +where + +import Data.Kind (Type) +import Data.Morpheus (interpreter) +import Data.Morpheus.Types + ( GQLRequest, + GQLResponse, + GQLType (..), + RootResolver (..), + Undefined, + defaultRootResolver, + ) +import GHC.Generics (Generic) + +data MyEnum = MyEnum deriving (Generic, GQLType) + +newtype MyObject + = MyObject Int + deriving (Generic, GQLType) + +data Query (m :: Type -> Type) = Query + { enum :: MyEnum, + object :: MyObject + } + deriving (Generic, GQLType) + +root :: RootResolver IO () Query Undefined Undefined +root = + defaultRootResolver + { queryResolver = + Query + { enum = MyEnum, + object = MyObject 0 + } + } + +api :: GQLRequest -> IO GQLResponse +api = interpreter root diff --git a/test/Feature/Inference/TaggedArguments.hs b/test/Feature/Inference/TaggedArguments.hs --- a/test/Feature/Inference/TaggedArguments.hs +++ b/test/Feature/Inference/TaggedArguments.hs @@ -9,6 +9,7 @@ ) where +import Data.Kind (Type) import Data.Morpheus (interpreter) import Data.Morpheus.Types ( Arg (..), @@ -16,7 +17,8 @@ GQLResponse, GQLType (..), RootResolver (..), - Undefined (..), + Undefined, + defaultRootResolver, ) import Data.Text ( Text, @@ -28,33 +30,46 @@ { a1 :: Text, a2 :: Int } - deriving (Show, Generic, GQLType) + deriving + ( Show, + Generic, + GQLType + ) newtype B = B {b1 :: Text} - deriving (Show, Generic, GQLType) + deriving + ( Show, + Generic, + GQLType + ) newtype C = C {c1 :: Int} - deriving (Show, Generic, GQLType) + deriving + ( Show, + Generic, + GQLType + ) -data Query (m :: * -> *) = Query +data Query (m :: Type -> Type) = Query { field1 :: A -> B -> C -> m Text, field2 :: A -> Arg "b1" Text -> Arg "c1" Int -> m Text } - deriving (Generic, GQLType) + deriving + ( Generic, + GQLType + ) -rootResolver :: RootResolver IO () Query Undefined Undefined -rootResolver = - RootResolver +root :: RootResolver IO () Query Undefined Undefined +root = + defaultRootResolver { queryResolver = Query { field1 = \a b c -> pure $ pack $ show (a, b, c), field2 = \a b c -> pure $ pack $ show (a, b, c) - }, - mutationResolver = Undefined, - subscriptionResolver = Undefined + } } api :: GQLRequest -> IO GQLResponse -api = interpreter rootResolver +api = interpreter root diff --git a/test/Feature/Inference/TaggedArgumentsFail.hs b/test/Feature/Inference/TaggedArgumentsFail.hs --- a/test/Feature/Inference/TaggedArgumentsFail.hs +++ b/test/Feature/Inference/TaggedArgumentsFail.hs @@ -9,13 +9,15 @@ ) where +import Data.Kind (Type) import Data.Morpheus (interpreter) import Data.Morpheus.Types ( GQLRequest, GQLResponse, GQLType (..), RootResolver (..), - Undefined (..), + Undefined, + defaultRootResolver, ) import Data.Text ( Text, @@ -33,20 +35,18 @@ {a2 :: Text} deriving (Show, Generic, GQLType) -newtype Query (m :: * -> *) = Query +newtype Query (m :: Type -> Type) = Query { field1 :: A -> B -> m Text } deriving (Generic, GQLType) rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver = - RootResolver + defaultRootResolver { queryResolver = Query { field1 = \a b -> pure $ pack $ show (a, b) - }, - mutationResolver = Undefined, - subscriptionResolver = Undefined + } } api :: GQLRequest -> IO GQLResponse diff --git a/test/Feature/Inference/TypeGuards.hs b/test/Feature/Inference/TypeGuards.hs --- a/test/Feature/Inference/TypeGuards.hs +++ b/test/Feature/Inference/TypeGuards.hs @@ -10,6 +10,7 @@ ) where +import Data.Kind (Type) import Data.Morpheus (interpreter) import Data.Morpheus.Types ( GQLRequest, @@ -17,7 +18,8 @@ GQLType (..), RootResolver (..), TypeGuard (..), - Undefined (..), + Undefined, + defaultRootResolver, ) import Data.Text ( Text, @@ -30,21 +32,21 @@ } deriving (Show, Generic, GQLType) -data Deity (m :: * -> *) = Deity +data Deity (m :: Type -> Type) = Deity { name :: Text, age :: Int, power :: Text } deriving (Generic, GQLType) -data Implements (m :: * -> *) +data Implements (m :: Type -> Type) = ImplementsDeity (Deity m) | Creature {name :: Text, age :: Int} deriving (Generic, GQLType) type Characters m = TypeGuard Character (Implements m) -newtype Query (m :: * -> *) = Query +newtype Query (m :: Type -> Type) = Query { characters :: [Characters m] } deriving (Generic, GQLType) @@ -67,13 +69,8 @@ rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver = - RootResolver - { queryResolver = - Query - { characters = resolveCharacters - }, - mutationResolver = Undefined, - subscriptionResolver = Undefined + defaultRootResolver + { queryResolver = Query {characters = resolveCharacters} } api :: GQLRequest -> IO GQLResponse diff --git a/test/Feature/Inference/TypeInference.hs b/test/Feature/Inference/TypeInference.hs --- a/test/Feature/Inference/TypeInference.hs +++ b/test/Feature/Inference/TypeInference.hs @@ -10,13 +10,15 @@ ) where +import Data.Kind (Type) import Data.Morpheus (interpreter) import Data.Morpheus.Types ( GQLRequest, GQLResponse, GQLType (..), RootResolver (..), - Undefined (..), + Undefined, + defaultRootResolver, ) import Data.Text ( Text, @@ -30,7 +32,7 @@ | Hurricanes deriving (Generic, GQLType) -data Deity (m :: * -> *) = Deity +data Deity (m :: Type -> Type) = Deity { name :: Text, power :: Power } @@ -51,7 +53,7 @@ | UnidentifiedMonster deriving (Show, Generic, GQLType) -data Character (m :: * -> *) +data Character (m :: Type -> Type) = CharacterDeity (Deity m) -- Only should generate direct link | Creature {creatureName :: Text, creatureAge :: Int} | BoxedDeity {boxedDeity :: Deity m} @@ -81,7 +83,7 @@ } deriving (Show, Generic, GQLType) -data Query (m :: * -> *) = Query +data Query (m :: Type -> Type) = Query { deity :: Deity m, character :: [Character m], showMonster :: MonsterArgs -> m Text @@ -90,15 +92,13 @@ rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver = - RootResolver + defaultRootResolver { queryResolver = Query { deity = deityRes, character = resolveCharacter, showMonster - }, - mutationResolver = Undefined, - subscriptionResolver = Undefined + } } where showMonster MonsterArgs {monster} = pure (pack $ show monster) diff --git a/test/Feature/Inference/UnionType.hs b/test/Feature/Inference/UnionType.hs --- a/test/Feature/Inference/UnionType.hs +++ b/test/Feature/Inference/UnionType.hs @@ -15,7 +15,8 @@ GQLType (..), ResolverQ, RootResolver (..), - Undefined (..), + Undefined, + defaultRootResolver, ) import Data.Text (Text) import GHC.Generics (Generic) @@ -44,25 +45,23 @@ deriving (Generic, GQLType) data Query m = Query - { union :: () -> m [Sum], + { union :: m [Sum], fc :: C } deriving (Generic, GQLType) -resolveUnion :: () -> ResolverQ () IO [Sum] -resolveUnion _ = +resolveUnion :: ResolverQ () IO [Sum] +resolveUnion = return [SumA A {aText = "at", aInt = 1}, SumB B {bText = "bt", bInt = 2}] rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver = - RootResolver + defaultRootResolver { queryResolver = Query { union = resolveUnion, fc = C {cText = "", cInt = 3} - }, - mutationResolver = Undefined, - subscriptionResolver = Undefined + } } api :: GQLRequest -> IO GQLResponse diff --git a/test/Feature/Inference/WrappedType.hs b/test/Feature/Inference/WrappedType.hs --- a/test/Feature/Inference/WrappedType.hs +++ b/test/Feature/Inference/WrappedType.hs @@ -29,7 +29,7 @@ deriving (Generic, GQLType) data WA m = WA - { aText :: () -> m Text, + { aText :: m Text, aInt :: Int } deriving (Generic, GQLType) @@ -58,7 +58,7 @@ type EVENT = Event Channel () -data Subscription (m :: * -> *) = Subscription +data Subscription (m :: Type -> Type) = Subscription { sub1 :: SubscriptionField (m (Maybe (WA m))), sub2 :: SubscriptionField (m (Maybe Wrapped1)), sub3 :: SubscriptionField (m (Maybe Wrapped2)) @@ -68,7 +68,7 @@ rootResolver :: RootResolver IO EVENT Query Mutation Subscription rootResolver = RootResolver - { queryResolver = Query {a1 = WA {aText = const $ pure "test1", aInt = 0}, a2 = Nothing, a3 = Nothing}, + { queryResolver = Query {a1 = WA {aText = pure "test1", aInt = 0}, a2 = Nothing, a3 = Nothing}, mutationResolver = Mutation {mut1 = Nothing, mut2 = Nothing, mut3 = Nothing}, subscriptionResolver = Subscription diff --git a/test/Feature/Inference/object-and-enum/introspection/query.gql b/test/Feature/Inference/object-and-enum/introspection/query.gql new file mode 100644 --- /dev/null +++ b/test/Feature/Inference/object-and-enum/introspection/query.gql @@ -0,0 +1,79 @@ +query Get__Type { + enum: __type(name: "MyEnum") { + ...FullType + } + object: __type(name: "MyObject") { + ...FullType + } +} + +fragment FullType on __Type { + kind + name + fields(includeDeprecated: true) { + name + args { + ...InputValue + } + type { + ...TypeRef + } + isDeprecated + deprecationReason + } + inputFields { + ...InputValue + } + interfaces { + ...TypeRef + } + enumValues(includeDeprecated: true) { + name + isDeprecated + deprecationReason + } + possibleTypes { + ...TypeRef + } +} + +fragment InputValue on __InputValue { + name + type { + ...TypeRef + } + defaultValue +} + +fragment TypeRef on __Type { + kind + name + ofType { + kind + name + ofType { + kind + name + ofType { + kind + name + ofType { + kind + name + ofType { + kind + name + ofType { + kind + name + ofType { + kind + name + } + } + } + } + } + } + } +} diff --git a/test/Feature/Inference/object-and-enum/introspection/response.json b/test/Feature/Inference/object-and-enum/introspection/response.json new file mode 100644 --- /dev/null +++ b/test/Feature/Inference/object-and-enum/introspection/response.json @@ -0,0 +1,44 @@ +{ + "data": { + "enum": { + "enumValues": [ + { + "deprecationReason": null, + "isDeprecated": false, + "name": "MyEnum" + } + ], + "fields": null, + "inputFields": null, + "interfaces": null, + "kind": "ENUM", + "name": "MyEnum", + "possibleTypes": null + }, + "object": { + "enumValues": null, + "fields": [ + { + "args": [], + "deprecationReason": null, + "isDeprecated": false, + "name": "_0", + "type": { + "kind": "NON_NULL", + "name": null, + "ofType": { + "kind": "SCALAR", + "name": "Int", + "ofType": null + } + } + } + ], + "inputFields": null, + "interfaces": [], + "kind": "OBJECT", + "name": "MyObject", + "possibleTypes": null + } + } +} diff --git a/test/Feature/Inference/object-and-enum/resolving/query.gql b/test/Feature/Inference/object-and-enum/resolving/query.gql new file mode 100644 --- /dev/null +++ b/test/Feature/Inference/object-and-enum/resolving/query.gql @@ -0,0 +1,7 @@ +{ + enum + object { + _0 + __typename + } +} diff --git a/test/Feature/Inference/object-and-enum/resolving/response.json b/test/Feature/Inference/object-and-enum/resolving/response.json new file mode 100644 --- /dev/null +++ b/test/Feature/Inference/object-and-enum/resolving/response.json @@ -0,0 +1,6 @@ +{ + "data": { + "enum": "MyEnum", + "object": { "_0": 0, "__typename": "MyObject" } + } +} diff --git a/test/Feature/Input/Collections.hs b/test/Feature/Input/Collections.hs --- a/test/Feature/Input/Collections.hs +++ b/test/Feature/Input/Collections.hs @@ -18,16 +18,14 @@ GQLResponse, GQLType (..), GQLTypeOptions (..), - GQLTypeOptions (..), RootResolver (..), - Undefined (..), - render, + Undefined, + defaultRootResolver, ) import Data.Sequence (Seq) import Data.Set (Set) import Data.Text import Data.Vector (Vector) -import Debug.Trace (traceShow) import GHC.Generics (Generic) -- query @@ -60,7 +58,7 @@ rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver = - RootResolver + defaultRootResolver { queryResolver = Query { testSet = testRes, @@ -71,9 +69,7 @@ testProduct = testRes, testMap = testRes, testAssoc = testRes - }, - mutationResolver = Undefined, - subscriptionResolver = Undefined + } } app :: App () IO diff --git a/test/Feature/Input/DefaultValues.hs b/test/Feature/Input/DefaultValues.hs --- a/test/Feature/Input/DefaultValues.hs +++ b/test/Feature/Input/DefaultValues.hs @@ -23,7 +23,8 @@ GQLResponse, ID (..), RootResolver (..), - Undefined (..), + Undefined, + defaultRootResolver, ) import Data.Text (Text, pack) @@ -31,19 +32,17 @@ rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver = - RootResolver - { queryResolver = Query {user, testSimple}, - mutationResolver = Undefined, - subscriptionResolver = Undefined + defaultRootResolver + { queryResolver = Query {user, testSimple} } where user :: Applicative m => m (Maybe (User m)) user = - pure - $ Just - $ User - { inputs = pure . pack . show - } + pure $ + Just $ + User + { inputs = pure . pack . show + } testSimple = pure . pack . show ----------------------------------- diff --git a/test/Feature/Input/Enums.hs b/test/Feature/Input/Enums.hs --- a/test/Feature/Input/Enums.hs +++ b/test/Feature/Input/Enums.hs @@ -9,7 +9,14 @@ where import Data.Morpheus (interpreter) -import Data.Morpheus.Types (GQLRequest, GQLResponse, GQLType (..), RootResolver (..), Undefined (..)) +import Data.Morpheus.Types + ( GQLRequest, + GQLResponse, + GQLType (..), + RootResolver (..), + Undefined, + defaultRootResolver, + ) import GHC.Generics (Generic) data TwoCon @@ -53,10 +60,8 @@ rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver = - RootResolver - { queryResolver = Query {test = testRes, test2 = testRes, test3 = testRes}, - mutationResolver = Undefined, - subscriptionResolver = Undefined + defaultRootResolver + { queryResolver = Query {test = testRes, test2 = testRes, test3 = testRes} } api :: GQLRequest -> IO GQLResponse diff --git a/test/Feature/Input/Objects.hs b/test/Feature/Input/Objects.hs --- a/test/Feature/Input/Objects.hs +++ b/test/Feature/Input/Objects.hs @@ -14,7 +14,8 @@ GQLResponse, GQLType (..), RootResolver (..), - Undefined (..), + Undefined, + defaultRootResolver, ) import Data.Text ( Text, @@ -47,10 +48,8 @@ rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver = - RootResolver - { queryResolver = Query {input = testRes}, - mutationResolver = Undefined, - subscriptionResolver = Undefined + defaultRootResolver + { queryResolver = Query {input = testRes} } api :: GQLRequest -> IO GQLResponse diff --git a/test/Feature/Input/Scalars.hs b/test/Feature/Input/Scalars.hs --- a/test/Feature/Input/Scalars.hs +++ b/test/Feature/Input/Scalars.hs @@ -14,7 +14,8 @@ GQLResponse, GQLType, RootResolver (..), - Undefined (..), + Undefined, + defaultRootResolver, ) import Data.Text (Text) import GHC.Generics (Generic) @@ -39,15 +40,13 @@ rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver = - RootResolver + defaultRootResolver { queryResolver = Query { testFloat = testRes, testInt = testRes, testString = testRes - }, - mutationResolver = Undefined, - subscriptionResolver = Undefined + } } api :: GQLRequest -> IO GQLResponse diff --git a/test/Feature/Input/Variables.hs b/test/Feature/Input/Variables.hs --- a/test/Feature/Input/Variables.hs +++ b/test/Feature/Input/Variables.hs @@ -8,6 +8,7 @@ ) where +import Data.Kind (Type) import Data.Morpheus (interpreter) import Data.Morpheus.Types ( GQLRequest, @@ -15,7 +16,8 @@ GQLType (..), ResolverQ, RootResolver (..), - Undefined (..), + Undefined, + defaultRootResolver, ) import Data.Text (Text) import GHC.Generics (Generic) @@ -38,14 +40,14 @@ } deriving (Generic, GQLType) -newtype Query (m :: * -> *) = Query +newtype Query (m :: Type -> Type) = Query { q1 :: A } deriving (Generic, GQLType) rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver = - RootResolver + defaultRootResolver { queryResolver = Query { q1 = @@ -53,9 +55,7 @@ { a1 = const $ return "a1Test", a2 = const $ return 1 } - }, - mutationResolver = Undefined, - subscriptionResolver = Undefined + } } api :: GQLRequest -> IO GQLResponse diff --git a/test/Rendering/Schema.hs b/test/Rendering/Schema.hs --- a/test/Rendering/Schema.hs +++ b/test/Rendering/Schema.hs @@ -34,7 +34,7 @@ importGQLDocumentWithNamespace "test/Rendering/schema.gql" -type APIResolver e (m :: * -> *) = +type APIResolver e (m :: Type -> Type) = RootResolver m e MyQuery MyMutation Undefined proxy :: Proxy (APIResolver () IO) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -12,6 +12,7 @@ import qualified Feature.Collision.CategoryCollisionSuccess as TypeCategoryCollisionSuccess import qualified Feature.Collision.NameCollision as NameCollision import qualified Feature.Holistic.API as Holistic +import qualified Feature.Inference.ObjectAndEnum as ObjectAndEnum import qualified Feature.Inference.TaggedArguments as TaggedArguments import qualified Feature.Inference.TaggedArgumentsFail as TaggedArgumentsFail import qualified Feature.Inference.TypeGuards as TypeGuards @@ -80,7 +81,8 @@ (UnionType.api, "union-type"), (TypeInference.api, "type-inference"), (TaggedArguments.api, "tagged-arguments"), - (TaggedArgumentsFail.api, "tagged-arguments-fail") + (TaggedArgumentsFail.api, "tagged-arguments-fail"), + (ObjectAndEnum.api, "object-and-enum") ], testFeatures "Holistic"