From 05fc62ba6a44f73958f55ca75ff8999628205d19 Mon Sep 17 00:00:00 2001
From: Paul Desmond Parker <pauldesmondparker@gmail.com>
Date: Sat, 16 Dec 2017 12:18:27 +0800
Subject: [PATCH 1/6] Make Node instance of HasName. Implement getName

Following todo formerly in src/GraphQL/Internal/Syntax/AST.hs:
  TODO: Just make Node implement HasName.
Declared Node as instance of HasName and wrote implementation of
getname for it.

Because of a cyclic dependency between Name and AST, moved the Name
specific code from GraphQL.Internal.Syntax.AST module into the
GraphQL.Internal.Name module.

Updated imports and exposures in the AST and Name modules described
above.

Simple import and qualified name changes to:
  GraphQL/Internal/Syntax/Encoder
  GraphQL/Internal/Syntax/Parser
---
 src/GraphQL/Internal/Name.hs           | 74 ++++++++++++++++++++++---
 src/GraphQL/Internal/Syntax/AST.hs     | 76 ++------------------------
 src/GraphQL/Internal/Syntax/Encoder.hs | 47 ++++++++--------
 src/GraphQL/Internal/Syntax/Parser.hs  | 41 +++++++-------
 4 files changed, 116 insertions(+), 122 deletions(-)

