From ca0f0bd32d3334dfe7e016f11c9582c6e54e5422 Mon Sep 17 00:00:00 2001
From: Ben Sinclair <ben@typius.com>
Date: Sun, 21 Feb 2021 02:06:27 +1100
Subject: Fix some issues with directive definitions

I found some issues with directive definitions:

- I couldn't use `on FIELD_DEFINITION`, I believe because `FIELD` was parsed
  first in `executableDirectiveLocation`. I've combined both
  `executableDirectiveLocation` and `typetypeSystemDirectiveLocation` into one
  function which can reorder them to ensure every directive location gets a fair
  chance at parsing.

Not actually to do with directives, some literals weren't being parsed
correctly.

- The GraphQL spec defines list to be `[]` or `[Value]`, but empty literal lists
  weren't being parsed correctly because of using `some` instead of `many`.

- The GraphQL spec defines objects to be `{}` or `{Name: Value}`, but empty
  literal objects had the same issue.
---
 tests/Language/GraphQL/AST/ParserSpec.hs | 51 ++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)

(limited to 'tests/Language/GraphQL/AST')

diff --git a/tests/Language/GraphQL/AST/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs
index 5c4d39e..a47fc11 100644
--- a/tests/Language/GraphQL/AST/ParserSpec.hs
+++ b/tests/Language/GraphQL/AST/ParserSpec.hs
@@ -6,6 +6,7 @@ module Language.GraphQL.AST.ParserSpec
 
 import Data.List.NonEmpty (NonEmpty(..))
 import Language.GraphQL.AST.Document
+import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc
 import Language.GraphQL.AST.Parser
 import Test.Hspec (Spec, describe, it)
 import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
@@ -119,6 +120,56 @@ spec = describe "Parser" $ do
               | FRAGMENT_SPREAD
         |]
 
+    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 = 2, column = 17})
+            example2 =
+                directive "example2"
+                    (DirLoc.ExecutableDirectiveLocation DirLoc.Field)
+                    (Location {line = 3, column = 17})
+            testSchemaExtension = example1 :| [ example2 ]
+            query = [r|
+                directive @example1 on FIELD_DEFINITION
+                directive @example2 on FIELD
+            |]
+         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})
+            query = [r|directive @test(foo: [String] = []) on FIELD_DEFINITION|]
+         in parse document "" query `shouldParse` (defn :| [ ])
+
     it "parses schema extension with a new directive" $
         parse document "" `shouldSucceedOn`[r|
             extend schema @newDirective
-- 
cgit v1.2.3