diff --git a/.circleci/config.yml b/.circleci/config.yml index 7cd53f6..7baecc4 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -28,5 +28,8 @@ jobs: - /root/.stack - .stack-work - run: + # Build with --pedantic here to avoid introducing warnings. We + # *don't* build with -Werror on Hackage as that is strongly + # discouraged. name: Tests - command: stack test --skip-ghc-check --no-terminal + command: stack test --skip-ghc-check --no-terminal --pedantic diff --git a/src/GraphQL/API.hs b/src/GraphQL/API.hs index 2094f84..d7a6bdf 100644 --- a/src/GraphQL/API.hs +++ b/src/GraphQL/API.hs @@ -34,9 +34,8 @@ module GraphQL.API import Protolude hiding (Enum, TypeError) -import GraphQL.Internal.Schema hiding (Type) -import qualified GraphQL.Internal.Schema (Type) import GHC.TypeLits (Symbol, KnownSymbol, TypeError, ErrorMessage(..)) +import qualified GraphQL.Internal.Schema as Schema import GraphQL.Internal.Name (NameError, nameFromSymbol) import GraphQL.API.Enum (GraphQLEnum(..)) import GHC.Generics ((:*:)(..)) @@ -95,15 +94,15 @@ cons = (:) -- Transform into a Schema definition class HasObjectDefinition a where -- Todo rename to getObjectTypeDefinition - getDefinition :: Either NameError ObjectTypeDefinition + getDefinition :: Either NameError Schema.ObjectTypeDefinition class HasFieldDefinition a where - getFieldDefinition :: Either NameError FieldDefinition + getFieldDefinition :: Either NameError Schema.FieldDefinition -- Fields class HasFieldDefinitions a where - getFieldDefinitions :: Either NameError [FieldDefinition] + getFieldDefinitions :: Either NameError [Schema.FieldDefinition] instance forall a as. (HasFieldDefinition a, HasFieldDefinitions as) => HasFieldDefinitions (a:as) where getFieldDefinitions = cons <$> getFieldDefinition @a <*> getFieldDefinitions @as @@ -116,7 +115,7 @@ instance HasFieldDefinitions '[] where -- Union "Horse" '[Leg, Head, Tail] -- ^^^^^^^^^^^^^^^^^^ this part class UnionTypeObjectTypeDefinitionList a where - getUnionTypeObjectTypeDefinitions :: Either NameError [ObjectTypeDefinition] + getUnionTypeObjectTypeDefinitions :: Either NameError [Schema.ObjectTypeDefinition] instance forall a as. (HasObjectDefinition a, UnionTypeObjectTypeDefinitionList as) => UnionTypeObjectTypeDefinitionList (a:as) where getUnionTypeObjectTypeDefinitions = cons <$> getDefinition @a <*> getUnionTypeObjectTypeDefinitions @as @@ -126,7 +125,7 @@ instance UnionTypeObjectTypeDefinitionList '[] where -- Interfaces class HasInterfaceDefinitions a where - getInterfaceDefinitions :: Either NameError Interfaces + getInterfaceDefinitions :: Either NameError Schema.Interfaces instance forall a as. (HasInterfaceDefinition a, HasInterfaceDefinitions as) => HasInterfaceDefinitions (a:as) where getInterfaceDefinitions = cons <$> getInterfaceDefinition @a <*> getInterfaceDefinitions @as @@ -135,35 +134,35 @@ instance HasInterfaceDefinitions '[] where getInterfaceDefinitions = pure [] class HasInterfaceDefinition a where - getInterfaceDefinition :: Either NameError InterfaceTypeDefinition + getInterfaceDefinition :: Either NameError Schema.InterfaceTypeDefinition instance forall ks fields. (KnownSymbol ks, HasFieldDefinitions fields) => HasInterfaceDefinition (Interface ks fields) where getInterfaceDefinition = let name = nameFromSymbol @ks - fields = NonEmptyList <$> getFieldDefinitions @fields - in InterfaceTypeDefinition <$> name <*> fields + fields = Schema.NonEmptyList <$> getFieldDefinitions @fields + in Schema.InterfaceTypeDefinition <$> name <*> fields -- Give users some help if they don't terminate Arguments with a Field: -- NB the "redundant constraints" warning is a GHC bug: https://ghc.haskell.org/trac/ghc/ticket/11099 instance forall ks t. TypeError ('Text ":> Arguments must end with a Field") => HasFieldDefinition (Argument ks t) where - getFieldDefinition = notImplemented + getFieldDefinition = panic ":> Arugments must end with a Field. This should not happen, but rather we'll get a compile-time error instead." instance forall ks is ts. (KnownSymbol ks, HasInterfaceDefinitions is, HasFieldDefinitions ts) => HasAnnotatedType (Object ks is ts) where getAnnotatedType = let obj = getDefinition @(Object ks is ts) - in (TypeNamed . DefinedType . TypeDefinitionObject) <$> obj + in (Schema.TypeNamed . Schema.DefinedType . Schema.TypeDefinitionObject) <$> obj instance forall t ks. (KnownSymbol ks, HasAnnotatedType t) => HasFieldDefinition (Field ks t) where getFieldDefinition = let name = nameFromSymbol @ks - in FieldDefinition <$> name <*> pure [] <*> getAnnotatedType @t + in Schema.FieldDefinition <$> name <*> pure [] <*> getAnnotatedType @t class HasArgumentDefinition a where - getArgumentDefinition :: Either NameError ArgumentDefinition + getArgumentDefinition :: Either NameError Schema.ArgumentDefinition instance forall ks t. (KnownSymbol ks, HasAnnotatedInputType t) => HasArgumentDefinition (Argument ks t) where - getArgumentDefinition = ArgumentDefinition <$> argName <*> argType <*> defaultValue + getArgumentDefinition = Schema.ArgumentDefinition <$> argName <*> argType <*> defaultValue where argName = nameFromSymbol @ks argType = getAnnotatedInputType @t @@ -173,7 +172,7 @@ instance forall a b. (HasArgumentDefinition a, HasFieldDefinition b) => HasField getFieldDefinition = prependArg <$> argument <*> getFieldDefinition @b where - prependArg arg (FieldDefinition name argDefs at) = FieldDefinition name (arg:argDefs) at + prependArg arg (Schema.FieldDefinition name argDefs at) = Schema.FieldDefinition name (arg:argDefs) at argument = getArgumentDefinition @a instance forall ks is fields. @@ -182,8 +181,8 @@ instance forall ks is fields. getDefinition = let name = nameFromSymbol @ks interfaces = getInterfaceDefinitions @is - fields = NonEmptyList <$> getFieldDefinitions @fields - in ObjectTypeDefinition <$> name <*> interfaces <*> fields + fields = Schema.NonEmptyList <$> getFieldDefinitions @fields + in Schema.ObjectTypeDefinition <$> name <*> interfaces <*> fields -- Builtin output types (annotated types) class HasAnnotatedType a where @@ -192,21 +191,21 @@ class HasAnnotatedType a where -- forget this. Maybe we can flip the internal encoding to be -- non-null by default and needing explicit null-encoding (via -- Maybe). - getAnnotatedType :: Either NameError (AnnotatedType GraphQL.Internal.Schema.Type) + getAnnotatedType :: Either NameError (Schema.AnnotatedType Schema.GType) -- | Turn a non-null type into the optional version of its own type. -dropNonNull :: AnnotatedType t -> AnnotatedType t -dropNonNull (TypeNonNull (NonNullTypeNamed t)) = TypeNamed t -dropNonNull (TypeNonNull (NonNullTypeList t)) = TypeList t -dropNonNull x@(TypeNamed _) = x -dropNonNull x@(TypeList _) = x +dropNonNull :: Schema.AnnotatedType t -> Schema.AnnotatedType t +dropNonNull (Schema.TypeNonNull (Schema.NonNullTypeNamed t)) = Schema.TypeNamed t +dropNonNull (Schema.TypeNonNull (Schema.NonNullTypeList t)) = Schema.TypeList t +dropNonNull x@(Schema.TypeNamed _) = x +dropNonNull x@(Schema.TypeList _) = x instance forall a. HasAnnotatedType a => HasAnnotatedType (Maybe a) where -- see TODO in HasAnnotatedType class getAnnotatedType = dropNonNull <$> getAnnotatedType @a -builtinType :: Builtin -> Either NameError (AnnotatedType GraphQL.Internal.Schema.Type) -builtinType = pure . TypeNonNull . NonNullTypeNamed . BuiltinType +builtinType :: Schema.Builtin -> Either NameError (Schema.AnnotatedType Schema.GType) +builtinType = pure . Schema.TypeNonNull . Schema.NonNullTypeNamed . Schema.BuiltinType -- TODO(jml): Given that AnnotatedType is parametrised, we can probably reduce -- a great deal of duplication by making HasAnnotatedType a parametrised type @@ -216,93 +215,93 @@ builtinType = pure . TypeNonNull . NonNullTypeNamed . BuiltinType -- than listing each individually. instance HasAnnotatedType Int where - getAnnotatedType = builtinType GInt + getAnnotatedType = builtinType Schema.GInt instance HasAnnotatedType Int32 where - getAnnotatedType = builtinType GInt + getAnnotatedType = builtinType Schema.GInt instance HasAnnotatedType Bool where - getAnnotatedType = builtinType GBool + getAnnotatedType = builtinType Schema.GBool instance HasAnnotatedType Text where - getAnnotatedType = builtinType GString + getAnnotatedType = builtinType Schema.GString instance HasAnnotatedType Double where - getAnnotatedType = builtinType GFloat + getAnnotatedType = builtinType Schema.GFloat instance HasAnnotatedType Float where - getAnnotatedType = builtinType GFloat + getAnnotatedType = builtinType Schema.GFloat instance forall t. (HasAnnotatedType t) => HasAnnotatedType (List t) where - getAnnotatedType = TypeList . ListType <$> getAnnotatedType @t + getAnnotatedType = Schema.TypeList . Schema.ListType <$> getAnnotatedType @t instance forall ks enum. (KnownSymbol ks, GraphQLEnum enum) => HasAnnotatedType (Enum ks enum) where getAnnotatedType = do let name = nameFromSymbol @ks - let enums = sequenceA (enumValues @enum) :: Either NameError [Name] - let et = EnumTypeDefinition <$> name <*> map (map EnumValueDefinition) enums - TypeNonNull . NonNullTypeNamed . DefinedType . TypeDefinitionEnum <$> et + let enums = sequenceA (enumValues @enum) :: Either NameError [Schema.Name] + let et = Schema.EnumTypeDefinition <$> name <*> map (map Schema.EnumValueDefinition) enums + Schema.TypeNonNull . Schema.NonNullTypeNamed . Schema.DefinedType . Schema.TypeDefinitionEnum <$> et instance forall ks as. (KnownSymbol ks, UnionTypeObjectTypeDefinitionList as) => HasAnnotatedType (Union ks as) where getAnnotatedType = let name = nameFromSymbol @ks - types = NonEmptyList <$> getUnionTypeObjectTypeDefinitions @as - in (TypeNamed . DefinedType . TypeDefinitionUnion) <$> (UnionTypeDefinition <$> name <*> types) + types = Schema.NonEmptyList <$> getUnionTypeObjectTypeDefinitions @as + in (Schema.TypeNamed . Schema.DefinedType . Schema.TypeDefinitionUnion) <$> (Schema.UnionTypeDefinition <$> name <*> types) -- Help users with better type errors instance TypeError ('Text "Cannot encode Integer because it has arbitrary size but the JSON encoding is a number") => HasAnnotatedType Integer where - getAnnotatedType = undefined + getAnnotatedType = panic "Cannot encode Integer into JSON due to its arbitrary size. Should get a compile-time error instead of this." -- Builtin input types class HasAnnotatedInputType a where -- See TODO comment in "HasAnnotatedType" class for nullability. - getAnnotatedInputType :: Either NameError (AnnotatedType InputType) - default getAnnotatedInputType :: (Generic a, GenericAnnotatedInputType (Rep a)) => Either NameError (AnnotatedType InputType) + getAnnotatedInputType :: Either NameError (Schema.AnnotatedType Schema.InputType) + default getAnnotatedInputType :: (Generic a, GenericAnnotatedInputType (Rep a)) => Either NameError (Schema.AnnotatedType Schema.InputType) getAnnotatedInputType = genericGetAnnotatedInputType @(Rep a) instance forall a. HasAnnotatedInputType a => HasAnnotatedInputType (Maybe a) where getAnnotatedInputType = dropNonNull <$> getAnnotatedInputType @a -builtinInputType :: Builtin -> Either NameError (AnnotatedType InputType) -builtinInputType = pure . TypeNonNull . NonNullTypeNamed . BuiltinInputType +builtinInputType :: Schema.Builtin -> Either NameError (Schema.AnnotatedType Schema.InputType) +builtinInputType = pure . Schema.TypeNonNull . Schema.NonNullTypeNamed . Schema.BuiltinInputType instance HasAnnotatedInputType Int where - getAnnotatedInputType = builtinInputType GInt + getAnnotatedInputType = builtinInputType Schema.GInt instance HasAnnotatedInputType Int32 where - getAnnotatedInputType = builtinInputType GInt + getAnnotatedInputType = builtinInputType Schema.GInt instance HasAnnotatedInputType Bool where - getAnnotatedInputType = builtinInputType GBool + getAnnotatedInputType = builtinInputType Schema.GBool instance HasAnnotatedInputType Text where - getAnnotatedInputType = builtinInputType GString + getAnnotatedInputType = builtinInputType Schema.GString instance HasAnnotatedInputType Double where - getAnnotatedInputType = builtinInputType GFloat + getAnnotatedInputType = builtinInputType Schema.GFloat instance HasAnnotatedInputType Float where - getAnnotatedInputType = builtinInputType GFloat + getAnnotatedInputType = builtinInputType Schema.GFloat instance forall t. (HasAnnotatedInputType t) => HasAnnotatedInputType (List t) where - getAnnotatedInputType = TypeList . ListType <$> getAnnotatedInputType @t + getAnnotatedInputType = Schema.TypeList . Schema.ListType <$> getAnnotatedInputType @t instance forall ks enum. (KnownSymbol ks, GraphQLEnum enum) => HasAnnotatedInputType (Enum ks enum) where getAnnotatedInputType = do let name = nameFromSymbol @ks - enums = sequenceA (enumValues @enum) :: Either NameError [Name] - let et = EnumTypeDefinition <$> name <*> map (map EnumValueDefinition) enums - TypeNonNull . NonNullTypeNamed . DefinedInputType . InputTypeDefinitionEnum <$> et + enums = sequenceA (enumValues @enum) :: Either NameError [Schema.Name] + let et = Schema.EnumTypeDefinition <$> name <*> map (map Schema.EnumValueDefinition) enums + Schema.TypeNonNull . Schema.NonNullTypeNamed . Schema.DefinedInputType . Schema.InputTypeDefinitionEnum <$> et -- Generic getAnnotatedInputType function class GenericAnnotatedInputType (f :: Type -> Type) where - genericGetAnnotatedInputType :: Either NameError (AnnotatedType InputType) + genericGetAnnotatedInputType :: Either NameError (Schema.AnnotatedType Schema.InputType) class GenericInputObjectFieldDefinitions (f :: Type -> Type) where - genericGetInputObjectFieldDefinitions :: Either NameError [InputObjectFieldDefinition] + genericGetInputObjectFieldDefinitions :: Either NameError [Schema.InputObjectFieldDefinition] instance forall dataName consName records s l p. ( KnownSymbol dataName @@ -313,12 +312,12 @@ instance forall dataName consName records s l p. )) where genericGetAnnotatedInputType = do name <- nameFromSymbol @dataName - map ( TypeNonNull - . NonNullTypeNamed - . DefinedInputType - . InputTypeDefinitionObject - . (InputObjectTypeDefinition name) - . NonEmptyList + map ( Schema.TypeNonNull + . Schema.NonNullTypeNamed + . Schema.DefinedInputType + . Schema.InputTypeDefinitionObject + . (Schema.InputObjectTypeDefinition name) + . Schema.NonEmptyList ) (genericGetInputObjectFieldDefinitions @records) instance forall wrappedType fieldName rest u s l. @@ -329,7 +328,7 @@ instance forall wrappedType fieldName rest u s l. genericGetInputObjectFieldDefinitions = do name <- nameFromSymbol @fieldName annotatedInputType <- getAnnotatedInputType @wrappedType - let l = InputObjectFieldDefinition name annotatedInputType Nothing + let l = Schema.InputObjectFieldDefinition name annotatedInputType Nothing r <- genericGetInputObjectFieldDefinitions @rest pure (l:r) @@ -340,5 +339,5 @@ instance forall wrappedType fieldName u s l. genericGetInputObjectFieldDefinitions = do name <- nameFromSymbol @fieldName annotatedInputType <- getAnnotatedInputType @wrappedType - let l = InputObjectFieldDefinition name annotatedInputType Nothing + let l = Schema.InputObjectFieldDefinition name annotatedInputType Nothing pure [l] diff --git a/src/GraphQL/API/Enum.hs b/src/GraphQL/API/Enum.hs index 9cf3477..c1af662 100644 --- a/src/GraphQL/API/Enum.hs +++ b/src/GraphQL/API/Enum.hs @@ -86,18 +86,20 @@ instance forall conName p b sa sb. ( TypeError ('Text "Constructor not unary: " ':<>: 'Text conName) , KnownSymbol conName ) => GenericEnumValues (C1 ('MetaCons conName p b) (S1 sa sb)) where - genericEnumValues = undefined - genericEnumFromValue = undefined - genericEnumToValue = undefined + genericEnumValues = nonUnaryConstructorError + genericEnumFromValue = nonUnaryConstructorError + genericEnumToValue = nonUnaryConstructorError instance forall conName p b sa sb f. ( TypeError ('Text "Constructor not unary: " ':<>: 'Text conName) , KnownSymbol conName ) => GenericEnumValues (C1 ('MetaCons conName p b) (S1 sa sb) :+: f) where - genericEnumValues = undefined - genericEnumFromValue = undefined - genericEnumToValue = undefined + genericEnumValues = nonUnaryConstructorError + genericEnumFromValue = nonUnaryConstructorError + genericEnumToValue = nonUnaryConstructorError +nonUnaryConstructorError :: a +nonUnaryConstructorError = panic "Tried to construct enum with non-unary constructor. Should get a compile-time error instead of this." -- | For each enum type we need 1) a list of all possible values 2) a -- way to serialise and 3) deserialise. diff --git a/src/GraphQL/Internal/Execution.hs b/src/GraphQL/Internal/Execution.hs index 2203917..266fdab 100644 --- a/src/GraphQL/Internal/Execution.hs +++ b/src/GraphQL/Internal/Execution.hs @@ -32,7 +32,7 @@ import GraphQL.Internal.Validation , VariableDefinition(..) , VariableValue , Variable - , Type(..) + , GType(..) ) -- | Get an operation from a GraphQL document diff --git a/src/GraphQL/Internal/Schema.hs b/src/GraphQL/Internal/Schema.hs index 288f7c5..d05762b 100644 --- a/src/GraphQL/Internal/Schema.hs +++ b/src/GraphQL/Internal/Schema.hs @@ -8,7 +8,7 @@ -- -- Equivalent representation of GraphQL /values/ is in "GraphQL.Value". module GraphQL.Internal.Schema - ( Type(..) + ( GType(..) -- * Builtin types , Builtin(..) -- * Defining new types @@ -40,7 +40,7 @@ module GraphQL.Internal.Schema , lookupType ) where -import Protolude hiding (Type) +import Protolude import qualified Data.Map as Map import GraphQL.Value (Value) @@ -100,13 +100,13 @@ data NonNullType t = NonNullTypeNamed t | NonNullTypeList (ListType t) deriving (Eq, Ord, Show) -data Type = DefinedType TypeDefinition | BuiltinType Builtin deriving (Eq, Ord, Show) +data GType = DefinedType TypeDefinition | BuiltinType Builtin deriving (Eq, Ord, Show) -instance DefinesTypes Type where +instance DefinesTypes GType where getDefinedTypes (BuiltinType _) = mempty getDefinedTypes (DefinedType t) = getDefinedTypes t -instance HasName Type where +instance HasName GType where getName (DefinedType x) = getName x getName (BuiltinType x) = getName x @@ -154,7 +154,7 @@ instance DefinesTypes ObjectTypeDefinition where type Interfaces = [InterfaceTypeDefinition] -data FieldDefinition = FieldDefinition Name [ArgumentDefinition] (AnnotatedType Type) +data FieldDefinition = FieldDefinition Name [ArgumentDefinition] (AnnotatedType GType) deriving (Eq, Ord, Show) instance HasName FieldDefinition where diff --git a/src/GraphQL/Internal/Syntax/AST.hs b/src/GraphQL/Internal/Syntax/AST.hs index 7f5e171..01ecda2 100644 --- a/src/GraphQL/Internal/Syntax/AST.hs +++ b/src/GraphQL/Internal/Syntax/AST.hs @@ -27,7 +27,7 @@ module GraphQL.Internal.Syntax.AST , ObjectField(..) , DefaultValue , Directive(..) - , Type(..) + , GType(..) , NamedType(..) , ListType(..) , NonNullType(..) @@ -46,9 +46,8 @@ module GraphQL.Internal.Syntax.AST , TypeExtensionDefinition(..) ) where -import Protolude hiding (Type) +import Protolude ---import Data.String (IsString(..)) import Test.QuickCheck (Arbitrary(..), listOf, oneof) import GraphQL.Internal.Arbitrary (arbitraryText) @@ -79,11 +78,7 @@ data OperationDefinition data Node = Node (Maybe Name) [VariableDefinition] [Directive] SelectionSet deriving (Eq,Show) --- -getNodeName :: Node -> Maybe Name -getNodeName (Node maybeName _ _ _) = maybeName - -data VariableDefinition = VariableDefinition Variable Type (Maybe DefaultValue) +data VariableDefinition = VariableDefinition Variable GType (Maybe DefaultValue) deriving (Eq,Show) newtype Variable = Variable Name deriving (Eq, Ord, Show) @@ -174,14 +169,14 @@ data Directive = Directive Name [Argument] deriving (Eq,Show) -- * Type Reference -data Type = TypeNamed NamedType - | TypeList ListType - | TypeNonNull NonNullType - deriving (Eq, Ord, Show) +data GType = TypeNamed NamedType + | TypeList ListType + | TypeNonNull NonNullType + deriving (Eq, Ord, Show) newtype NamedType = NamedType Name deriving (Eq, Ord, Show) -newtype ListType = ListType Type deriving (Eq, Ord, Show) +newtype ListType = ListType GType deriving (Eq, Ord, Show) data NonNullType = NonNullTypeNamed NamedType | NonNullTypeList ListType @@ -203,12 +198,12 @@ data ObjectTypeDefinition = ObjectTypeDefinition Name Interfaces [FieldDefinitio type Interfaces = [NamedType] -data FieldDefinition = FieldDefinition Name ArgumentsDefinition Type +data FieldDefinition = FieldDefinition Name ArgumentsDefinition GType deriving (Eq,Show) type ArgumentsDefinition = [InputValueDefinition] -data InputValueDefinition = InputValueDefinition Name Type (Maybe DefaultValue) +data InputValueDefinition = InputValueDefinition Name GType (Maybe DefaultValue) deriving (Eq,Show) data InterfaceTypeDefinition = InterfaceTypeDefinition Name [FieldDefinition] diff --git a/src/GraphQL/Internal/Syntax/Encoder.hs b/src/GraphQL/Internal/Syntax/Encoder.hs index 18fda0f..10ed13e 100644 --- a/src/GraphQL/Internal/Syntax/Encoder.hs +++ b/src/GraphQL/Internal/Syntax/Encoder.hs @@ -138,7 +138,7 @@ directive (AST.Directive name args) = "@" <> unName name <> optempty arguments a -- * Type Reference -type_ :: AST.Type -> Text +type_ :: AST.GType -> Text type_ (AST.TypeNamed (AST.NamedType x)) = unName x type_ (AST.TypeList x) = listType x type_ (AST.TypeNonNull x) = nonNullType x diff --git a/src/GraphQL/Internal/Syntax/Parser.hs b/src/GraphQL/Internal/Syntax/Parser.hs index 1c3d6d0..7cb7024 100644 --- a/src/GraphQL/Internal/Syntax/Parser.hs +++ b/src/GraphQL/Internal/Syntax/Parser.hs @@ -208,7 +208,7 @@ directive = AST.Directive -- * Type Reference -type_ :: Parser AST.Type +type_ :: Parser AST.GType type_ = AST.TypeList <$> listType <|> AST.TypeNonNull <$> nonNullType <|> AST.TypeNamed <$> namedType diff --git a/src/GraphQL/Internal/Validation.hs b/src/GraphQL/Internal/Validation.hs index 0f85092..900dc2e 100644 --- a/src/GraphQL/Internal/Validation.hs +++ b/src/GraphQL/Internal/Validation.hs @@ -44,7 +44,7 @@ module GraphQL.Internal.Validation , VariableDefinition(..) , VariableValue , Variable - , AST.Type(..) + , AST.GType(..) -- * Resolving queries , SelectionSetByType , SelectionSet(..) @@ -624,7 +624,7 @@ validateArguments args = Arguments <$> mapErrors DuplicateArgument (makeMap [(na data VariableDefinition = VariableDefinition { variable :: Variable -- ^ The name of the variable - , variableType :: AST.Type -- ^ The type of the variable + , variableType :: AST.GType -- ^ The type of the variable , defaultValue :: Maybe Value -- ^ An optional default value for the variable } deriving (Eq, Ord, Show) diff --git a/src/GraphQL/Value/FromValue.hs b/src/GraphQL/Value/FromValue.hs index 8cb5bb5..aa80586 100644 --- a/src/GraphQL/Value/FromValue.hs +++ b/src/GraphQL/Value/FromValue.hs @@ -132,4 +132,4 @@ instance forall wrappedType fieldName u s l. instance forall l r m. ( TypeError ('Text "Generic fromValue only works for records with exactly one data constructor.") ) => GenericFromValue (D1 m (l :+: r)) where - genericFromValue = undefined + genericFromValue = panic "genericFromValue cannot be called for records with more than one data constructor. Code that tries will not be compiled." diff --git a/tests/SchemaTests.hs b/tests/SchemaTests.hs index f17423e..1707b38 100644 --- a/tests/SchemaTests.hs +++ b/tests/SchemaTests.hs @@ -27,7 +27,7 @@ import GraphQL.Internal.Schema , AnnotatedType(..) , ListType(..) , UnionTypeDefinition(..) - , Type(..) + , GType(..) , TypeDefinition(..) , NonNullType(..) , Builtin(..) diff --git a/tests/ValidationTests.hs b/tests/ValidationTests.hs index 420c576..25ab059 100644 --- a/tests/ValidationTests.hs +++ b/tests/ValidationTests.hs @@ -31,7 +31,7 @@ dog = "dog" -- | Schema used for these tests. Since none of them do type-level stuff, we -- don't need to define it. schema :: Schema -schema = undefined +schema = panic "schema evaluated. We weren't expecting that." tests :: IO TestTree tests = testSpec "Validation" $ do