diff --git a/src/GraphQL/Internal/Name.hs b/src/GraphQL/Internal/Name.hs
index d09a1b9..9a9bc04 100644
--- a/src/GraphQL/Internal/Name.hs
+++ b/src/GraphQL/Internal/Name.hs
@@ -5,10 +5,11 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 module GraphQL.Internal.Name
-  ( Name(unName)
+  ( Name(unName, Name)
   , NameError(..)
   , makeName
   , nameFromSymbol
+  , nameParser
   -- * Named things
   , HasName(..)
   -- * Unsafe functions
@@ -17,13 +18,57 @@ module GraphQL.Internal.Name
 
 import Protolude
 
+import qualified Data.Aeson as Aeson
 import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)
-import GraphQL.Internal.Syntax.AST
-  ( Name(..)
-  , NameError(..)
-  , unsafeMakeName
-  , makeName
-  )
+import Data.Char (isDigit)
+import qualified Data.Attoparsec.Text as A
+import Test.QuickCheck (Arbitrary(..), elements, listOf)
+import Data.String (IsString(..))
+
+import GraphQL.Internal.Arbitrary (arbitraryText)
+import GraphQL.Internal.Syntax.Tokens (tok)
+
+-- * Name
+
+-- | A name in GraphQL.
+--
+-- https://facebook.github.io/graphql/#sec-Names
+newtype Name = Name { unName :: Text } deriving (Eq, Ord, Show)
+
+-- | Create a 'Name', panicking if the given text is invalid.
+--
+-- Prefer 'makeName' to this in all cases.
+--
+-- >>> unsafeMakeName "foo"
+-- Name {unName = "foo"}
+unsafeMakeName :: HasCallStack => Text -> Name
+unsafeMakeName name =
+  case makeName name of
+    Left e -> panic (show e)
+    Right n -> n
+
+-- | Create a 'Name'.
+--
+-- Names must match the regex @[_A-Za-z][_0-9A-Za-z]*@. If the given text does
+-- not match, return Nothing.
+--
+-- >>> makeName "foo"
+-- Right (Name {unName = "foo"})
+-- >>> makeName "9-bar"
+-- Left (NameError "9-bar")
+makeName :: Text -> Either NameError Name
+makeName name = first (const (NameError name)) (A.parseOnly nameParser name)
+
+-- | Parser for 'Name'.
+nameParser :: A.Parser Name
+nameParser = Name <$> tok ((<>) <$> A.takeWhile1 isA_z
+                                <*> A.takeWhile ((||) <$> isDigit <*> isA_z))
+  where
+    -- `isAlpha` handles many more Unicode Chars
+    isA_z = A.inClass $ '_' : ['A'..'Z'] <> ['a'..'z']
+
+-- | An invalid name.
+newtype NameError = NameError Text deriving (Eq, Show)
 
 -- | Convert a type-level 'Symbol' into a GraphQL 'Name'.
 nameFromSymbol :: forall (n :: Symbol). KnownSymbol n => Either NameError Name
@@ -41,3 +86,18 @@ nameFromSymbol = makeName (toS (symbolVal @n Proxy))
 class HasName a where
   -- | Get the name of the object.
   getName :: a -> Name
+
+instance IsString Name where
+  fromString = unsafeMakeName . toS
+
+instance Aeson.ToJSON Name where
+  toJSON = Aeson.toJSON . unName
+
+instance Arbitrary Name where
+  arbitrary = do
+    initial <- elements alpha
+    rest <- listOf (elements (alpha <> numeric))
+    pure (Name (toS (initial:rest)))
+    where
+      alpha = ['A'..'Z'] <> ['a'..'z'] <> ['_']
+      numeric = ['0'..'9']
diff --git a/src/GraphQL/Internal/Syntax/AST.hs b/src/GraphQL/Internal/Syntax/AST.hs
index 9063507..1190fbd 100644
--- a/src/GraphQL/Internal/Syntax/AST.hs
+++ b/src/GraphQL/Internal/Syntax/AST.hs
@@ -4,17 +4,11 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module GraphQL.Internal.Syntax.AST
-  ( Name(unName)
-  , nameParser
-  , NameError(..)
-  , unsafeMakeName
-  , makeName
-  , QueryDocument(..)
+  ( QueryDocument(..)
   , SchemaDocument(..)
   , Definition(..)
   , OperationDefinition(..)
   , Node(..)
-  , getNodeName
   , VariableDefinition(..)
   , Variable(..)
   , SelectionSet
@@ -54,72 +48,11 @@ module GraphQL.Internal.Syntax.AST
 
 import Protolude
 
-import qualified Data.Aeson as Aeson
-import qualified Data.Attoparsec.Text as A
-import Data.Char (isDigit)
 import Data.String (IsString(..))
 import Test.QuickCheck (Arbitrary(..), elements, listOf, oneof)
 
 import GraphQL.Internal.Arbitrary (arbitraryText)
-import GraphQL.Internal.Syntax.Tokens (tok)
-
--- * Name
-
--- | A name in GraphQL.
---
--- https://facebook.github.io/graphql/#sec-Names
-newtype Name = Name { unName :: Text } deriving (Eq, Ord, Show)
-
--- | Create a 'Name', panicking if the given text is invalid.
---
--- Prefer 'makeName' to this in all cases.
---
--- >>> unsafeMakeName "foo"
--- Name {unName = "foo"}
-unsafeMakeName :: HasCallStack => Text -> Name
-unsafeMakeName name =
-  case makeName name of
-    Left e -> panic (show e)
-    Right n -> n
-
--- | Create a 'Name'.
---
--- Names must match the regex @[_A-Za-z][_0-9A-Za-z]*@. If the given text does
--- not match, return Nothing.
---
--- >>> makeName "foo"
--- Right (Name {unName = "foo"})
--- >>> makeName "9-bar"
--- Left (NameError "9-bar")
-makeName :: Text -> Either NameError Name
-makeName name = first (const (NameError name)) (A.parseOnly nameParser name)
-
--- | An invalid name.
-newtype NameError = NameError Text deriving (Eq, Show)
-
-
-instance IsString Name where
-  fromString = unsafeMakeName . toS
-
-instance Aeson.ToJSON Name where
-  toJSON = Aeson.toJSON . unName
-
-instance Arbitrary Name where
-  arbitrary = do
-    initial <- elements alpha
-    rest <- listOf (elements (alpha <> numeric))
-    pure (Name (toS (initial:rest)))
-    where
-      alpha = ['A'..'Z'] <> ['a'..'z'] <> ['_']
-      numeric = ['0'..'9']
-
--- | Parser for 'Name'.
-nameParser :: A.Parser Name
-nameParser = Name <$> tok ((<>) <$> A.takeWhile1 isA_z
-                                <*> A.takeWhile ((||) <$> isDigit <*> isA_z))
-  where
-    -- `isAlpha` handles many more Unicode Chars
-    isA_z = A.inClass $ '_' : ['A'..'Z'] <> ['a'..'z']
+import GraphQL.Internal.Name (HasName(getName), Name(unName, Name), unsafeMakeName)
 
 -- * Documents
 
@@ -146,9 +79,8 @@ data OperationDefinition
 data Node = Node Name [VariableDefinition] [Directive] SelectionSet
             deriving (Eq,Show)
 
--- TODO: Just make Node implement HasName.
-getNodeName :: Node -> Name
-getNodeName (Node name _ _ _) = name
+instance HasName Node where
+  getName (Node name _ _ _) = name
 
 data VariableDefinition = VariableDefinition Variable Type (Maybe DefaultValue)
                           deriving (Eq,Show)
diff --git a/src/GraphQL/Internal/Syntax/Encoder.hs b/src/GraphQL/Internal/Syntax/Encoder.hs
index c296858..6891790 100644
--- a/src/GraphQL/Internal/Syntax/Encoder.hs
+++ b/src/GraphQL/Internal/Syntax/Encoder.hs
@@ -10,6 +10,7 @@ import qualified Data.Aeson as Aeson
 import Data.Text (Text, cons, intercalate, pack, snoc)
 
 import qualified GraphQL.Internal.Syntax.AST as AST
+import GraphQL.Internal.Name (unName)
 
 -- * Document
 
@@ -30,7 +31,7 @@ operationDefinition (AST.AnonymousQuery ss) = selectionSet ss
 
 node :: AST.Node -> Text
 node (AST.Node name vds ds ss) =
-     AST.unName name
+     unName name
   <> optempty variableDefinitions vds
   <> optempty directives ds
   <> selectionSet ss
@@ -46,7 +47,7 @@ defaultValue :: AST.DefaultValue -> Text
 defaultValue val = "=" <> value val
 
 variable :: AST.Variable -> Text
-variable (AST.Variable name) = "$" <> AST.unName name
+variable (AST.Variable name) = "$" <> unName name
 
 selectionSet :: AST.SelectionSet -> Text
 selectionSet = bracesCommas selection
@@ -58,8 +59,8 @@ selection (AST.SelectionFragmentSpread x) = fragmentSpread x
 
 field :: AST.Field -> Text
 field (AST.Field alias name args ds ss) =
-       optempty (`snoc` ':') (maybe mempty AST.unName alias)
-    <> AST.unName name
+       optempty (`snoc` ':') (maybe mempty unName alias)
+    <> unName name
     <> optempty arguments args
     <> optempty directives ds
     <> optempty selectionSet ss
@@ -68,17 +69,17 @@ arguments :: [AST.Argument] -> Text
 arguments = parensCommas argument
 
 argument :: AST.Argument -> Text
-argument (AST.Argument name v) = AST.unName name <> ":" <> value v
+argument (AST.Argument name v) = unName name <> ":" <> value v
 
 -- * Fragments
 
 fragmentSpread :: AST.FragmentSpread -> Text
 fragmentSpread (AST.FragmentSpread name ds) =
-  "..." <> AST.unName name <> optempty directives ds
+  "..." <> unName name <> optempty directives ds
 
 inlineFragment :: AST.InlineFragment -> Text
 inlineFragment (AST.InlineFragment (Just (AST.NamedType tc)) ds ss) =
-  "... on " <> AST.unName tc
+  "... on " <> unName tc
             <> optempty directives ds
             <> optempty selectionSet ss
 inlineFragment (AST.InlineFragment Nothing ds ss) =
@@ -87,7 +88,7 @@ inlineFragment (AST.InlineFragment Nothing ds ss) =
 
 fragmentDefinition :: AST.FragmentDefinition -> Text
 fragmentDefinition (AST.FragmentDefinition name (AST.NamedType tc) ds ss) =
-  "fragment " <> AST.unName name <> " on " <> AST.unName tc
+  "fragment " <> unName name <> " on " <> unName tc
               <> optempty directives ds
               <> selectionSet ss
 
@@ -101,7 +102,7 @@ value (AST.ValueInt      x) = pack $ show x
 value (AST.ValueFloat    x) = pack $ show x
 value (AST.ValueBoolean  x) = booleanValue x
 value (AST.ValueString   x) = stringValue x
-value (AST.ValueEnum     x) = AST.unName x
+value (AST.ValueEnum     x) = unName x
 value (AST.ValueList     x) = listValue x
 value (AST.ValueObject   x) = objectValue x
 value AST.ValueNull = "null"
@@ -121,7 +122,7 @@ objectValue :: AST.ObjectValue -> Text
 objectValue (AST.ObjectValue ofs) = bracesCommas objectField ofs
 
 objectField :: AST.ObjectField -> Text
-objectField (AST.ObjectField name v) = AST.unName name <> ":" <> value v
+objectField (AST.ObjectField name v) = unName name <> ":" <> value v
 
 -- * Directives
 
@@ -129,23 +130,23 @@ directives :: [AST.Directive] -> Text
 directives = spaces directive
 
 directive :: AST.Directive -> Text
-directive (AST.Directive name args) = "@" <> AST.unName name <> optempty arguments args
+directive (AST.Directive name args) = "@" <> unName name <> optempty arguments args
 
 -- * Type Reference
 
 type_ :: AST.Type -> Text
-type_ (AST.TypeNamed (AST.NamedType x)) = AST.unName x
+type_ (AST.TypeNamed (AST.NamedType x)) = unName x
 type_ (AST.TypeList x) = listType x
 type_ (AST.TypeNonNull x) = nonNullType x
 
 namedType :: AST.NamedType -> Text
-namedType (AST.NamedType name) = AST.unName name
+namedType (AST.NamedType name) = unName name
 
 listType :: AST.ListType -> Text
 listType (AST.ListType ty) = brackets (type_ ty)
 
 nonNullType :: AST.NonNullType -> Text
-nonNullType (AST.NonNullTypeNamed (AST.NamedType x)) = AST.unName x <> "!"
+nonNullType (AST.NonNullTypeNamed (AST.NamedType x)) = unName x <> "!"
 nonNullType (AST.NonNullTypeList  x) = listType x <> "!"
 
 typeDefinition :: AST.TypeDefinition -> Text
@@ -159,7 +160,7 @@ typeDefinition (AST.TypeDefinitionTypeExtension x) = typeExtensionDefinition x
 
 objectTypeDefinition :: AST.ObjectTypeDefinition -> Text
 objectTypeDefinition (AST.ObjectTypeDefinition name ifaces fds) =
-  "type " <> AST.unName name
+  "type " <> unName name
           <> optempty (spaced . interfaces) ifaces
           <> optempty fieldDefinitions fds
 
@@ -171,7 +172,7 @@ fieldDefinitions = bracesCommas fieldDefinition
 
 fieldDefinition :: AST.FieldDefinition -> Text
 fieldDefinition (AST.FieldDefinition name args ty) =
-  AST.unName name <> optempty argumentsDefinition args
+  unName name <> optempty argumentsDefinition args
                        <> ":"
                        <> type_ ty
 
@@ -180,36 +181,36 @@ argumentsDefinition = parensCommas inputValueDefinition
 
 interfaceTypeDefinition :: AST.InterfaceTypeDefinition -> Text
 interfaceTypeDefinition (AST.InterfaceTypeDefinition name fds) =
-  "interface " <> AST.unName name <> fieldDefinitions fds
+  "interface " <> unName name <> fieldDefinitions fds
 
 unionTypeDefinition :: AST.UnionTypeDefinition -> Text
 unionTypeDefinition (AST.UnionTypeDefinition name ums) =
-  "union " <> AST.unName name <> "=" <> unionMembers ums
+  "union " <> unName name <> "=" <> unionMembers ums
 
 unionMembers :: [AST.NamedType] -> Text
 unionMembers = intercalate "|" . fmap namedType
 
 scalarTypeDefinition :: AST.ScalarTypeDefinition -> Text
-scalarTypeDefinition (AST.ScalarTypeDefinition name) = "scalar " <> AST.unName name
+scalarTypeDefinition (AST.ScalarTypeDefinition name) = "scalar " <> unName name
 
 enumTypeDefinition :: AST.EnumTypeDefinition -> Text
 enumTypeDefinition (AST.EnumTypeDefinition name evds) =
-  "enum " <> AST.unName name
+  "enum " <> unName name
           <> bracesCommas enumValueDefinition evds
 
 enumValueDefinition :: AST.EnumValueDefinition -> Text
-enumValueDefinition (AST.EnumValueDefinition name) = AST.unName name
+enumValueDefinition (AST.EnumValueDefinition name) = unName name
 
 inputObjectTypeDefinition :: AST.InputObjectTypeDefinition -> Text
 inputObjectTypeDefinition (AST.InputObjectTypeDefinition name ivds) =
-  "input " <> AST.unName name <> inputValueDefinitions ivds
+  "input " <> unName name <> inputValueDefinitions ivds
 
 inputValueDefinitions :: [AST.InputValueDefinition] -> Text
 inputValueDefinitions = bracesCommas inputValueDefinition
 
 inputValueDefinition :: AST.InputValueDefinition -> Text
 inputValueDefinition (AST.InputValueDefinition name ty dv) =
-  AST.unName name <> ":" <> type_ ty <> maybe mempty defaultValue dv
+  unName name <> ":" <> type_ ty <> maybe mempty defaultValue dv
 
 typeExtensionDefinition :: AST.TypeExtensionDefinition -> Text
 typeExtensionDefinition (AST.TypeExtensionDefinition otd) =
diff --git a/src/GraphQL/Internal/Syntax/Parser.hs b/src/GraphQL/Internal/Syntax/Parser.hs
index 398702c..e6ca994 100644
--- a/src/GraphQL/Internal/Syntax/Parser.hs
+++ b/src/GraphQL/Internal/Syntax/Parser.hs
@@ -28,6 +28,7 @@ import Data.Attoparsec.Text
 
 import qualified GraphQL.Internal.Syntax.AST as AST
 import GraphQL.Internal.Syntax.Tokens (tok, whiteSpace)
+import GraphQL.Internal.Name (nameParser)
 
 -- * Document
 
@@ -51,7 +52,7 @@ operationDefinition =
   <?> "operationDefinition error!"
 
 node :: Parser AST.Node
-node = AST.Node <$> AST.nameParser
+node = AST.Node <$> nameParser
                 <*> optempty variableDefinitions
                 <*> optempty directives
                 <*> selectionSet
@@ -70,7 +71,7 @@ defaultValue :: Parser AST.DefaultValue
 defaultValue = tok "=" *> value
 
 variable :: Parser AST.Variable
-variable = AST.Variable <$ tok "$" <*> AST.nameParser
+variable = AST.Variable <$ tok "$" <*> nameParser
 
 selectionSet :: Parser AST.SelectionSet
 selectionSet = braces $ many1 selection
@@ -84,19 +85,19 @@ selection = AST.SelectionField <$> field
 
 field :: Parser AST.Field
 field = AST.Field <$> option empty (pure <$> alias)
-                  <*> AST.nameParser
+                  <*> nameParser
                   <*> optempty arguments
                   <*> optempty directives
                   <*> optempty selectionSet
 
 alias :: Parser AST.Alias
-alias = AST.nameParser <* tok ":"
+alias = nameParser <* tok ":"
 
 arguments :: Parser [AST.Argument]
 arguments = parens $ many1 argument
 
 argument :: Parser AST.Argument
-argument = AST.Argument <$> AST.nameParser <* tok ":" <*> value
+argument = AST.Argument <$> nameParser <* tok ":" <*> value
 
 -- * Fragments
 
@@ -105,7 +106,7 @@ fragmentSpread :: Parser AST.FragmentSpread
 -- See https://facebook.github.io/graphql/#FragmentSpread
 fragmentSpread = AST.FragmentSpread
   <$  tok "..."
-  <*> AST.nameParser
+  <*> nameParser
   <*> optempty directives
 
 -- InlineFragment tried first in order to guard against 'on' keyword
@@ -119,7 +120,7 @@ inlineFragment = AST.InlineFragment
 fragmentDefinition :: Parser AST.FragmentDefinition
 fragmentDefinition = AST.FragmentDefinition
   <$  tok "fragment"
-  <*> AST.nameParser
+  <*> nameParser
   <*  tok "on"
   <*> typeCondition
   <*> optempty directives
@@ -139,7 +140,7 @@ value = tok (AST.ValueVariable <$> (variable <?> "variable")
   <|> AST.ValueBoolean  <$> (booleanValue <?> "booleanValue")
   <|> AST.ValueString   <$> (stringValue <?> "stringValue")
   -- `true` and `false` have been tried before
-  <|> AST.ValueEnum     <$> (AST.nameParser <?> "name")
+  <|> AST.ValueEnum     <$> (nameParser <?> "name")
   <|> AST.ValueList     <$> (listValue <?> "listValue")
   <|> AST.ValueObject   <$> (objectValue <?> "objectValue")
   <?> "value error!")
@@ -192,7 +193,7 @@ objectValue :: Parser AST.ObjectValue
 objectValue = AST.ObjectValue <$> braces (many (objectField <?> "objectField"))
 
 objectField :: Parser AST.ObjectField
-objectField = AST.ObjectField <$> AST.nameParser <* tok ":" <*> value
+objectField = AST.ObjectField <$> nameParser <* tok ":" <*> value
 
 -- * Directives
 
@@ -202,7 +203,7 @@ directives = many1 directive
 directive :: Parser AST.Directive
 directive = AST.Directive
   <$  tok "@"
-  <*> AST.nameParser
+  <*> nameParser
   <*> optempty arguments
 
 -- * Type Reference
@@ -214,7 +215,7 @@ type_ = AST.TypeList    <$> listType
     <?> "type_ error!"
 
 namedType :: Parser AST.NamedType
-namedType = AST.NamedType <$> AST.nameParser
+namedType = AST.NamedType <$> nameParser
 
 listType :: Parser AST.ListType
 listType = AST.ListType <$> brackets type_
@@ -240,7 +241,7 @@ typeDefinition =
 objectTypeDefinition :: Parser AST.ObjectTypeDefinition
 objectTypeDefinition = AST.ObjectTypeDefinition
   <$  tok "type"
-  <*> AST.nameParser
+  <*> nameParser
   <*> optempty interfaces
   <*> fieldDefinitions
 
@@ -252,7 +253,7 @@ fieldDefinitions = braces $ many1 fieldDefinition
 
 fieldDefinition :: Parser AST.FieldDefinition
 fieldDefinition = AST.FieldDefinition
-  <$> AST.nameParser
+  <$> nameParser
   <*> optempty argumentsDefinition
   <*  tok ":"
   <*> type_
@@ -263,13 +264,13 @@ argumentsDefinition = parens $ many1 inputValueDefinition
 interfaceTypeDefinition :: Parser AST.InterfaceTypeDefinition
 interfaceTypeDefinition = AST.InterfaceTypeDefinition
   <$  tok "interface"
-  <*> AST.nameParser
+  <*> nameParser
   <*> fieldDefinitions
 
 unionTypeDefinition :: Parser AST.UnionTypeDefinition
 unionTypeDefinition = AST.UnionTypeDefinition
   <$  tok "union"
-  <*> AST.nameParser
+  <*> nameParser
   <*  tok "="
   <*> unionMembers
 
@@ -279,24 +280,24 @@ unionMembers = namedType `sepBy1` tok "|"
 scalarTypeDefinition :: Parser AST.ScalarTypeDefinition
 scalarTypeDefinition = AST.ScalarTypeDefinition
   <$  tok "scalar"
-  <*> AST.nameParser
+  <*> nameParser
 
 enumTypeDefinition :: Parser AST.EnumTypeDefinition
 enumTypeDefinition = AST.EnumTypeDefinition
   <$  tok "enum"
-  <*> AST.nameParser
+  <*> nameParser
   <*> enumValueDefinitions
 
 enumValueDefinitions :: Parser [AST.EnumValueDefinition]
 enumValueDefinitions = braces $ many1 enumValueDefinition
 
 enumValueDefinition :: Parser AST.EnumValueDefinition
-enumValueDefinition = AST.EnumValueDefinition <$> AST.nameParser
+enumValueDefinition = AST.EnumValueDefinition <$> nameParser
 
 inputObjectTypeDefinition :: Parser AST.InputObjectTypeDefinition
 inputObjectTypeDefinition = AST.InputObjectTypeDefinition
   <$  tok "input"
-  <*> AST.nameParser
+  <*> nameParser
   <*> inputValueDefinitions
 
 inputValueDefinitions :: Parser [AST.InputValueDefinition]
@@ -304,7 +305,7 @@ inputValueDefinitions = braces $ many1 inputValueDefinition
 
 inputValueDefinition :: Parser AST.InputValueDefinition
 inputValueDefinition = AST.InputValueDefinition
-  <$> AST.nameParser
+  <$> nameParser
   <*  tok ":"
   <*> type_
   <*> optional defaultValue

From d27f591607109ac6029e1b8219ec7c966984e04b Mon Sep 17 00:00:00 2001
From: Paul Desmond Parker <pauldesmondparker@gmail.com>
Date: Wed, 20 Dec 2017 19:20:17 +0800
Subject: [PATCH 2/6] Add Data.Text import and clean up unused imports.

Was compiling before, but Name was using Text from some place else.
---
 src/GraphQL/Internal/Name.hs       | 4 ++--
 src/GraphQL/Internal/Syntax/AST.hs | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/GraphQL/Internal/Name.hs b/src/GraphQL/Internal/Name.hs
index 9a9bc04..90c8772 100644
--- a/src/GraphQL/Internal/Name.hs
+++ b/src/GraphQL/Internal/Name.hs
@@ -21,11 +21,11 @@ import Protolude
 import qualified Data.Aeson as Aeson
 import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)
 import Data.Char (isDigit)
+import Data.Text as T (Text)
 import qualified Data.Attoparsec.Text as A
 import Test.QuickCheck (Arbitrary(..), elements, listOf)
 import Data.String (IsString(..))
 
-import GraphQL.Internal.Arbitrary (arbitraryText)
 import GraphQL.Internal.Syntax.Tokens (tok)
 
 -- * Name
@@ -33,7 +33,7 @@ import GraphQL.Internal.Syntax.Tokens (tok)
 -- | A name in GraphQL.
 --
 -- https://facebook.github.io/graphql/#sec-Names
-newtype Name = Name { unName :: Text } deriving (Eq, Ord, Show)
+newtype Name = Name { unName :: T.Text } deriving (Eq, Ord, Show)
 
 -- | Create a 'Name', panicking if the given text is invalid.
 --
diff --git a/src/GraphQL/Internal/Syntax/AST.hs b/src/GraphQL/Internal/Syntax/AST.hs
index 1190fbd..82f68e3 100644
--- a/src/GraphQL/Internal/Syntax/AST.hs
+++ b/src/GraphQL/Internal/Syntax/AST.hs
@@ -48,7 +48,7 @@ module GraphQL.Internal.Syntax.AST
 
 import Protolude
 
-import Data.String (IsString(..))
+--import Data.String (IsString(..))
 import Test.QuickCheck (Arbitrary(..), elements, listOf, oneof)
 
 import GraphQL.Internal.Arbitrary (arbitraryText)

From a8cd01fb7d6f1d7c079af983c815bd25ad73ed5b Mon Sep 17 00:00:00 2001
From: Paul Desmond Parker <pauldesmondparker@gmail.com>
Date: Wed, 20 Dec 2017 21:29:40 +0800
Subject: [PATCH 3/6] Fix error when single query is anonymous.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

```
    "{\"query\":\"query {\\n  greeting(who: \\\"Tim\\\")\\n}\"}"
```
Notice that the query (immediately after the start of the JSON field
`query:`) has no operationName, i.e. it's anonymous.

This gets decoded to:
```
Just (GraphQLPostRequest {query = "query {\n  greeting(who: \"Tim\")\n}", operationName = "", variables = fromList []})
```
by a custom/temporary Aeson parser.

:blush: I didn't record it, and now it's gone. Something along the lines
of: `Just(Error{"query document error!definition error!query"})`
Not exactly, but that was the gist of it.

Realized that the parser might be choking on the absence of the
`operationName`, so tried to apply `optempty` to `nameParser` but Name
was not an instance of Monoid. Changed that and ¡viola! it worked
(sounds easy, but I learned something about applying Monoid to a newtype,
and also picked up a prior mistake where I forgot to import Data.Text).

On a side note, the 'custom/temporary' Aeson parser does not yet solve
the ambiguous `variables` problem mentioned here:
and here:
and obliquely here:
---
 src/GraphQL/Internal/Name.hs          | 15 +++++++++++++++
 src/GraphQL/Internal/Syntax/Parser.hs |  2 +-
 2 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/src/GraphQL/Internal/Name.hs b/src/GraphQL/Internal/Name.hs
index 90c8772..f26f3f1 100644
--- a/src/GraphQL/Internal/Name.hs
+++ b/src/GraphQL/Internal/Name.hs
@@ -25,6 +25,7 @@ import Data.Text as T (Text)
 import qualified Data.Attoparsec.Text as A
 import Test.QuickCheck (Arbitrary(..), elements, listOf)
 import Data.String (IsString(..))
+import Data.Text as T (Text, append, empty)
 
 import GraphQL.Internal.Syntax.Tokens (tok)
 
@@ -35,6 +36,20 @@ import GraphQL.Internal.Syntax.Tokens (tok)
 -- https://facebook.github.io/graphql/#sec-Names
 newtype Name = Name { unName :: T.Text } deriving (Eq, Ord, Show)
 
+instance Monoid Name where
+    mempty  = Name T.empty
+--    mappend (Name {a}) mempty = Name {a}
+--    mappend mempty (Name {b}) = Name {b}
+    mappend (Name a1) (Name a2) = Name (T.append a1 a2)
+--    mappend = append
+--    mconcat = concat
+
+--newtype Any = Any { getAny :: Bool }
+
+--instance Monoid Any where
+--    mempty = Any False
+--    (Any b1) `mappend` (Any b2) = Any (b1 || b2)
+
 -- | Create a 'Name', panicking if the given text is invalid.
 --
 -- Prefer 'makeName' to this in all cases.
diff --git a/src/GraphQL/Internal/Syntax/Parser.hs b/src/GraphQL/Internal/Syntax/Parser.hs
index e6ca994..34b7db6 100644
--- a/src/GraphQL/Internal/Syntax/Parser.hs
+++ b/src/GraphQL/Internal/Syntax/Parser.hs
@@ -52,7 +52,7 @@ operationDefinition =
   <?> "operationDefinition error!"
 
 node :: Parser AST.Node
-node = AST.Node <$> nameParser
+node = AST.Node <$> optempty nameParser
                 <*> optempty variableDefinitions
                 <*> optempty directives
                 <*> selectionSet

From 0a96e0033c5222b2cc0ed5c9e368f2c63f83f4dc Mon Sep 17 00:00:00 2001
From: Paul Desmond Parker <pauldesmondparker@gmail.com>
Date: Sat, 23 Dec 2017 12:13:35 +0800
Subject: [PATCH 4/6] Cut commented out code. Comment monoid instance.

Following suggestions made at:
[pull/139#discussion_r158537349](https://github.com/jml/graphql-api/pull/139#discussion_r158537349)
and
[pull/139#discussion_r158537230](https://github.com/jml/graphql-api/pull/139#discussion_r158537230)
and
[pull/139#discussion_r158537382](https://github.com/jml/graphql-api/pull/139#discussion_r158537382)
---
 src/GraphQL/Internal/Name.hs | 15 +++++----------
 1 file changed, 5 insertions(+), 10 deletions(-)

diff --git a/src/GraphQL/Internal/Name.hs b/src/GraphQL/Internal/Name.hs
index f26f3f1..bcd7e01 100644
--- a/src/GraphQL/Internal/Name.hs
+++ b/src/GraphQL/Internal/Name.hs
@@ -36,19 +36,14 @@ import GraphQL.Internal.Syntax.Tokens (tok)
 -- https://facebook.github.io/graphql/#sec-Names
 newtype Name = Name { unName :: T.Text } deriving (Eq, Ord, Show)
 
+-- | Allow Name to be parsed with `optempty`
+--
+-- Example: node = AST.Node <$> optempty nameParser
+-- I.e. If nameParser fails, the Name field of AST.Node is set
+-- mempty rather than propagating a failure. 
 instance Monoid Name where
     mempty  = Name T.empty
---    mappend (Name {a}) mempty = Name {a}
---    mappend mempty (Name {b}) = Name {b}
     mappend (Name a1) (Name a2) = Name (T.append a1 a2)
---    mappend = append
---    mconcat = concat
-
---newtype Any = Any { getAny :: Bool }
-
---instance Monoid Any where
---    mempty = Any False
---    (Any b1) `mappend` (Any b2) = Any (b1 || b2)
 
 -- | Create a 'Name', panicking if the given text is invalid.
 --

From 2bf5c01d5b44d812ebd0a9599a49046d578f06c0 Mon Sep 17 00:00:00 2001
From: Paul Desmond Parker <pauldesmondparker@gmail.com>
Date: Fri, 5 Jan 2018 11:22:07 +0800
Subject: [PATCH 5/6] Remove deriving Monoid from Name.

---
 src/GraphQL/Internal/Name.hs | 9 ---------
 1 file changed, 9 deletions(-)

diff --git a/src/GraphQL/Internal/Name.hs b/src/GraphQL/Internal/Name.hs
index bcd7e01..ea2b0c1 100644
--- a/src/GraphQL/Internal/Name.hs
+++ b/src/GraphQL/Internal/Name.hs
@@ -25,7 +25,6 @@ import Data.Text as T (Text)
 import qualified Data.Attoparsec.Text as A
 import Test.QuickCheck (Arbitrary(..), elements, listOf)
 import Data.String (IsString(..))
-import Data.Text as T (Text, append, empty)
 
 import GraphQL.Internal.Syntax.Tokens (tok)
 
@@ -36,14 +35,6 @@ import GraphQL.Internal.Syntax.Tokens (tok)
 -- https://facebook.github.io/graphql/#sec-Names
 newtype Name = Name { unName :: T.Text } deriving (Eq, Ord, Show)
 
--- | Allow Name to be parsed with `optempty`
---
--- Example: node = AST.Node <$> optempty nameParser
--- I.e. If nameParser fails, the Name field of AST.Node is set
--- mempty rather than propagating a failure. 
-instance Monoid Name where
-    mempty  = Name T.empty
-    mappend (Name a1) (Name a2) = Name (T.append a1 a2)
 
 -- | Create a 'Name', panicking if the given text is invalid.
 --

From 693d0b3583fdfad4b431e5884a88663c559f37b8 Mon Sep 17 00:00:00 2001
From: Paul Desmond Parker <pauldesmondparker@gmail.com>
Date: Fri, 5 Jan 2018 11:36:43 +0800
Subject: [PATCH 6/6] Revert Node as instance of HasName to getNodeName

Majority of code change occurred in Validations.hs because the StateT
monad needed to operate on a state of type `Set (Maybe Name)` instead of
`Set Name`. This was complicated by the fact that fragments use a raw
`Name`, not the wrapped `Maybe Name`. Lifted `Name` with `pure Name`
in all places it needed to be used inside StateT`s state.

Internal/Syntax/AST.hs:
        * Clean imports
        * Change type of Node to replace Name with (Maybe Name)

Internal/Syntax/Parser.hs:
        * Make nameParser optional

Internal/Syntax/Encoder.hs:
        * Self explanatory.

Internal/Validations.hs:
        * Rename variables to clearly reflect that they carry a `Maybe
Name` somewhere within rather than a `Name`.
        * Change `StateT`'s state type to `Set (Maybe Name)`
        * Wrap any `Name` type that needs to go into `StateT`'s state.

Change tests accordingly.
---
 docs/source/tutorial/tutorial.cabal    | 12 ++++---
 graphql-wai/graphql-wai.cabal          | 30 +++++++++++-------
 src/GraphQL/Internal/Execution.hs      |  2 +-
 src/GraphQL/Internal/Syntax/AST.hs     | 11 ++++---
 src/GraphQL/Internal/Syntax/Encoder.hs |  6 +++-
 src/GraphQL/Internal/Syntax/Parser.hs  |  2 +-
 src/GraphQL/Internal/Validation.hs     | 44 +++++++++++++-------------
 tests/ASTTests.hs                      |  4 +--
 tests/ValidationTests.hs               |  4 +--
 9 files changed, 64 insertions(+), 51 deletions(-)

diff --git a/docs/source/tutorial/tutorial.cabal b/docs/source/tutorial/tutorial.cabal
index 6f3ded8..83e21bf 100644
--- a/docs/source/tutorial/tutorial.cabal
+++ b/docs/source/tutorial/tutorial.cabal
@@ -1,6 +1,8 @@
--- This file has been generated from package.yaml by hpack version 0.15.0.
+-- This file has been generated from package.yaml by hpack version 0.20.0.
 --
 -- see: https://github.com/sol/hpack
+--
+-- hash: b3da6c729f0fa19c9ad82cb7e45f616850463bcc1654b9cd4797e34f6685ebd8
 
 name:          tutorial
 version:       0.0.1
@@ -18,11 +20,11 @@ library
   other-modules:
       Paths_tutorial
   build-depends:
-      base >= 4.9 && < 5
-    , protolude
+      aeson
+    , base >=4.9 && <5
     , graphql-api
+    , markdown-unlit >=0.4
+    , protolude
     , random
-    , markdown-unlit >= 0.4
-    , aeson
   default-language: Haskell2010
   ghc-options: -Wall -pgmL markdown-unlit
diff --git a/graphql-wai/graphql-wai.cabal b/graphql-wai/graphql-wai.cabal
index 16b423a..10caf71 100644
--- a/graphql-wai/graphql-wai.cabal
+++ b/graphql-wai/graphql-wai.cabal
@@ -1,6 +1,8 @@
--- This file has been generated from package.yaml by hpack version 0.15.0.
+-- This file has been generated from package.yaml by hpack version 0.20.0.
 --
 -- see: https://github.com/sol/hpack
+--
+-- hash: 12d030d800c1c036c89a9464dd8de8b05f9f6dc28e0faae9d2b105b2b120460e
 
 name:           graphql-wai
 version:        0.1.0
@@ -22,15 +24,17 @@ library
   default-extensions: NoImplicitPrelude OverloadedStrings RecordWildCards TypeApplications
   ghc-options: -Wall -fno-warn-redundant-constraints -Werror
   build-depends:
-      base >= 4.9 && < 5
-    , protolude
+      aeson
+    , base >=4.9 && <5
     , exceptions
-    , wai
-    , http-types
     , graphql-api
-    , aeson
+    , http-types
+    , protolude
+    , wai
   exposed-modules:
       GraphQL.Wai
+  other-modules:
+      Paths_graphql_wai
   default-language: Haskell2010
 
 test-suite wai-tests
@@ -41,13 +45,15 @@ test-suite wai-tests
   default-extensions: NoImplicitPrelude OverloadedStrings RecordWildCards TypeApplications
   ghc-options: -Wall -fno-warn-redundant-constraints -Werror
   build-depends:
-      base >= 4.9 && < 5
-    , protolude
+      aeson
+    , base >=4.9 && <5
     , exceptions
-    , wai
-    , http-types
     , graphql-api
-    , aeson
-    , wai-extra
     , graphql-wai
+    , http-types
+    , protolude
+    , wai
+    , wai-extra
+  other-modules:
+      Paths_graphql_wai
   default-language: Haskell2010
diff --git a/src/GraphQL/Internal/Execution.hs b/src/GraphQL/Internal/Execution.hs
index f793fae..2203917 100644
--- a/src/GraphQL/Internal/Execution.hs
+++ b/src/GraphQL/Internal/Execution.hs
@@ -51,7 +51,7 @@ import GraphQL.Internal.Validation
 --     * Return {operation}.
 getOperation :: QueryDocument value -> Maybe Name -> Either ExecutionError (Operation value)
 getOperation (LoneAnonymousOperation op) Nothing = pure op
-getOperation (MultipleOperations ops) (Just name) = note (NoSuchOperation name) (Map.lookup name ops)
+getOperation (MultipleOperations ops) (Just name) = note (NoSuchOperation name) (Map.lookup (pure name) ops)
 getOperation (MultipleOperations ops) Nothing =
   case toList ops of
     [op] -> pure op
diff --git a/src/GraphQL/Internal/Syntax/AST.hs b/src/GraphQL/Internal/Syntax/AST.hs
index 82f68e3..71c15b2 100644
--- a/src/GraphQL/Internal/Syntax/AST.hs
+++ b/src/GraphQL/Internal/Syntax/AST.hs
@@ -49,10 +49,10 @@ module GraphQL.Internal.Syntax.AST
 import Protolude
 
 --import Data.String (IsString(..))
-import Test.QuickCheck (Arbitrary(..), elements, listOf, oneof)
+import Test.QuickCheck (Arbitrary(..), listOf, oneof)
 
 import GraphQL.Internal.Arbitrary (arbitraryText)
-import GraphQL.Internal.Name (HasName(getName), Name(unName, Name), unsafeMakeName)
+import GraphQL.Internal.Name (Name)
 
 -- * Documents
 
@@ -76,11 +76,12 @@ data OperationDefinition
   | AnonymousQuery SelectionSet
   deriving (Eq,Show)
 
-data Node = Node Name [VariableDefinition] [Directive] SelectionSet
+data Node = Node (Maybe Name) [VariableDefinition] [Directive] SelectionSet
             deriving (Eq,Show)
 
-instance HasName Node where
-  getName (Node name _ _ _) = name
+--
+getNodeName :: Node -> Maybe Name
+getNodeName (Node maybeName _ _ _) = maybeName
 
 data VariableDefinition = VariableDefinition Variable Type (Maybe DefaultValue)
                           deriving (Eq,Show)
diff --git a/src/GraphQL/Internal/Syntax/Encoder.hs b/src/GraphQL/Internal/Syntax/Encoder.hs
index 6891790..18fda0f 100644
--- a/src/GraphQL/Internal/Syntax/Encoder.hs
+++ b/src/GraphQL/Internal/Syntax/Encoder.hs
@@ -30,11 +30,15 @@ operationDefinition (AST.Mutation n) = "mutation " <> node n
 operationDefinition (AST.AnonymousQuery ss) = selectionSet ss
 
 node :: AST.Node -> Text
-node (AST.Node name vds ds ss) =
+node (AST.Node (Just name) vds ds ss) =
      unName name
   <> optempty variableDefinitions vds
   <> optempty directives ds
   <> selectionSet ss
+node (AST.Node Nothing vds ds ss) =
+     optempty variableDefinitions vds
+  <> optempty directives ds
+  <> selectionSet ss
 
 variableDefinitions :: [AST.VariableDefinition] -> Text
 variableDefinitions = parensCommas variableDefinition
diff --git a/src/GraphQL/Internal/Syntax/Parser.hs b/src/GraphQL/Internal/Syntax/Parser.hs
index 34b7db6..1c3d6d0 100644
--- a/src/GraphQL/Internal/Syntax/Parser.hs
+++ b/src/GraphQL/Internal/Syntax/Parser.hs
@@ -52,7 +52,7 @@ operationDefinition =
   <?> "operationDefinition error!"
 
 node :: Parser AST.Node
-node = AST.Node <$> optempty nameParser
+node = AST.Node <$> optional nameParser
                 <*> optempty variableDefinitions
                 <*> optempty directives
                 <*> selectionSet
diff --git a/src/GraphQL/Internal/Validation.hs b/src/GraphQL/Internal/Validation.hs
index e7e0372..1c4d7f7 100644
--- a/src/GraphQL/Internal/Validation.hs
+++ b/src/GraphQL/Internal/Validation.hs
@@ -123,7 +123,7 @@ getSelectionSet (Mutation _ _ ss) = ss
 -- | Type alias for 'Query' and 'Mutation' constructors of 'Operation'.
 type OperationType value = VariableDefinitions -> Directives value -> SelectionSetByType value -> Operation value
 
-type Operations value = Map Name (Operation value)
+type Operations value = Map (Maybe Name) (Operation value)
 
 -- | Turn a parsed document into a known valid one.
 --
@@ -132,9 +132,9 @@ type Operations value = Map Name (Operation value)
 validate :: Schema -> AST.QueryDocument -> Either (NonEmpty ValidationError) (QueryDocument VariableValue)
 validate schema (AST.QueryDocument defns) = runValidator $ do
   let (operations, fragments) = splitBy splitDefns defns
-  let (anonymous, named) = splitBy splitOps operations
+  let (anonymous, maybeNamed) = splitBy splitOps operations
   (frags, visitedFrags) <- resolveFragmentDefinitions =<< validateFragmentDefinitions schema fragments
-  case (anonymous, named) of
+  case (anonymous, maybeNamed) of
     ([], ops) -> do
       (validOps, usedFrags) <- runStateT (validateOperations schema frags ops) mempty
       assertAllFragmentsUsed frags (visitedFrags <> usedFrags)
@@ -146,7 +146,7 @@ validate schema (AST.QueryDocument defns) = runValidator $ do
       validValuesSS <- validateValues ss
       resolvedValuesSS <- resolveVariables emptyVariableDefinitions validValuesSS
       pure (LoneAnonymousOperation (Query emptyVariableDefinitions emptyDirectives resolvedValuesSS))
-    _ -> throwE (MixedAnonymousOperations (length anonymous) (map fst named))
+    _ -> throwE (MixedAnonymousOperations (length anonymous) (map fst maybeNamed))
 
   where
     splitBy :: (a -> Either b c) -> [a] -> ([b], [c])
@@ -156,17 +156,17 @@ validate schema (AST.QueryDocument defns) = runValidator $ do
     splitDefns (AST.DefinitionFragment frag) = Right frag
 
     splitOps (AST.AnonymousQuery ss) = Left ss
-    splitOps (AST.Query node@(AST.Node name _ _ _)) = Right (name, (Query, node))
-    splitOps (AST.Mutation node@(AST.Node name _ _ _)) = Right (name, (Mutation, node))
+    splitOps (AST.Query node@(AST.Node maybeName _ _ _)) = Right (maybeName, (Query, node))
+    splitOps (AST.Mutation node@(AST.Node maybeName _ _ _)) = Right (maybeName, (Mutation, node))
 
-    assertAllFragmentsUsed :: Fragments value -> Set Name -> Validation ()
+    assertAllFragmentsUsed :: Fragments value -> Set (Maybe Name) -> Validation ()
     assertAllFragmentsUsed fragments used =
-      let unused = Map.keysSet fragments `Set.difference` used
+      let unused = ( Set.map pure (Map.keysSet fragments)) `Set.difference` used
       in unless (Set.null unused) (throwE (UnusedFragments unused))
 
 -- * Operations
 
-validateOperations :: Schema -> Fragments AST.Value -> [(Name, (OperationType AST.Value, AST.Node))] -> StateT (Set Name) Validation (Operations AST.Value)
+validateOperations :: Schema -> Fragments AST.Value -> [(Maybe Name, (OperationType AST.Value, AST.Node))] -> StateT (Set (Maybe Name)) Validation (Operations AST.Value)
 validateOperations schema fragments ops = do
   deduped <- lift (mapErrors DuplicateOperation (makeMap ops))
   traverse validateNode deduped
@@ -219,7 +219,7 @@ validateOperation (Mutation vars directives selectionSet) = do
 -- We do this /before/ validating the values (since that's much easier once
 -- everything is in a nice structure and away from the AST), which means we
 -- can't yet evaluate directives.
-validateSelectionSet :: Schema -> Fragments AST.Value -> [AST.Selection] -> StateT (Set Name) Validation (SelectionSetByType AST.Value)
+validateSelectionSet :: Schema -> Fragments AST.Value -> [AST.Selection] -> StateT (Set (Maybe Name)) Validation (SelectionSetByType AST.Value)
 validateSelectionSet schema fragments selections = do
   unresolved <- lift $ traverse (validateSelection schema) selections
   resolved <- traverse (resolveSelection fragments) unresolved
@@ -508,14 +508,14 @@ validateSelection schema selection =
 -- We're doing a standard depth-first traversal of fragment references, where
 -- references are by name, so the set of names can be thought of as a record
 -- of visited references.
-resolveSelection :: Fragments a -> Selection' UnresolvedFragmentSpread a -> StateT (Set Name) Validation (Selection' FragmentSpread a)
+resolveSelection :: Fragments a -> Selection' UnresolvedFragmentSpread a -> StateT (Set (Maybe Name)) Validation (Selection' FragmentSpread a)
 resolveSelection fragments = traverseFragmentSpreads resolveFragmentSpread
   where
     resolveFragmentSpread (UnresolvedFragmentSpread name directive) = do
       case Map.lookup name fragments of
         Nothing -> lift (throwE (NoSuchFragment name))
         Just fragment -> do
-          modify (Set.insert name)
+          modify (Set.insert (pure name))
           pure (FragmentSpread name directive fragment)
 
 -- * Fragment definitions
@@ -577,7 +577,7 @@ validateTypeCondition schema (NamedType typeCond) =
 --
 -- <https://facebook.github.io/graphql/#sec-Fragment-spread-target-defined>
 -- <https://facebook.github.io/graphql/#sec-Fragment-spreads-must-not-form-cycles>
-resolveFragmentDefinitions :: Map Name (FragmentDefinition UnresolvedFragmentSpread value) -> Validation (Fragments value, Set Name)
+resolveFragmentDefinitions :: Map Name (FragmentDefinition UnresolvedFragmentSpread value) -> Validation (Fragments value, Set (Maybe Name))
 resolveFragmentDefinitions allFragments =
   splitResult <$> traverse resolveFragment allFragments
   where
@@ -595,12 +595,12 @@ resolveFragmentDefinitions allFragments =
       FragmentDefinition name cond directives <$> traverse (traverseFragmentSpreads resolveSpread) ss
 
     resolveSpread (UnresolvedFragmentSpread name directives) = do
-      visited <- Set.member name <$> get
+      visited <- Set.member (pure name) <$> get
       when visited (lift (throwE (CircularFragmentSpread name)))
       case Map.lookup name allFragments of
         Nothing -> lift (throwE (NoSuchFragment name))
         Just definition -> do
-          modify (Set.insert name)
+          modify (Set.insert (pure name))
           FragmentSpread name directives <$> resolveFragment' definition
 
 -- * Arguments
@@ -727,12 +727,12 @@ data ValidationError
   -- with the given name.
   --
   -- <https://facebook.github.io/graphql/#sec-Operation-Name-Uniqueness>
-  = DuplicateOperation Name
+  = DuplicateOperation (Maybe Name)
   -- | 'MixedAnonymousOperations' means there was more than one operation
   -- defined in a document with an anonymous operation.
   --
   -- <https://facebook.github.io/graphql/#sec-Lone-Anonymous-Operation>
-  | MixedAnonymousOperations Int [Name]
+  | MixedAnonymousOperations Int [Maybe Name]
   -- | 'DuplicateArgument' means that multiple copies of the same argument was
   -- given to the same field, directive, etc.
   | DuplicateArgument Name
@@ -755,7 +755,7 @@ data ValidationError
   | CircularFragmentSpread Name
   -- | 'UnusedFragments' means that fragments were defined that weren't used.
   -- <https://facebook.github.io/graphql/#sec-Fragments-Must-Be-Used>
-  | UnusedFragments (Set Name)
+  | UnusedFragments (Set (Maybe Name))
   -- | Variables were defined without being used.
   -- <https://facebook.github.io/graphql/#sec-All-Variables-Used>
   | UnusedVariables (Set Variable)
@@ -777,10 +777,10 @@ data ValidationError
   deriving (Eq, Show)
 
 instance GraphQLError ValidationError where
-  formatError (DuplicateOperation name) = "More than one operation named '" <> show name <> "'"
-  formatError (MixedAnonymousOperations n names)
-    | n > 1 && null names = "Multiple anonymous operations defined. Found " <> show n
-    | otherwise = "Document contains both anonymous operations (" <> show n <> ") and named operations (" <> show names <> ")"
+  formatError (DuplicateOperation maybeName) = "More than one operation named '" <> show maybeName <> "'"
+  formatError (MixedAnonymousOperations n maybeNames)
+    | n > 1 && null maybeNames = "Multiple anonymous operations defined. Found " <> show n
+    | otherwise = "Document contains both anonymous operations (" <> show n <> ") and named operations (" <> show maybeNames <> ")"
   formatError (DuplicateArgument name) = "More than one argument named '" <> show name <> "'"
   formatError (DuplicateFragmentDefinition name) = "More than one fragment named '" <> show name <> "'"
   formatError (NoSuchFragment name) = "No fragment named '" <> show name <> "'"
diff --git a/tests/ASTTests.hs b/tests/ASTTests.hs
index 0a47e6a..64042d1 100644
--- a/tests/ASTTests.hs
+++ b/tests/ASTTests.hs
@@ -121,7 +121,7 @@ tests = testSpec "AST" $ do
                          ])
                      , AST.DefinitionOperation
                        (AST.Query
-                        (AST.Node "getName" [] []
+                        (AST.Node (pure "getName") [] []
                          [ AST.SelectionField
                            (AST.Field Nothing dog [] []
                             [ AST.SelectionField
@@ -145,7 +145,7 @@ tests = testSpec "AST" $ do
       let expected = AST.QueryDocument
                      [ AST.DefinitionOperation
                          (AST.Query
-                           (AST.Node "houseTrainedQuery"
+                           (AST.Node (pure "houseTrainedQuery")
                             [ AST.VariableDefinition
                                 (AST.Variable "atOtherHomes")
                                 (AST.TypeNamed (AST.NamedType "Boolean"))
diff --git a/tests/ValidationTests.hs b/tests/ValidationTests.hs
index 6b1f24c..c9a365b 100644
--- a/tests/ValidationTests.hs
+++ b/tests/ValidationTests.hs
@@ -19,8 +19,8 @@ import GraphQL.Internal.Validation
   , getErrors
   )
 
-me :: Name
-me = "me"
+me :: Maybe Name
+me = pure "me"
 
 someName :: Name
 someName = "name"