Parse repeatable directive definitions
This commit is contained in:
parent
4b5e25a4d8
commit
b40d8a7e1e
@ -9,7 +9,7 @@ and this project adheres to
|
|||||||
## [Unreleased]
|
## [Unreleased]
|
||||||
### Changed
|
### Changed
|
||||||
- `Schema.Directive` is extended to contain a boolean argument, representing
|
- `Schema.Directive` is extended to contain a boolean argument, representing
|
||||||
repeatable directives.
|
repeatable directives. The parser can parse repeatable directive definitions.
|
||||||
|
|
||||||
### Fixed
|
### Fixed
|
||||||
- `gql` quasi quoter recognizeds all GraphQL line endings (CR, LF and CRLF).
|
- `gql` quasi quoter recognizeds all GraphQL line endings (CR, LF and CRLF).
|
||||||
|
@ -405,7 +405,7 @@ data TypeSystemDefinition
|
|||||||
= SchemaDefinition [Directive] (NonEmpty OperationTypeDefinition)
|
= SchemaDefinition [Directive] (NonEmpty OperationTypeDefinition)
|
||||||
| TypeDefinition TypeDefinition
|
| TypeDefinition TypeDefinition
|
||||||
| DirectiveDefinition
|
| DirectiveDefinition
|
||||||
Description Name ArgumentsDefinition (NonEmpty DirectiveLocation)
|
Description Name ArgumentsDefinition Bool (NonEmpty DirectiveLocation)
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
-- ** Type System Extensions
|
-- ** Type System Extensions
|
||||||
|
@ -159,11 +159,12 @@ typeSystemDefinition formatter = \case
|
|||||||
<> optempty (directives formatter) operationDirectives
|
<> optempty (directives formatter) operationDirectives
|
||||||
<> bracesList formatter (operationTypeDefinition formatter) (NonEmpty.toList operationTypeDefinitions')
|
<> bracesList formatter (operationTypeDefinition formatter) (NonEmpty.toList operationTypeDefinitions')
|
||||||
Full.TypeDefinition typeDefinition' -> typeDefinition formatter typeDefinition'
|
Full.TypeDefinition typeDefinition' -> typeDefinition formatter typeDefinition'
|
||||||
Full.DirectiveDefinition description' name' arguments' locations
|
Full.DirectiveDefinition description' name' arguments' repeatable locations
|
||||||
-> description formatter description'
|
-> description formatter description'
|
||||||
<> "@"
|
<> "@"
|
||||||
<> Lazy.Text.fromStrict name'
|
<> Lazy.Text.fromStrict name'
|
||||||
<> argumentsDefinition formatter arguments'
|
<> argumentsDefinition formatter arguments'
|
||||||
|
<> (if repeatable then " repeatable" else mempty)
|
||||||
<> " on"
|
<> " on"
|
||||||
<> pipeList formatter (directiveLocation <$> locations)
|
<> pipeList formatter (directiveLocation <$> locations)
|
||||||
|
|
||||||
|
@ -27,6 +27,7 @@ import Text.Megaparsec
|
|||||||
, unPos
|
, unPos
|
||||||
, (<?>)
|
, (<?>)
|
||||||
)
|
)
|
||||||
|
import Data.Maybe (isJust)
|
||||||
|
|
||||||
-- | Parser for the GraphQL documents.
|
-- | Parser for the GraphQL documents.
|
||||||
document :: Parser Full.Document
|
document :: Parser Full.Document
|
||||||
@ -82,6 +83,7 @@ directiveDefinition description' = Full.DirectiveDefinition description'
|
|||||||
<* at
|
<* at
|
||||||
<*> name
|
<*> name
|
||||||
<*> argumentsDefinition
|
<*> argumentsDefinition
|
||||||
|
<*> (isJust <$> optional (symbol "repeatable"))
|
||||||
<* symbol "on"
|
<* symbol "on"
|
||||||
<*> directiveLocations
|
<*> directiveLocations
|
||||||
<?> "DirectiveDefinition"
|
<?> "DirectiveDefinition"
|
||||||
|
@ -200,7 +200,7 @@ typeSystemDefinition context rule = \case
|
|||||||
directives context rule schemaLocation directives'
|
directives context rule schemaLocation directives'
|
||||||
Full.TypeDefinition typeDefinition' ->
|
Full.TypeDefinition typeDefinition' ->
|
||||||
typeDefinition context rule typeDefinition'
|
typeDefinition context rule typeDefinition'
|
||||||
Full.DirectiveDefinition _ _ arguments' _ ->
|
Full.DirectiveDefinition _ _ arguments' _ _ ->
|
||||||
argumentsDefinition context rule arguments'
|
argumentsDefinition context rule arguments'
|
||||||
|
|
||||||
typeDefinition :: forall m. Validation m -> ApplyRule m Full.TypeDefinition
|
typeDefinition :: forall m. Validation m -> ApplyRule m Full.TypeDefinition
|
||||||
|
@ -12,7 +12,12 @@ import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc
|
|||||||
import Language.GraphQL.AST.Parser
|
import Language.GraphQL.AST.Parser
|
||||||
import Language.GraphQL.TH
|
import Language.GraphQL.TH
|
||||||
import Test.Hspec (Spec, describe, it, context)
|
import Test.Hspec (Spec, describe, it, context)
|
||||||
import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
|
import Test.Hspec.Megaparsec
|
||||||
|
( shouldParse
|
||||||
|
, shouldFailOn
|
||||||
|
, parseSatisfies
|
||||||
|
, shouldSucceedOn
|
||||||
|
)
|
||||||
import Text.Megaparsec (parse)
|
import Text.Megaparsec (parse)
|
||||||
import Test.QuickCheck (property, NonEmptyList (..), mapSize)
|
import Test.QuickCheck (property, NonEmptyList (..), mapSize)
|
||||||
import Language.GraphQL.AST.Arbitrary
|
import Language.GraphQL.AST.Arbitrary
|
||||||
@ -143,19 +148,17 @@ spec = describe "Parser" $ do
|
|||||||
|]
|
|]
|
||||||
|
|
||||||
it "parses two minimal directive definitions" $
|
it "parses two minimal directive definitions" $
|
||||||
let directive nm loc =
|
let directive name' loc = TypeSystemDefinition
|
||||||
TypeSystemDefinition
|
$ DirectiveDefinition
|
||||||
(DirectiveDefinition
|
|
||||||
(Description Nothing)
|
(Description Nothing)
|
||||||
nm
|
name'
|
||||||
(ArgumentsDefinition [])
|
(ArgumentsDefinition [])
|
||||||
(loc :| []))
|
False
|
||||||
example1 =
|
(loc :| [])
|
||||||
directive "example1"
|
example1 = directive "example1"
|
||||||
(DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition)
|
(DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition)
|
||||||
(Location {line = 1, column = 1})
|
(Location {line = 1, column = 1})
|
||||||
example2 =
|
example2 = directive "example2"
|
||||||
directive "example2"
|
|
||||||
(DirLoc.ExecutableDirectiveLocation DirLoc.Field)
|
(DirLoc.ExecutableDirectiveLocation DirLoc.Field)
|
||||||
(Location {line = 2, column = 1})
|
(Location {line = 2, column = 1})
|
||||||
testSchemaExtension = example1 :| [example2]
|
testSchemaExtension = example1 :| [example2]
|
||||||
@ -166,31 +169,26 @@ spec = describe "Parser" $ do
|
|||||||
in parse document "" query `shouldParse` testSchemaExtension
|
in parse document "" query `shouldParse` testSchemaExtension
|
||||||
|
|
||||||
it "parses a directive definition with a default empty list argument" $
|
it "parses a directive definition with a default empty list argument" $
|
||||||
let directive nm loc args =
|
let argumentValue = Just
|
||||||
TypeSystemDefinition
|
|
||||||
(DirectiveDefinition
|
|
||||||
(Description Nothing)
|
|
||||||
nm
|
|
||||||
(ArgumentsDefinition
|
|
||||||
[ InputValueDefinition
|
|
||||||
(Description Nothing)
|
|
||||||
argName
|
|
||||||
argType
|
|
||||||
argValue
|
|
||||||
[]
|
|
||||||
| (argName, argType, argValue) <- args])
|
|
||||||
(loc :| []))
|
|
||||||
defn =
|
|
||||||
directive "test"
|
|
||||||
(DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition)
|
|
||||||
[("foo",
|
|
||||||
TypeList (TypeNamed "String"),
|
|
||||||
Just
|
|
||||||
$ Node (ConstList [])
|
$ Node (ConstList [])
|
||||||
$ Location {line = 1, column = 33})]
|
$ Location{ line = 1, column = 33 }
|
||||||
(Location {line = 1, column = 1})
|
loc = DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition
|
||||||
|
argumentValueDefinition = InputValueDefinition
|
||||||
|
(Description Nothing)
|
||||||
|
"foo"
|
||||||
|
(TypeList (TypeNamed "String"))
|
||||||
|
argumentValue
|
||||||
|
[]
|
||||||
|
definition = DirectiveDefinition
|
||||||
|
(Description Nothing)
|
||||||
|
"test"
|
||||||
|
(ArgumentsDefinition [argumentValueDefinition] )
|
||||||
|
False
|
||||||
|
(loc :| [])
|
||||||
|
directive = TypeSystemDefinition definition
|
||||||
|
$ Location{ line = 1, column = 1 }
|
||||||
query = [gql|directive @test(foo: [String] = []) on FIELD_DEFINITION|]
|
query = [gql|directive @test(foo: [String] = []) on FIELD_DEFINITION|]
|
||||||
in parse document "" query `shouldParse` (defn :| [ ])
|
in parse document "" query `shouldParse` (directive :| [])
|
||||||
|
|
||||||
it "parses schema extension with a new directive" $
|
it "parses schema extension with a new directive" $
|
||||||
parse document "" `shouldSucceedOn`[gql|
|
parse document "" `shouldSucceedOn`[gql|
|
||||||
@ -210,6 +208,13 @@ spec = describe "Parser" $ do
|
|||||||
query = [gql|extend schema @newDirective { query: Query }|]
|
query = [gql|extend schema @newDirective { query: Query }|]
|
||||||
in parse document "" query `shouldParse` (testSchemaExtension :| [])
|
in parse document "" query `shouldParse` (testSchemaExtension :| [])
|
||||||
|
|
||||||
|
it "parses a repeatable directive definition" $
|
||||||
|
let given = [gql|directive @test repeatable on FIELD_DEFINITION|]
|
||||||
|
isRepeatable (TypeSystemDefinition definition' _ :| [])
|
||||||
|
| DirectiveDefinition _ _ _ repeatable _ <- definition' = repeatable
|
||||||
|
isRepeatable _ = False
|
||||||
|
in parse document "" given `parseSatisfies` isRepeatable
|
||||||
|
|
||||||
it "parses an object extension" $
|
it "parses an object extension" $
|
||||||
parse document "" `shouldSucceedOn` [gql|
|
parse document "" `shouldSucceedOn` [gql|
|
||||||
extend type Story {
|
extend type Story {
|
||||||
|
Loading…
Reference in New Issue
Block a user