diff options
| -rw-r--r-- | CHANGELOG.md | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Document.hs | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Encoder.hs | 3 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Parser.hs | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL/Validate.hs | 2 | ||||
| -rw-r--r-- | tests/Language/GraphQL/AST/ParserSpec.hs | 87 |
6 files changed, 53 insertions, 45 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md index 0117b95..c492d22 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,7 +9,7 @@ and this project adheres to ## [Unreleased] ### Changed - `Schema.Directive` is extended to contain a boolean argument, representing - repeatable directives. + repeatable directives. The parser can parse repeatable directive definitions. ### Fixed - `gql` quasi quoter recognizeds all GraphQL line endings (CR, LF and CRLF). diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index 66fc246..f695495 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -405,7 +405,7 @@ data TypeSystemDefinition = SchemaDefinition [Directive] (NonEmpty OperationTypeDefinition) | TypeDefinition TypeDefinition | DirectiveDefinition - Description Name ArgumentsDefinition (NonEmpty DirectiveLocation) + Description Name ArgumentsDefinition Bool (NonEmpty DirectiveLocation) deriving (Eq, Show) -- ** Type System Extensions diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs index 120fb64..afa30de 100644 --- a/src/Language/GraphQL/AST/Encoder.hs +++ b/src/Language/GraphQL/AST/Encoder.hs @@ -159,11 +159,12 @@ typeSystemDefinition formatter = \case <> optempty (directives formatter) operationDirectives <> bracesList formatter (operationTypeDefinition formatter) (NonEmpty.toList operationTypeDefinitions') Full.TypeDefinition typeDefinition' -> typeDefinition formatter typeDefinition' - Full.DirectiveDefinition description' name' arguments' locations + Full.DirectiveDefinition description' name' arguments' repeatable locations -> description formatter description' <> "@" <> Lazy.Text.fromStrict name' <> argumentsDefinition formatter arguments' + <> (if repeatable then " repeatable" else mempty) <> " on" <> pipeList formatter (directiveLocation <$> locations) diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs index 049876e..f325ee7 100644 --- a/src/Language/GraphQL/AST/Parser.hs +++ b/src/Language/GraphQL/AST/Parser.hs @@ -27,6 +27,7 @@ import Text.Megaparsec , unPos , (<?>) ) +import Data.Maybe (isJust) -- | Parser for the GraphQL documents. document :: Parser Full.Document @@ -82,6 +83,7 @@ directiveDefinition description' = Full.DirectiveDefinition description' <* at <*> name <*> argumentsDefinition + <*> (isJust <$> optional (symbol "repeatable")) <* symbol "on" <*> directiveLocations <?> "DirectiveDefinition" diff --git a/src/Language/GraphQL/Validate.hs b/src/Language/GraphQL/Validate.hs index f6f8788..ba00594 100644 --- a/src/Language/GraphQL/Validate.hs +++ b/src/Language/GraphQL/Validate.hs @@ -200,7 +200,7 @@ typeSystemDefinition context rule = \case directives context rule schemaLocation directives' Full.TypeDefinition typeDefinition' -> typeDefinition context rule typeDefinition' - Full.DirectiveDefinition _ _ arguments' _ -> + Full.DirectiveDefinition _ _ arguments' _ _ -> argumentsDefinition context rule arguments' typeDefinition :: forall m. Validation m -> ApplyRule m Full.TypeDefinition diff --git a/tests/Language/GraphQL/AST/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs index 13faa21..80c2663 100644 --- a/tests/Language/GraphQL/AST/ParserSpec.hs +++ b/tests/Language/GraphQL/AST/ParserSpec.hs @@ -12,7 +12,12 @@ import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc import Language.GraphQL.AST.Parser import Language.GraphQL.TH 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 Test.QuickCheck (property, NonEmptyList (..), mapSize) import Language.GraphQL.AST.Arbitrary @@ -143,22 +148,20 @@ spec = describe "Parser" $ do |] it "parses two minimal directive definitions" $ - let directive nm loc = - TypeSystemDefinition - (DirectiveDefinition - (Description Nothing) - nm - (ArgumentsDefinition []) - (loc :| [])) - example1 = - directive "example1" - (DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition) - (Location {line = 1, column = 1}) - example2 = - directive "example2" - (DirLoc.ExecutableDirectiveLocation DirLoc.Field) - (Location {line = 2, column = 1}) - testSchemaExtension = example1 :| [ example2 ] + let directive name' loc = TypeSystemDefinition + $ DirectiveDefinition + (Description Nothing) + name' + (ArgumentsDefinition []) + False + (loc :| []) + example1 = directive "example1" + (DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition) + (Location {line = 1, column = 1}) + example2 = directive "example2" + (DirLoc.ExecutableDirectiveLocation DirLoc.Field) + (Location {line = 2, column = 1}) + testSchemaExtension = example1 :| [example2] query = [gql| directive @example1 on FIELD_DEFINITION directive @example2 on FIELD @@ -166,31 +169,26 @@ spec = describe "Parser" $ do in parse document "" query `shouldParse` testSchemaExtension it "parses a directive definition with a default empty list argument" $ - let directive nm loc args = - 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 []) - $ Location {line = 1, column = 33})] - (Location {line = 1, column = 1}) + let argumentValue = Just + $ Node (ConstList []) + $ Location{ line = 1, column = 33 } + 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|] - in parse document "" query `shouldParse` (defn :| [ ]) + in parse document "" query `shouldParse` (directive :| []) it "parses schema extension with a new directive" $ parse document "" `shouldSucceedOn`[gql| @@ -210,6 +208,13 @@ spec = describe "Parser" $ do query = [gql|extend schema @newDirective { query: Query }|] 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" $ parse document "" `shouldSucceedOn` [gql| extend type Story { |