diff options
Diffstat (limited to 'src/Language/GraphQL/AST')
| -rw-r--r-- | src/Language/GraphQL/AST/DirectiveLocation.hs | 36 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Document.hs | 108 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Encoder.hs | 223 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Lexer.hs | 8 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Parser.hs | 368 |
5 files changed, 401 insertions, 342 deletions
diff --git a/src/Language/GraphQL/AST/DirectiveLocation.hs b/src/Language/GraphQL/AST/DirectiveLocation.hs index c38c9ff..511225f 100644 --- a/src/Language/GraphQL/AST/DirectiveLocation.hs +++ b/src/Language/GraphQL/AST/DirectiveLocation.hs @@ -2,6 +2,8 @@ v. 2.0. If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. -} +{-# LANGUAGE Safe #-} + -- | Various parts of a GraphQL document can be annotated with directives. -- This module describes locations in a document where directives can appear. module Language.GraphQL.AST.DirectiveLocation @@ -16,7 +18,13 @@ module Language.GraphQL.AST.DirectiveLocation data DirectiveLocation = ExecutableDirectiveLocation ExecutableDirectiveLocation | TypeSystemDirectiveLocation TypeSystemDirectiveLocation - deriving (Eq, Show) + deriving Eq + +instance Show DirectiveLocation where + show (ExecutableDirectiveLocation directiveLocation) = + show directiveLocation + show (TypeSystemDirectiveLocation directiveLocation) = + show directiveLocation -- | Where directives can appear in an executable definition, like a query. data ExecutableDirectiveLocation @@ -27,7 +35,16 @@ data ExecutableDirectiveLocation | FragmentDefinition | FragmentSpread | InlineFragment - deriving (Eq, Show) + deriving Eq + +instance Show ExecutableDirectiveLocation where + show Query = "QUERY" + show Mutation = "MUTATION" + show Subscription = "SUBSCRIPTION" + show Field = "FIELD" + show FragmentDefinition = "FRAGMENT_DEFINITION" + show FragmentSpread = "FRAGMENT_SPREAD" + show InlineFragment = "INLINE_FRAGMENT" -- | Where directives can appear in a type system definition. data TypeSystemDirectiveLocation @@ -42,4 +59,17 @@ data TypeSystemDirectiveLocation | EnumValue | InputObject | InputFieldDefinition - deriving (Eq, Show) + deriving Eq + +instance Show TypeSystemDirectiveLocation where + show Schema = "SCHEMA" + show Scalar = "SCALAR" + show Object = "OBJECT" + show FieldDefinition = "FIELD_DEFINITION" + show ArgumentDefinition = "ARGUMENT_DEFINITION" + show Interface = "INTERFACE" + show Union = "UNION" + show Enum = "ENUM" + show EnumValue = "ENUM_VALUE" + show InputObject = "INPUT_OBJECT" + show InputFieldDefinition = "INPUT_FIELD_DEFINITION" diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index 72d39bb..b30271c 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -1,12 +1,15 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE Safe #-} -- | This module defines an abstract syntax tree for the @GraphQL@ language. It -- follows closely the structure given in the specification. Please refer to -- <https://facebook.github.io/graphql/ Facebook's GraphQL Specification>. -- for more information. module Language.GraphQL.AST.Document - ( Alias - , Argument(..) + ( Argument(..) , ArgumentsDefinition(..) , ConstValue(..) , Definition(..) @@ -15,13 +18,17 @@ module Language.GraphQL.AST.Document , Document , EnumValueDefinition(..) , ExecutableDefinition(..) + , Field(..) , FieldDefinition(..) , FragmentDefinition(..) + , FragmentSpread(..) , ImplementsInterfaces(..) + , InlineFragment(..) , InputValueDefinition(..) , Location(..) , Name , NamedType + , Node(..) , NonNullType(..) , ObjectField(..) , OperationDefinition(..) @@ -47,7 +54,7 @@ import Data.Int (Int32) import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) import qualified Data.Text as Text -import Language.GraphQL.AST.DirectiveLocation +import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation) -- * Language @@ -68,6 +75,15 @@ instance Ord Location where | thisLine > thatLine = GT | otherwise = compare thisColumn thatColumn +-- | Contains some tree node with a location. +data Node a = Node + { node :: a + , location :: Location + } deriving (Eq, Show) + +instance Functor Node where + fmap f Node{..} = Node (f node) location + -- ** Document -- | GraphQL document. @@ -116,10 +132,15 @@ type SelectionSet = NonEmpty Selection -- | Field selection. type SelectionSetOpt = [Selection] --- | Selection is a single entry in a selection set. It can be a single field, --- fragment spread or inline fragment. --- --- The only required property of a field is its name. Optionally it can also +-- | Selection is a single entry in a selection set. It can be a single 'Field', +-- 'FragmentSpread' or an 'InlineFragment'. +data Selection + = FieldSelection Field + | FragmentSpreadSelection FragmentSpread + | InlineFragmentSelection InlineFragment + deriving (Eq, Show) + +-- | The only required property of a field is its name. Optionally it can also -- have an alias, arguments, directives and a list of subfields. -- -- In the following query "user" is a field with two subfields, "id" and "name": @@ -132,8 +153,27 @@ type SelectionSetOpt = [Selection] -- } -- } -- @ +data Field = + Field (Maybe Name) Name [Argument] [Directive] SelectionSetOpt Location + deriving (Eq, Show) + +-- | Inline fragments don't have any name and the type condition ("on UserType") +-- is optional. -- --- A fragment spread refers to a fragment defined outside the operation and is +-- @ +-- { +-- user { +-- ... on UserType { +-- id +-- name +-- } +-- } +-- @ +data InlineFragment = InlineFragment + (Maybe TypeCondition) [Directive] SelectionSet Location + deriving (Eq, Show) + +-- | A fragment spread refers to a fragment defined outside the operation and is -- expanded at the execution time. -- -- @ @@ -148,23 +188,7 @@ type SelectionSetOpt = [Selection] -- name -- } -- @ --- --- Inline fragments are similar but they don't have any name and the type --- condition ("on UserType") is optional. --- --- @ --- { --- user { --- ... on UserType { --- id --- name --- } --- } --- @ -data Selection - = Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt - | FragmentSpread Name [Directive] - | InlineFragment (Maybe TypeCondition) [Directive] SelectionSet +data FragmentSpread = FragmentSpread Name [Directive] Location deriving (Eq, Show) -- ** Arguments @@ -180,23 +204,7 @@ data Selection -- @ -- -- Here "id" is an argument for the field "user" and its value is 4. -data Argument = Argument Name Value deriving (Eq,Show) - --- ** Field Alias - --- | Alternative field name. --- --- @ --- { --- smallPic: profilePic(size: 64) --- bigPic: profilePic(size: 1024) --- } --- @ --- --- Here "smallPic" and "bigPic" are aliases for the same field, "profilePic", --- used to distinquish between profile pictures with different arguments --- (sizes). -type Alias = Name +data Argument = Argument Name (Node Value) Location deriving (Eq, Show) -- ** Fragments @@ -238,8 +246,11 @@ data ConstValue -- | Key-value pair. -- -- A list of 'ObjectField's represents a GraphQL object type. -data ObjectField a = ObjectField Name a - deriving (Eq, Show) +data ObjectField a = ObjectField + { name :: Name + , value :: Node a + , location :: Location + } deriving (Eq, Show) -- ** Variables @@ -259,7 +270,8 @@ data ObjectField a = ObjectField Name a -- -- Variables are usually passed along with the query, but not in the query -- itself. They make queries reusable. -data VariableDefinition = VariableDefinition Name Type (Maybe ConstValue) +data VariableDefinition = + VariableDefinition Name Type (Maybe (Node ConstValue)) Location deriving (Eq, Show) -- ** Type References @@ -286,7 +298,7 @@ data NonNullType -- -- Directives begin with "@", can accept arguments, and can be applied to the -- most GraphQL elements, providing additional information. -data Directive = Directive Name [Argument] deriving (Eq, Show) +data Directive = Directive Name [Argument] Location deriving (Eq, Show) -- * Type System @@ -485,8 +497,8 @@ instance Monoid ArgumentsDefinition where -- @ -- -- The input type "Point2D" contains two value definitions: "x" and "y". -data InputValueDefinition - = InputValueDefinition Description Name Type (Maybe ConstValue) [Directive] +data InputValueDefinition = InputValueDefinition + Description Name Type (Maybe (Node ConstValue)) [Directive] deriving (Eq, Show) -- ** Unions diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs index ba89d36..9ba51b8 100644 --- a/src/Language/GraphQL/AST/Encoder.hs +++ b/src/Language/GraphQL/AST/Encoder.hs @@ -1,6 +1,8 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE Safe #-} -- | This module defines a minifier and a printer for the @GraphQL@ language. module Language.GraphQL.AST.Encoder @@ -25,7 +27,7 @@ import Data.Text.Lazy.Builder (Builder) import qualified Data.Text.Lazy.Builder as Builder import Data.Text.Lazy.Builder.Int (decimal, hexadecimal) import Data.Text.Lazy.Builder.RealFloat (realFloat) -import Language.GraphQL.AST.Document +import qualified Language.GraphQL.AST.Document as Full -- | Instructs the encoder whether the GraphQL document should be minified or -- pretty printed. @@ -44,77 +46,78 @@ minified :: Formatter minified = Minified -- | Converts a Document' into a string. -document :: Formatter -> Document -> Lazy.Text +document :: Formatter -> Full.Document -> Lazy.Text document formatter defs | Pretty _ <- formatter = Lazy.Text.intercalate "\n" encodeDocument | Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n' where encodeDocument = foldr executableDefinition [] defs - executableDefinition (ExecutableDefinition executableDefinition') acc = + executableDefinition (Full.ExecutableDefinition executableDefinition') acc = definition formatter executableDefinition' : acc executableDefinition _ acc = acc --- | Converts a t'ExecutableDefinition' into a string. -definition :: Formatter -> ExecutableDefinition -> Lazy.Text +-- | Converts a t'Full.ExecutableDefinition' into a string. +definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text definition formatter x | Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n' | Minified <- formatter = encodeDefinition x where - encodeDefinition (DefinitionOperation operation) + encodeDefinition (Full.DefinitionOperation operation) = operationDefinition formatter operation - encodeDefinition (DefinitionFragment fragment) + encodeDefinition (Full.DefinitionFragment fragment) = fragmentDefinition formatter fragment --- | Converts a 'OperationDefinition into a string. -operationDefinition :: Formatter -> OperationDefinition -> Lazy.Text +-- | Converts a 'Full.OperationDefinition into a string. +operationDefinition :: Formatter -> Full.OperationDefinition -> Lazy.Text operationDefinition formatter = \case - SelectionSet sels _ -> selectionSet formatter sels - OperationDefinition Query name vars dirs sels _ -> - "query " <> node formatter name vars dirs sels - OperationDefinition Mutation name vars dirs sels _ -> - "mutation " <> node formatter name vars dirs sels - OperationDefinition Subscription name vars dirs sels _ -> - "subscription " <> node formatter name vars dirs sels - --- | Converts a Query or Mutation into a string. -node :: Formatter -> - Maybe Name -> - [VariableDefinition] -> - [Directive] -> - SelectionSet -> - Lazy.Text -node formatter name vars dirs sels - = Lazy.Text.fromStrict (fold name) - <> optempty (variableDefinitions formatter) vars - <> optempty (directives formatter) dirs - <> eitherFormat formatter " " mempty - <> selectionSet formatter sels - -variableDefinitions :: Formatter -> [VariableDefinition] -> Lazy.Text + Full.SelectionSet sels _ -> selectionSet formatter sels + Full.OperationDefinition Full.Query name vars dirs sels _ -> + "query " <> root name vars dirs sels + Full.OperationDefinition Full.Mutation name vars dirs sels _ -> + "mutation " <> root name vars dirs sels + Full.OperationDefinition Full.Subscription name vars dirs sels _ -> + "subscription " <> root name vars dirs sels + where + -- | Converts a Query or Mutation into a string. + root :: Maybe Full.Name -> + [Full.VariableDefinition] -> + [Full.Directive] -> + Full.SelectionSet -> + Lazy.Text + root name vars dirs sels + = Lazy.Text.fromStrict (fold name) + <> optempty (variableDefinitions formatter) vars + <> optempty (directives formatter) dirs + <> eitherFormat formatter " " mempty + <> selectionSet formatter sels + +variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Lazy.Text variableDefinitions formatter = parensCommas formatter $ variableDefinition formatter -variableDefinition :: Formatter -> VariableDefinition -> Lazy.Text -variableDefinition formatter (VariableDefinition var ty defaultValue') - = variable var +variableDefinition :: Formatter -> Full.VariableDefinition -> Lazy.Text +variableDefinition formatter variableDefinition' = + let Full.VariableDefinition variableName variableType defaultValue' _ = + variableDefinition' + in variable variableName <> eitherFormat formatter ": " ":" - <> type' ty - <> maybe mempty (defaultValue formatter) defaultValue' + <> type' variableType + <> maybe mempty (defaultValue formatter) (Full.node <$> defaultValue') -defaultValue :: Formatter -> ConstValue -> Lazy.Text +defaultValue :: Formatter -> Full.ConstValue -> Lazy.Text defaultValue formatter val = eitherFormat formatter " = " "=" <> value formatter (fromConstValue val) -variable :: Name -> Lazy.Text +variable :: Full.Name -> Lazy.Text variable var = "$" <> Lazy.Text.fromStrict var -selectionSet :: Formatter -> SelectionSet -> Lazy.Text +selectionSet :: Formatter -> Full.SelectionSet -> Lazy.Text selectionSet formatter = bracesList formatter (selection formatter) . NonEmpty.toList -selectionSetOpt :: Formatter -> SelectionSetOpt -> Lazy.Text +selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text selectionSetOpt formatter = bracesList formatter $ selection formatter indentSymbol :: Lazy.Text @@ -123,15 +126,15 @@ indentSymbol = " " indent :: (Integral a) => a -> Lazy.Text indent indentation = Lazy.Text.replicate (fromIntegral indentation) indentSymbol -selection :: Formatter -> Selection -> Lazy.Text +selection :: Formatter -> Full.Selection -> Lazy.Text selection formatter = Lazy.Text.append indent' . encodeSelection where - encodeSelection (Field alias name args directives' selections) = - field incrementIndent alias name args directives' selections - encodeSelection (InlineFragment typeCondition directives' selections) = - inlineFragment incrementIndent typeCondition directives' selections - encodeSelection (FragmentSpread name directives') = - fragmentSpread incrementIndent name directives' + encodeSelection (Full.FieldSelection fieldSelection) = + field incrementIndent fieldSelection + encodeSelection (Full.InlineFragmentSelection fragmentSelection) = + inlineFragment incrementIndent fragmentSelection + encodeSelection (Full.FragmentSpreadSelection fragmentSelection) = + fragmentSpread incrementIndent fragmentSelection incrementIndent | Pretty indentation <- formatter = Pretty $ indentation + 1 | otherwise = Minified @@ -142,15 +145,9 @@ selection formatter = Lazy.Text.append indent' . encodeSelection colon :: Formatter -> Lazy.Text colon formatter = eitherFormat formatter ": " ":" --- | Converts Field into a string -field :: Formatter -> - Maybe Name -> - Name -> - [Argument] -> - [Directive] -> - [Selection] -> - Lazy.Text -field formatter alias name args dirs set +-- | Converts Field into a string. +field :: Formatter -> Full.Field -> Lazy.Text +field formatter (Full.Field alias name args dirs set _) = optempty prependAlias (fold alias) <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args @@ -161,36 +158,32 @@ field formatter alias name args dirs set selectionSetOpt' = (eitherFormat formatter " " "" <>) . selectionSetOpt formatter -arguments :: Formatter -> [Argument] -> Lazy.Text +arguments :: Formatter -> [Full.Argument] -> Lazy.Text arguments formatter = parensCommas formatter $ argument formatter -argument :: Formatter -> Argument -> Lazy.Text -argument formatter (Argument name value') +argument :: Formatter -> Full.Argument -> Lazy.Text +argument formatter (Full.Argument name value' _) = Lazy.Text.fromStrict name <> colon formatter - <> value formatter value' + <> value formatter (Full.node value') -- * Fragments -fragmentSpread :: Formatter -> Name -> [Directive] -> Lazy.Text -fragmentSpread formatter name directives' +fragmentSpread :: Formatter -> Full.FragmentSpread -> Lazy.Text +fragmentSpread formatter (Full.FragmentSpread name directives' _) = "..." <> Lazy.Text.fromStrict name <> optempty (directives formatter) directives' -inlineFragment :: - Formatter -> - Maybe TypeCondition -> - [Directive] -> - SelectionSet -> - Lazy.Text -inlineFragment formatter tc dirs sels = "... on " - <> Lazy.Text.fromStrict (fold tc) - <> directives formatter dirs +inlineFragment :: Formatter -> Full.InlineFragment -> Lazy.Text +inlineFragment formatter (Full.InlineFragment typeCondition directives' selections _) + = "... on " + <> Lazy.Text.fromStrict (fold typeCondition) + <> directives formatter directives' <> eitherFormat formatter " " mempty - <> selectionSet formatter sels + <> selectionSet formatter selections -fragmentDefinition :: Formatter -> FragmentDefinition -> Lazy.Text -fragmentDefinition formatter (FragmentDefinition name tc dirs sels _) +fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Lazy.Text +fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels _) = "fragment " <> Lazy.Text.fromStrict name <> " on " <> Lazy.Text.fromStrict tc <> optempty (directives formatter) dirs @@ -199,39 +192,39 @@ fragmentDefinition formatter (FragmentDefinition name tc dirs sels _) -- * Miscellaneous --- | Converts a 'Directive' into a string. -directive :: Formatter -> Directive -> Lazy.Text -directive formatter (Directive name args) +-- | Converts a 'Full.Directive' into a string. +directive :: Formatter -> Full.Directive -> Lazy.Text +directive formatter (Full.Directive name args _) = "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args -directives :: Formatter -> [Directive] -> Lazy.Text +directives :: Formatter -> [Full.Directive] -> Lazy.Text directives Minified = spaces (directive Minified) directives formatter = Lazy.Text.cons ' ' . spaces (directive formatter) --- | Converts a 'Value' into a string. -value :: Formatter -> Value -> Lazy.Text -value _ (Variable x) = variable x -value _ (Int x) = Builder.toLazyText $ decimal x -value _ (Float x) = Builder.toLazyText $ realFloat x -value _ (Boolean x) = booleanValue x -value _ Null = "null" -value formatter (String string) = stringValue formatter string -value _ (Enum x) = Lazy.Text.fromStrict x -value formatter (List x) = listValue formatter x -value formatter (Object x) = objectValue formatter x - -fromConstValue :: ConstValue -> Value -fromConstValue (ConstInt x) = Int x -fromConstValue (ConstFloat x) = Float x -fromConstValue (ConstBoolean x) = Boolean x -fromConstValue ConstNull = Null -fromConstValue (ConstString string) = String string -fromConstValue (ConstEnum x) = Enum x -fromConstValue (ConstList x) = List $ fromConstValue <$> x -fromConstValue (ConstObject x) = Object $ fromConstObjectField <$> x +-- | Converts a 'Full.Value' into a string. +value :: Formatter -> Full.Value -> Lazy.Text +value _ (Full.Variable x) = variable x +value _ (Full.Int x) = Builder.toLazyText $ decimal x +value _ (Full.Float x) = Builder.toLazyText $ realFloat x +value _ (Full.Boolean x) = booleanValue x +value _ Full.Null = "null" +value formatter (Full.String string) = stringValue formatter string +value _ (Full.Enum x) = Lazy.Text.fromStrict x +value formatter (Full.List x) = listValue formatter x +value formatter (Full.Object x) = objectValue formatter x + +fromConstValue :: Full.ConstValue -> Full.Value +fromConstValue (Full.ConstInt x) = Full.Int x +fromConstValue (Full.ConstFloat x) = Full.Float x +fromConstValue (Full.ConstBoolean x) = Full.Boolean x +fromConstValue Full.ConstNull = Full.Null +fromConstValue (Full.ConstString string) = Full.String string +fromConstValue (Full.ConstEnum x) = Full.Enum x +fromConstValue (Full.ConstList x) = Full.List $ fromConstValue <$> x +fromConstValue (Full.ConstObject x) = Full.Object $ fromConstObjectField <$> x where - fromConstObjectField (ObjectField key value') = - ObjectField key $ fromConstValue value' + fromConstObjectField Full.ObjectField{value = value', ..} = + Full.ObjectField name (fromConstValue <$> value') location booleanValue :: Bool -> Lazy.Text booleanValue True = "true" @@ -288,10 +281,10 @@ escape char' where unicode prefix = mappend (Builder.fromString prefix) . (hexadecimal . ord) -listValue :: Formatter -> [Value] -> Lazy.Text +listValue :: Formatter -> [Full.Value] -> Lazy.Text listValue formatter = bracketsCommas formatter $ value formatter -objectValue :: Formatter -> [ObjectField Value] -> Lazy.Text +objectValue :: Formatter -> [Full.ObjectField Full.Value] -> Lazy.Text objectValue formatter = intercalate $ objectField formatter where intercalate f @@ -299,22 +292,22 @@ objectValue formatter = intercalate $ objectField formatter . Lazy.Text.intercalate (eitherFormat formatter ", " ",") . fmap f -objectField :: Formatter -> ObjectField Value -> Lazy.Text -objectField formatter (ObjectField name value') = +objectField :: Formatter -> Full.ObjectField Full.Value -> Lazy.Text +objectField formatter (Full.ObjectField name (Full.Node value' _) _) = Lazy.Text.fromStrict name <> colon formatter <> value formatter value' --- | Converts a 'Type' a type into a string. -type' :: Type -> Lazy.Text -type' (TypeNamed x) = Lazy.Text.fromStrict x -type' (TypeList x) = listType x -type' (TypeNonNull x) = nonNullType x +-- | Converts a 'Full.Type' a type into a string. +type' :: Full.Type -> Lazy.Text +type' (Full.TypeNamed x) = Lazy.Text.fromStrict x +type' (Full.TypeList x) = listType x +type' (Full.TypeNonNull x) = nonNullType x -listType :: Type -> Lazy.Text +listType :: Full.Type -> Lazy.Text listType x = brackets (type' x) -nonNullType :: NonNullType -> Lazy.Text -nonNullType (NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!" -nonNullType (NonNullTypeList x) = listType x <> "!" +nonNullType :: Full.NonNullType -> Lazy.Text +nonNullType (Full.NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!" +nonNullType (Full.NonNullTypeList x) = listType x <> "!" -- * Internal diff --git a/src/Language/GraphQL/AST/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs index 17d3f9c..ecefaf6 100644 --- a/src/Language/GraphQL/AST/Lexer.hs +++ b/src/Language/GraphQL/AST/Lexer.hs @@ -92,16 +92,16 @@ dollar :: Parser T.Text dollar = symbol "$" -- | Parser for "@". -at :: Parser Text -at = symbol "@" +at :: Parser () +at = symbol "@" >> pure () -- | Parser for "&". amp :: Parser T.Text amp = symbol "&" -- | Parser for ":". -colon :: Parser T.Text -colon = symbol ":" +colon :: Parser () +colon = symbol ":" >> pure () -- | Parser for "=". equals :: Parser T.Text diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs index 7bc51cb..46c8fa3 100644 --- a/src/Language/GraphQL/AST/Parser.hs +++ b/src/Language/GraphQL/AST/Parser.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -18,7 +19,7 @@ import Language.GraphQL.AST.DirectiveLocation , ExecutableDirectiveLocation , TypeSystemDirectiveLocation ) -import Language.GraphQL.AST.Document +import qualified Language.GraphQL.AST.Document as Full import Language.GraphQL.AST.Lexer import Text.Megaparsec ( MonadParsec(..) @@ -32,13 +33,13 @@ import Text.Megaparsec ) -- | Parser for the GraphQL documents. -document :: Parser Document +document :: Parser Full.Document document = unicodeBOM *> spaceConsumer *> lexeme (NonEmpty.some definition) -definition :: Parser Definition -definition = ExecutableDefinition <$> executableDefinition +definition :: Parser Full.Definition +definition = Full.ExecutableDefinition <$> executableDefinition <|> typeSystemDefinition' <|> typeSystemExtension' <?> "Definition" @@ -46,41 +47,41 @@ definition = ExecutableDefinition <$> executableDefinition typeSystemDefinition' = do location <- getLocation definition' <- typeSystemDefinition - pure $ TypeSystemDefinition definition' location + pure $ Full.TypeSystemDefinition definition' location typeSystemExtension' = do location <- getLocation definition' <- typeSystemExtension - pure $ TypeSystemExtension definition' location + pure $ Full.TypeSystemExtension definition' location -getLocation :: Parser Location +getLocation :: Parser Full.Location getLocation = fromSourcePosition <$> getSourcePos where fromSourcePosition SourcePos{..} = - Location (wordFromPosition sourceLine) (wordFromPosition sourceColumn) + Full.Location (wordFromPosition sourceLine) (wordFromPosition sourceColumn) wordFromPosition = fromIntegral . unPos -executableDefinition :: Parser ExecutableDefinition -executableDefinition = DefinitionOperation <$> operationDefinition - <|> DefinitionFragment <$> fragmentDefinition +executableDefinition :: Parser Full.ExecutableDefinition +executableDefinition = Full.DefinitionOperation <$> operationDefinition + <|> Full.DefinitionFragment <$> fragmentDefinition <?> "ExecutableDefinition" -typeSystemDefinition :: Parser TypeSystemDefinition +typeSystemDefinition :: Parser Full.TypeSystemDefinition typeSystemDefinition = schemaDefinition <|> typeSystemDefinitionWithDescription <?> "TypeSystemDefinition" where typeSystemDefinitionWithDescription = description >>= liftA2 (<|>) typeDefinition' directiveDefinition - typeDefinition' description' = TypeDefinition + typeDefinition' description' = Full.TypeDefinition <$> typeDefinition description' -typeSystemExtension :: Parser TypeSystemExtension -typeSystemExtension = SchemaExtension <$> schemaExtension - <|> TypeExtension <$> typeExtension +typeSystemExtension :: Parser Full.TypeSystemExtension +typeSystemExtension = Full.SchemaExtension <$> schemaExtension + <|> Full.TypeExtension <$> typeExtension <?> "TypeSystemExtension" -directiveDefinition :: Description -> Parser TypeSystemDefinition -directiveDefinition description' = DirectiveDefinition description' +directiveDefinition :: Full.Description -> Parser Full.TypeSystemDefinition +directiveDefinition description' = Full.DirectiveDefinition description' <$ symbol "directive" <* at <*> name @@ -124,7 +125,7 @@ typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA" <|> Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION" <?> "TypeSystemDirectiveLocation" -typeDefinition :: Description -> Parser TypeDefinition +typeDefinition :: Full.Description -> Parser Full.TypeDefinition typeDefinition description' = scalarTypeDefinition description' <|> objectTypeDefinition description' <|> interfaceTypeDefinition description' @@ -133,7 +134,7 @@ typeDefinition description' = scalarTypeDefinition description' <|> inputObjectTypeDefinition description' <?> "TypeDefinition" -typeExtension :: Parser TypeExtension +typeExtension :: Parser Full.TypeExtension typeExtension = scalarTypeExtension <|> objectTypeExtension <|> interfaceTypeExtension @@ -142,143 +143,143 @@ typeExtension = scalarTypeExtension <|> inputObjectTypeExtension <?> "TypeExtension" -scalarTypeDefinition :: Description -> Parser TypeDefinition -scalarTypeDefinition description' = ScalarTypeDefinition description' +scalarTypeDefinition :: Full.Description -> Parser Full.TypeDefinition +scalarTypeDefinition description' = Full.ScalarTypeDefinition description' <$ symbol "scalar" <*> name <*> directives <?> "ScalarTypeDefinition" -scalarTypeExtension :: Parser TypeExtension +scalarTypeExtension :: Parser Full.TypeExtension scalarTypeExtension = extend "scalar" "ScalarTypeExtension" - $ (ScalarTypeExtension <$> name <*> NonEmpty.some directive) :| [] + $ (Full.ScalarTypeExtension <$> name <*> NonEmpty.some directive) :| [] -objectTypeDefinition :: Description -> Parser TypeDefinition -objectTypeDefinition description' = ObjectTypeDefinition description' +objectTypeDefinition :: Full.Description -> Parser Full.TypeDefinition +objectTypeDefinition description' = Full.ObjectTypeDefinition description' <$ symbol "type" <*> name - <*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1) + <*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1) <*> directives <*> braces (many fieldDefinition) <?> "ObjectTypeDefinition" -objectTypeExtension :: Parser TypeExtension +objectTypeExtension :: Parser Full.TypeExtension objectTypeExtension = extend "type" "ObjectTypeExtension" $ fieldsDefinitionExtension :| [ directivesExtension , implementsInterfacesExtension ] where - fieldsDefinitionExtension = ObjectTypeFieldsDefinitionExtension + fieldsDefinitionExtension = Full.ObjectTypeFieldsDefinitionExtension <$> name - <*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1) + <*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1) <*> directives <*> braces (NonEmpty.some fieldDefinition) - directivesExtension = ObjectTypeDirectivesExtension + directivesExtension = Full.ObjectTypeDirectivesExtension <$> name - <*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1) + <*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1) <*> NonEmpty.some directive - implementsInterfacesExtension = ObjectTypeImplementsInterfacesExtension + implementsInterfacesExtension = Full.ObjectTypeImplementsInterfacesExtension <$> name <*> implementsInterfaces NonEmpty.sepBy1 -description :: Parser Description -description = Description +description :: Parser Full.Description +description = Full.Description <$> optional stringValue <?> "Description" -unionTypeDefinition :: Description -> Parser TypeDefinition -unionTypeDefinition description' = UnionTypeDefinition description' +unionTypeDefinition :: Full.Description -> Parser Full.TypeDefinition +unionTypeDefinition description' = Full.UnionTypeDefinition description' <$ symbol "union" <*> name <*> directives - <*> option (UnionMemberTypes []) (unionMemberTypes sepBy1) + <*> option (Full.UnionMemberTypes []) (unionMemberTypes sepBy1) <?> "UnionTypeDefinition" -unionTypeExtension :: Parser TypeExtension +unionTypeExtension :: Parser Full.TypeExtension unionTypeExtension = extend "union" "UnionTypeExtension" $ unionMemberTypesExtension :| [directivesExtension] where - unionMemberTypesExtension = UnionTypeUnionMemberTypesExtension + unionMemberTypesExtension = Full.UnionTypeUnionMemberTypesExtension <$> name <*> directives <*> unionMemberTypes NonEmpty.sepBy1 - directivesExtension = UnionTypeDirectivesExtension + directivesExtension = Full.UnionTypeDirectivesExtension <$> name <*> NonEmpty.some directive unionMemberTypes :: Foldable t => - (Parser Text -> Parser Text -> Parser (t NamedType)) -> - Parser (UnionMemberTypes t) -unionMemberTypes sepBy' = UnionMemberTypes + (Parser Text -> Parser Text -> Parser (t Full.NamedType)) -> + Parser (Full.UnionMemberTypes t) +unionMemberTypes sepBy' = Full.UnionMemberTypes <$ equals <* optional pipe <*> name `sepBy'` pipe <?> "UnionMemberTypes" -interfaceTypeDefinition :: Description -> Parser TypeDefinition -interfaceTypeDefinition description' = InterfaceTypeDefinition description' +interfaceTypeDefinition :: Full.Description -> Parser Full.TypeDefinition +interfaceTypeDefinition description' = Full.InterfaceTypeDefinition description' <$ symbol "interface" <*> name <*> directives <*> braces (many fieldDefinition) <?> "InterfaceTypeDefinition" -interfaceTypeExtension :: Parser TypeExtension +interfaceTypeExtension :: Parser Full.TypeExtension interfaceTypeExtension = extend "interface" "InterfaceTypeExtension" $ fieldsDefinitionExtension :| [directivesExtension] where - fieldsDefinitionExtension = InterfaceTypeFieldsDefinitionExtension + fieldsDefinitionExtension = Full.InterfaceTypeFieldsDefinitionExtension <$> name <*> directives <*> braces (NonEmpty.some fieldDefinition) - directivesExtension = InterfaceTypeDirectivesExtension + directivesExtension = Full.InterfaceTypeDirectivesExtension <$> name <*> NonEmpty.some directive -enumTypeDefinition :: Description -> Parser TypeDefinition -enumTypeDefinition description' = EnumTypeDefinition description' +enumTypeDefinition :: Full.Description -> Parser Full.TypeDefinition +enumTypeDefinition description' = Full.EnumTypeDefinition description' <$ symbol "enum" <*> name <*> directives <*> listOptIn braces enumValueDefinition <?> "EnumTypeDefinition" -enumTypeExtension :: Parser TypeExtension +enumTypeExtension :: Parser Full.TypeExtension enumTypeExtension = extend "enum" "EnumTypeExtension" $ enumValuesDefinitionExtension :| [directivesExtension] where - enumValuesDefinitionExtension = EnumTypeEnumValuesDefinitionExtension + enumValuesDefinitionExtension = Full.EnumTypeEnumValuesDefinitionExtension <$> name <*> directives <*> braces (NonEmpty.some enumValueDefinition) - directivesExtension = EnumTypeDirectivesExtension + directivesExtension = Full.EnumTypeDirectivesExtension <$> name <*> NonEmpty.some directive -inputObjectTypeDefinition :: Description -> Parser TypeDefinition -inputObjectTypeDefinition description' = InputObjectTypeDefinition description' +inputObjectTypeDefinition :: Full.Description -> Parser Full.TypeDefinition +inputObjectTypeDefinition description' = Full.InputObjectTypeDefinition description' <$ symbol "input" <*> name <*> directives <*> listOptIn braces inputValueDefinition <?> "InputObjectTypeDefinition" -inputObjectTypeExtension :: Parser TypeExtension +inputObjectTypeExtension :: Parser Full.TypeExtension inputObjectTypeExtension = extend "input" "InputObjectTypeExtension" $ inputFieldsDefinitionExtension :| [directivesExtension] where - inputFieldsDefinitionExtension = InputObjectTypeInputFieldsDefinitionExtension + inputFieldsDefinitionExtension = Full.InputObjectTypeInputFieldsDefinitionExtension <$> name <*> directives <*> braces (NonEmpty.some inputValueDefinition) - directivesExtension = InputObjectTypeDirectivesExtension + directivesExtension = Full.InputObjectTypeDirectivesExtension <$> name <*> NonEmpty.some directive -enumValueDefinition :: Parser EnumValueDefinition -enumValueDefinition = EnumValueDefinition +enumValueDefinition :: Parser Full.EnumValueDefinition +enumValueDefinition = Full.EnumValueDefinition <$> description <*> enumValue <*> directives @@ -286,16 +287,16 @@ enumValueDefinition = EnumValueDefinition implementsInterfaces :: Foldable t => - (Parser Text -> Parser Text -> Parser (t NamedType)) -> - Parser (ImplementsInterfaces t) -implementsInterfaces sepBy' = ImplementsInterfaces + (Parser Text -> Parser Text -> Parser (t Full.NamedType)) -> + Parser (Full.ImplementsInterfaces t) +implementsInterfaces sepBy' = Full.ImplementsInterfaces <$ symbol "implements" <* optional amp <*> name `sepBy'` amp <?> "ImplementsInterfaces" -inputValueDefinition :: Parser InputValueDefinition -inputValueDefinition = InputValueDefinition +inputValueDefinition :: Parser Full.InputValueDefinition +inputValueDefinition = Full.InputValueDefinition <$> description <*> name <* colon @@ -304,13 +305,13 @@ inputValueDefinition = InputValueDefinition <*> directives <?> "InputValueDefinition" -argumentsDefinition :: Parser ArgumentsDefinition -argumentsDefinition = ArgumentsDefinition +argumentsDefinition :: Parser Full.ArgumentsDefinition +argumentsDefinition = Full.ArgumentsDefinition <$> listOptIn parens inputValueDefinition <?> "ArgumentsDefinition" -fieldDefinition :: Parser FieldDefinition -fieldDefinition = FieldDefinition +fieldDefinition :: Parser Full.FieldDefinition +fieldDefinition = Full.FieldDefinition <$> description <*> name <*> argumentsDefinition @@ -319,33 +320,33 @@ fieldDefinition = FieldDefinition <*> directives <?> "FieldDefinition" -schemaDefinition :: Parser TypeSystemDefinition -schemaDefinition = SchemaDefinition +schemaDefinition :: Parser Full.TypeSystemDefinition +schemaDefinition = Full.SchemaDefinition <$ symbol "schema" <*> directives <*> operationTypeDefinitions <?> "SchemaDefinition" -operationTypeDefinitions :: Parser (NonEmpty OperationTypeDefinition) +operationTypeDefinitions :: Parser (NonEmpty Full.OperationTypeDefinition) operationTypeDefinitions = braces $ NonEmpty.some operationTypeDefinition -schemaExtension :: Parser SchemaExtension +schemaExtension :: Parser Full.SchemaExtension schemaExtension = extend "schema" "SchemaExtension" $ schemaOperationExtension :| [directivesExtension] where - directivesExtension = SchemaDirectivesExtension + directivesExtension = Full.SchemaDirectivesExtension <$> NonEmpty.some directive - schemaOperationExtension = SchemaOperationExtension + schemaOperationExtension = Full.SchemaOperationExtension <$> directives <*> operationTypeDefinitions -operationTypeDefinition :: Parser OperationTypeDefinition -operationTypeDefinition = OperationTypeDefinition +operationTypeDefinition :: Parser Full.OperationTypeDefinition +operationTypeDefinition = Full.OperationTypeDefinition <$> operationType <* colon <*> name <?> "OperationTypeDefinition" -operationDefinition :: Parser OperationDefinition +operationDefinition :: Parser Full.OperationDefinition operationDefinition = shorthand <|> operationDefinition' <?> "OperationDefinition" @@ -353,7 +354,7 @@ operationDefinition = shorthand shorthand = do location <- getLocation selectionSet' <- selectionSet - pure $ SelectionSet selectionSet' location + pure $ Full.SelectionSet selectionSet' location operationDefinition' = do location <- getLocation operationType' <- operationType @@ -361,60 +362,74 @@ operationDefinition = shorthand variableDefinitions' <- variableDefinitions directives' <- directives selectionSet' <- selectionSet - pure $ OperationDefinition operationType' operationName variableDefinitions' directives' selectionSet' location - -operationType :: Parser OperationType -operationType = Query <$ symbol "query" - <|> Mutation <$ symbol "mutation" - <|> Subscription <$ symbol "subscription" + pure $ Full.OperationDefinition + operationType' + operationName + variableDefinitions' + directives' + selectionSet' + location + +operationType :: Parser Full.OperationType +operationType = Full.Query <$ symbol "query" + <|> Full.Mutation <$ symbol "mutation" + <|> Full.Subscription <$ symbol "subscription" <?> "OperationType" -selectionSet :: Parser SelectionSet +selectionSet :: Parser Full.SelectionSet selectionSet = braces (NonEmpty.some selection) <?> "SelectionSet" -selectionSetOpt :: Parser SelectionSetOpt +selectionSetOpt :: Parser Full.SelectionSetOpt selectionSetOpt = listOptIn braces selection <?> "SelectionSet" -selection :: Parser Selection -selection = field - <|> try fragmentSpread - <|> inlineFragment +selection :: Parser Full.Selection +selection = Full.FieldSelection <$> field + <|> Full.FragmentSpreadSelection <$> try fragmentSpread + <|> Full.InlineFragmentSelection <$> inlineFragment <?> "Selection" -field :: Parser Selection -field = Field - <$> optional alias - <*> name - <*> arguments - <*> directives - <*> selectionSetOpt - <?> "Field" +field :: Parser Full.Field +field = label "Field" $ do + location <- getLocation + alias' <- optional alias + name' <- name + arguments' <- arguments + directives' <- directives + selectionSetOpt' <- selectionSetOpt + pure $ Full.Field alias' name' arguments' directives' selectionSetOpt' location -alias :: Parser Alias +alias :: Parser Full.Name alias = try (name <* colon) <?> "Alias" -arguments :: Parser [Argument] +arguments :: Parser [Full.Argument] arguments = listOptIn parens argument <?> "Arguments" -argument :: Parser Argument -argument = Argument <$> name <* colon <*> value <?> "Argument" +argument :: Parser Full.Argument +argument = label "Argument" $ do + location <- getLocation + name' <- name + colon + value' <- valueNode value + pure $ Full.Argument name' value' location -fragmentSpread :: Parser Selection -fragmentSpread = FragmentSpread - <$ spread - <*> fragmentName - <*> directives - <?> "FragmentSpread" +fragmentSpread :: Parser Full.FragmentSpread +fragmentSpread = label "FragmentSpread" $ do + location <- getLocation + _ <- spread + fragmentName' <- fragmentName + directives' <- directives + pure $ Full.FragmentSpread fragmentName' directives' location -inlineFragment :: Parser Selection -inlineFragment = InlineFragment - <$ spread - <*> optional typeCondition - <*> directives - <*> selectionSet - <?> "InlineFragment" +inlineFragment :: Parser Full.InlineFragment +inlineFragment = label "InlineFragment" $ do + location <- getLocation + _ <- spread + typeCondition' <- optional typeCondition + directives' <- directives + selectionSet' <- selectionSet + pure $ Full.InlineFragment typeCondition' directives' selectionSet' location -fragmentDefinition :: Parser FragmentDefinition +fragmentDefinition :: Parser Full.FragmentDefinition fragmentDefinition = label "FragmentDefinition" $ do location <- getLocation _ <- symbol "fragment" @@ -422,36 +437,42 @@ fragmentDefinition = label "FragmentDefinition" $ do typeCondition' <- typeCondition directives' <- directives selectionSet' <- selectionSet - pure $ FragmentDefinition + pure $ Full.FragmentDefinition fragmentName' typeCondition' directives' selectionSet' location -fragmentName :: Parser Name +fragmentName :: Parser Full.Name fragmentName = but (symbol "on") *> name <?> "FragmentName" -typeCondition :: Parser TypeCondition +typeCondition :: Parser Full.TypeCondition typeCondition = symbol "on" *> name <?> "TypeCondition" -value :: Parser Value -value = Variable <$> variable - <|> Float <$> try float - <|> Int <$> integer - <|> Boolean <$> booleanValue - <|> Null <$ nullValue - <|> String <$> stringValue - <|> Enum <$> try enumValue - <|> List <$> brackets (some value) - <|> Object <$> braces (some $ objectField value) +valueNode :: forall a. Parser a -> Parser (Full.Node a) +valueNode valueParser = do + location <- getLocation + value' <- valueParser + pure $ Full.Node value' location + +value :: Parser Full.Value +value = Full.Variable <$> variable + <|> Full.Float <$> try float + <|> Full.Int <$> integer + <|> Full.Boolean <$> booleanValue + <|> Full.Null <$ nullValue + <|> Full.String <$> stringValue + <|> Full.Enum <$> try enumValue + <|> Full.List <$> brackets (some value) + <|> Full.Object <$> braces (some $ objectField $ valueNode value) <?> "Value" -constValue :: Parser ConstValue -constValue = ConstFloat <$> try float - <|> ConstInt <$> integer - <|> ConstBoolean <$> booleanValue - <|> ConstNull <$ nullValue - <|> ConstString <$> stringValue - <|> ConstEnum <$> try enumValue - <|> ConstList <$> brackets (some constValue) - <|> ConstObject <$> braces (some $ objectField constValue) +constValue :: Parser Full.ConstValue +constValue = Full.ConstFloat <$> try float + <|> Full.ConstInt <$> integer + <|> Full.ConstBoolean <$> booleanValue + <|> Full.ConstNull <$ nullValue + <|> Full.ConstString <$> stringValue + <|> Full.ConstEnum <$> try enumValue + <|> Full.ConstList <$> brackets (some constValue) + <|> Full.ConstObject <$> braces (some $ objectField $ valueNode constValue) <?> "Value" booleanValue :: Parser Bool @@ -459,7 +480,7 @@ booleanValue = True <$ symbol "true" <|> False <$ symbol "false" <?> "BooleanValue" -enumValue :: Parser Name +enumValue :: Parser Full.Name enumValue = but (symbol "true") *> but (symbol "false") *> but (symbol "null") @@ -472,51 +493,54 @@ stringValue = blockString <|> string <?> "StringValue" nullValue :: Parser Text nullValue = symbol "null" <?> "NullValue" -objectField :: Parser a -> Parser (ObjectField a) -objectField valueParser = ObjectField - <$> name - <* colon - <*> valueParser - <?> "ObjectField" +objectField :: forall a. Parser (Full.Node a) -> Parser (Full.ObjectField a) +objectField valueParser = label "ObjectField" $ do + location <- getLocation + fieldName <- name + colon + fieldValue <- valueParser + pure $ Full.ObjectField fieldName fieldValue location -variableDefinitions :: Parser [VariableDefinition] +variableDefinitions :: Parser [Full.VariableDefinition] variableDefinitions = listOptIn parens variableDefinition <?> "VariableDefinitions" -variableDefinition :: Parser VariableDefinition -variableDefinition = VariableDefinition - <$> variable - <* colon - <*> type' - <*> defaultValue - <?> "VariableDefinition" +variableDefinition :: Parser Full.VariableDefinition +variableDefinition = label "VariableDefinition" $ do + location <- getLocation + variableName <- variable + colon + variableType <- type' + variableValue <- defaultValue + pure $ Full.VariableDefinition variableName variableType variableValue location -variable :: Parser Name +variable :: Parser Full.Name variable = dollar *> name <?> "Variable" -defaultValue :: Parser (Maybe ConstValue) -defaultValue = optional (equals *> constValue) <?> "DefaultValue" +defaultValue :: Parser (Maybe (Full.Node Full.ConstValue)) +defaultValue = optional (equals *> valueNode constValue) <?> "DefaultValue" -type' :: Parser Type -type' = try (TypeNonNull <$> nonNullType) - <|> TypeList <$> brackets type' - <|> TypeNamed <$> name +type' :: Parser Full.Type +type' = try (Full.TypeNonNull <$> nonNullType) + <|> Full.TypeList <$> brackets type' + <|> Full.TypeNamed <$> name <?> "Type" -nonNullType :: Parser NonNullType -nonNullType = NonNullTypeNamed <$> name <* bang - <|> NonNullTypeList <$> brackets type' <* bang +nonNullType :: Parser Full.NonNullType +nonNullType = Full.NonNullTypeNamed <$> name <* bang + <|> Full.NonNullTypeList <$> brackets type' <* bang <?> "NonNullType" -directives :: Parser [Directive] +directives :: Parser [Full.Directive] directives = many directive <?> "Directives" -directive :: Parser Directive -directive = Directive - <$ at - <*> name - <*> arguments - <?> "Directive" +directive :: Parser Full.Directive +directive = label "Directive" $ do + location <- getLocation + at + directiveName <- name + directiveArguments <- arguments + pure $ Full.Directive directiveName directiveArguments location listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a] listOptIn surround = option [] . surround . some |