Draft the Validation API
This commit is contained in:
@ -129,10 +129,11 @@ spec = describe "Parser" $ do
|
||||
|
||||
it "parses schema extension with an operation type and directive" $
|
||||
let newDirective = Directive "newDirective" []
|
||||
testSchemaExtension = TypeSystemExtension
|
||||
$ SchemaExtension
|
||||
schemaExtension = SchemaExtension
|
||||
$ SchemaOperationExtension [newDirective]
|
||||
$ OperationTypeDefinition Query "Query" :| []
|
||||
testSchemaExtension = TypeSystemExtension schemaExtension
|
||||
$ Location 1 1
|
||||
query = [r|extend schema @newDirective { query: Query }|]
|
||||
in parse document "" query `shouldParse` (testSchemaExtension :| [])
|
||||
|
||||
|
||||
171
tests/Language/GraphQL/ValidateSpec.hs
Normal file
171
tests/Language/GraphQL/ValidateSpec.hs
Normal file
@ -0,0 +1,171 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Language.GraphQL.ValidateSpec
|
||||
( spec
|
||||
) where
|
||||
|
||||
import Data.Sequence (Seq(..))
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Text (Text)
|
||||
import qualified Language.GraphQL.AST as AST
|
||||
import Language.GraphQL.Type
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Language.GraphQL.Validate
|
||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||
import Text.Megaparsec (parse)
|
||||
import Text.RawString.QQ (r)
|
||||
|
||||
schema :: Schema IO
|
||||
schema = Schema
|
||||
{ query = queryType
|
||||
, mutation = Nothing
|
||||
, subscription = Nothing
|
||||
}
|
||||
|
||||
queryType :: ObjectType IO
|
||||
queryType = ObjectType "Query" Nothing []
|
||||
$ HashMap.singleton "dog" dogResolver
|
||||
where
|
||||
dogField = Field Nothing (Out.NamedObjectType dogType) mempty
|
||||
dogResolver = ValueResolver dogField $ pure Null
|
||||
|
||||
dogCommandType :: EnumType
|
||||
dogCommandType = EnumType "DogCommand" Nothing $ HashMap.fromList
|
||||
[ ("SIT", EnumValue Nothing)
|
||||
, ("DOWN", EnumValue Nothing)
|
||||
, ("HEEL", EnumValue Nothing)
|
||||
]
|
||||
|
||||
dogType :: ObjectType IO
|
||||
dogType = ObjectType "Dog" Nothing [petType] $ HashMap.fromList
|
||||
[ ("name", nameResolver)
|
||||
, ("nickname", nicknameResolver)
|
||||
, ("barkVolume", barkVolumeResolver)
|
||||
, ("doesKnowCommand", doesKnowCommandResolver)
|
||||
, ("isHousetrained", isHousetrainedResolver)
|
||||
, ("owner", ownerResolver)
|
||||
]
|
||||
where
|
||||
nameField = Field Nothing (Out.NonNullScalarType string) mempty
|
||||
nameResolver = ValueResolver nameField $ pure "Name"
|
||||
nicknameField = Field Nothing (Out.NamedScalarType string) mempty
|
||||
nicknameResolver = ValueResolver nicknameField $ pure "Nickname"
|
||||
barkVolumeField = Field Nothing (Out.NamedScalarType int) mempty
|
||||
barkVolumeResolver = ValueResolver barkVolumeField $ pure $ Int 3
|
||||
doesKnowCommandField = Field Nothing (Out.NonNullScalarType boolean)
|
||||
$ HashMap.singleton "dogCommand"
|
||||
$ In.Argument Nothing (In.NonNullEnumType dogCommandType) Nothing
|
||||
doesKnowCommandResolver = ValueResolver doesKnowCommandField
|
||||
$ pure $ Boolean True
|
||||
isHousetrainedField = Field Nothing (Out.NonNullScalarType boolean)
|
||||
$ HashMap.singleton "atOtherHomes"
|
||||
$ In.Argument Nothing (In.NamedScalarType boolean) Nothing
|
||||
isHousetrainedResolver = ValueResolver isHousetrainedField
|
||||
$ pure $ Boolean True
|
||||
ownerField = Field Nothing (Out.NamedObjectType humanType) mempty
|
||||
ownerResolver = ValueResolver ownerField $ pure Null
|
||||
|
||||
sentientType :: InterfaceType IO
|
||||
sentientType = InterfaceType "Sentient" Nothing []
|
||||
$ HashMap.singleton "name"
|
||||
$ Field Nothing (Out.NonNullScalarType string) mempty
|
||||
|
||||
petType :: InterfaceType IO
|
||||
petType = InterfaceType "Pet" Nothing []
|
||||
$ HashMap.singleton "name"
|
||||
$ Field Nothing (Out.NonNullScalarType string) mempty
|
||||
{-
|
||||
alienType :: ObjectType IO
|
||||
alienType = ObjectType "Alien" Nothing [sentientType] $ HashMap.fromList
|
||||
[ ("name", nameResolver)
|
||||
, ("homePlanet", homePlanetResolver)
|
||||
]
|
||||
where
|
||||
nameField = Field Nothing (Out.NonNullScalarType string) mempty
|
||||
nameResolver = ValueResolver nameField $ pure "Name"
|
||||
homePlanetField =
|
||||
Field Nothing (Out.NamedScalarType string) mempty
|
||||
homePlanetResolver = ValueResolver homePlanetField $ pure "Home planet"
|
||||
-}
|
||||
humanType :: ObjectType IO
|
||||
humanType = ObjectType "Human" Nothing [sentientType] $ HashMap.fromList
|
||||
[ ("name", nameResolver)
|
||||
, ("pets", petsResolver)
|
||||
]
|
||||
where
|
||||
nameField = Field Nothing (Out.NonNullScalarType string) mempty
|
||||
nameResolver = ValueResolver nameField $ pure "Name"
|
||||
petsField =
|
||||
Field Nothing (Out.ListType $ Out.NonNullInterfaceType petType) mempty
|
||||
petsResolver = ValueResolver petsField $ pure $ List []
|
||||
{-
|
||||
catCommandType :: EnumType
|
||||
catCommandType = EnumType "CatCommand" Nothing $ HashMap.fromList
|
||||
[ ("JUMP", EnumValue Nothing)
|
||||
]
|
||||
|
||||
catType :: ObjectType IO
|
||||
catType = ObjectType "Cat" Nothing [petType] $ HashMap.fromList
|
||||
[ ("name", nameResolver)
|
||||
, ("nickname", nicknameResolver)
|
||||
, ("doesKnowCommand", doesKnowCommandResolver)
|
||||
, ("meowVolume", meowVolumeResolver)
|
||||
]
|
||||
where
|
||||
nameField = Field Nothing (Out.NonNullScalarType string) mempty
|
||||
nameResolver = ValueResolver nameField $ pure "Name"
|
||||
nicknameField = Field Nothing (Out.NamedScalarType string) mempty
|
||||
nicknameResolver = ValueResolver nicknameField $ pure "Nickname"
|
||||
doesKnowCommandField = Field Nothing (Out.NonNullScalarType boolean)
|
||||
$ HashMap.singleton "catCommand"
|
||||
$ In.Argument Nothing (In.NonNullEnumType catCommandType) Nothing
|
||||
doesKnowCommandResolver = ValueResolver doesKnowCommandField
|
||||
$ pure $ Boolean True
|
||||
meowVolumeField = Field Nothing (Out.NamedScalarType int) mempty
|
||||
meowVolumeResolver = ValueResolver meowVolumeField $ pure $ Int 2
|
||||
|
||||
catOrDogType :: UnionType IO
|
||||
catOrDogType = UnionType "CatOrDog" Nothing [catType, dogType]
|
||||
|
||||
dogOrHumanType :: UnionType IO
|
||||
dogOrHumanType = UnionType "DogOrHuman" Nothing [dogType, humanType]
|
||||
|
||||
humanOrAlienType :: UnionType IO
|
||||
humanOrAlienType = UnionType "HumanOrAlien" Nothing [humanType, alienType]
|
||||
-}
|
||||
validate :: Text -> Seq Error
|
||||
validate queryString =
|
||||
case parse AST.document "" queryString of
|
||||
Left _ -> Seq.empty
|
||||
Right ast -> document schema specifiedRules ast
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "document" $
|
||||
it "rejects type definitions" $
|
||||
let queryString = [r|
|
||||
query getDogName {
|
||||
dog {
|
||||
name
|
||||
color
|
||||
}
|
||||
}
|
||||
|
||||
extend type Dog {
|
||||
color: String
|
||||
}
|
||||
|]
|
||||
expected = Error
|
||||
{ message =
|
||||
"Definition must be OperationDefinition or FragmentDefinition."
|
||||
, locations = [AST.Location 9 15]
|
||||
, path = []
|
||||
}
|
||||
in validate queryString `shouldBe` Seq.singleton expected
|
||||
Reference in New Issue
Block a user