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.

CHANGELOG.md

@@ -11,6 +11,10 @@ and this project adheres to
 - `Language.GraphQL.Execute.OrderedMap` is a map data structure, that preserves
   insertion order.
 
+### Fixed
+- Parser now accepts empty lists and objects.
+- Parser now accepts all directive locations.
+
 ## [0.11.1.0] - 2021-02-07
 ### Added
 - `Validate.Rules`:
@@ -109,7 +113,7 @@ and this project adheres to
   `locations`.
 - Parsing comments in the front of definitions.
 - Some missing labels were added to the parsers, some labels were fixed to
-  refer to the AST nodes being parsed. 
+  refer to the AST nodes being parsed.
 
 ### Added
 - `AST` reexports `AST.Parser`.

src/Language/GraphQL/AST/Parser.hs

@@ -14,11 +14,7 @@ import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Text (Text)
 import qualified Language.GraphQL.AST.DirectiveLocation as Directive
-import Language.GraphQL.AST.DirectiveLocation
+import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation)
-    ( DirectiveLocation
-    , ExecutableDirectiveLocation
-    , TypeSystemDirectiveLocation
-    )
 import qualified Language.GraphQL.AST.Document as Full
 import Language.GraphQL.AST.Lexer
 import Text.Megaparsec
@@ -96,34 +92,28 @@ directiveLocations = optional pipe
     <?> "DirectiveLocations"
 
 directiveLocation :: Parser DirectiveLocation
-directiveLocation
+directiveLocation = e (Directive.Query <$ symbol "QUERY")
-    = Directive.ExecutableDirectiveLocation <$> executableDirectiveLocation
+    <|> e (Directive.Mutation <$ symbol "MUTATION")
-    <|> Directive.TypeSystemDirectiveLocation <$> typeSystemDirectiveLocation
+    <|> e (Directive.Subscription <$ symbol "SUBSCRIPTION")
+    <|> t (Directive.FieldDefinition <$ symbol "FIELD_DEFINITION")
+    <|> e (Directive.Field <$ symbol "FIELD")
+    <|> e (Directive.FragmentDefinition <$ "FRAGMENT_DEFINITION")
+    <|> e (Directive.FragmentSpread <$ "FRAGMENT_SPREAD")
+    <|> e (Directive.InlineFragment <$ "INLINE_FRAGMENT")
+    <|> t (Directive.Schema <$ symbol "SCHEMA")
+    <|> t (Directive.Scalar <$ symbol "SCALAR")
+    <|> t (Directive.Object <$ symbol "OBJECT")
+    <|> t (Directive.ArgumentDefinition <$ symbol "ARGUMENT_DEFINITION")
+    <|> t (Directive.Interface <$ symbol "INTERFACE")
+    <|> t (Directive.Union <$ symbol "UNION")
+    <|> t (Directive.EnumValue <$ symbol "ENUM_VALUE")
+    <|> t (Directive.Enum <$ symbol "ENUM")
+    <|> t (Directive.InputObject <$ symbol "INPUT_OBJECT")
+    <|> t (Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION")
     <?> "DirectiveLocation"
-
+  where
-executableDirectiveLocation :: Parser ExecutableDirectiveLocation
+    e = fmap Directive.ExecutableDirectiveLocation
-executableDirectiveLocation = Directive.Query <$ symbol "QUERY"
+    t = fmap Directive.TypeSystemDirectiveLocation
-    <|> Directive.Mutation <$ symbol "MUTATION"
-    <|> Directive.Subscription <$ symbol "SUBSCRIPTION"
-    <|> Directive.Field <$ symbol "FIELD"
-    <|> Directive.FragmentDefinition <$ "FRAGMENT_DEFINITION"
-    <|> Directive.FragmentSpread <$ "FRAGMENT_SPREAD"
-    <|> Directive.InlineFragment <$ "INLINE_FRAGMENT"
-    <?> "ExecutableDirectiveLocation"
-
-typeSystemDirectiveLocation :: Parser TypeSystemDirectiveLocation
-typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA"
-    <|> Directive.Scalar <$ symbol "SCALAR"
-    <|> Directive.Object <$ symbol "OBJECT"
-    <|> Directive.FieldDefinition <$ symbol "FIELD_DEFINITION"
-    <|> Directive.ArgumentDefinition <$ symbol "ARGUMENT_DEFINITION"
-    <|> Directive.Interface <$ symbol "INTERFACE"
-    <|> Directive.Union <$ symbol "UNION"
-    <|> Directive.Enum <$ symbol "ENUM"
-    <|> Directive.EnumValue <$ symbol "ENUM_VALUE"
-    <|> Directive.InputObject <$ symbol "INPUT_OBJECT"
-    <|> Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION"
-    <?> "TypeSystemDirectiveLocation"
 
 typeDefinition :: Full.Description -> Parser Full.TypeDefinition
 typeDefinition description' = scalarTypeDefinition description'
@@ -471,8 +461,8 @@ constValue = Full.ConstFloat <$> try float
     <|> Full.ConstNull <$ nullValue
     <|> Full.ConstString <$> stringValue
     <|> Full.ConstEnum <$> try enumValue
-    <|> Full.ConstList <$> brackets (some constValue)
+    <|> Full.ConstList <$> brackets (many constValue)
-    <|> Full.ConstObject <$> braces (some $ objectField $ valueNode constValue)
+    <|> Full.ConstObject <$> braces (many $ objectField $ valueNode constValue)
     <?> "Value"
 
 booleanValue :: Parser Bool

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