{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Parsing.Internal.Pattern
  ( inputValueDefinition,
    fieldsDefinition,
    typeDeclaration,
    optionalDirectives,
    enumValueDefinition,
    inputFieldsDefinition,
    parseOperationType,
    argumentsDefinition,
    parseDirectiveLocation,
  )
where

import Data.ByteString.Lazy.Internal (ByteString)
import Data.Morpheus.Internal.Utils (fromElems)
import Data.Morpheus.Parsing.Internal.Arguments
  ( maybeArguments,
  )
import Data.Morpheus.Parsing.Internal.Internal
  ( Parser,
    getLocation,
  )
import Data.Morpheus.Parsing.Internal.Terms
  ( at,
    colon,
    ignoredTokens,
    keyword,
    optDescription,
    parseName,
    parseType,
    parseTypeName,
    setOf,
    uniqTuple,
  )
import Data.Morpheus.Parsing.Internal.Value
  ( Parse (..),
    parseDefaultValue,
  )
import Data.Morpheus.Types.Internal.AST
  ( ArgumentDefinition (..),
    ArgumentsDefinition,
    DataEnumValue (..),
    Description,
    Directive (..),
    DirectiveLocation (..),
    Directives,
    FieldContent (..),
    FieldDefinition (..),
    FieldName,
    FieldsDefinition,
    IN,
    InputFieldsDefinition,
    OUT,
    OperationType (..),
    TRUE,
    TypeName,
    TypeRef,
    Value,
  )
import Relude hiding (ByteString, many)
import Text.Megaparsec
  ( choice,
    label,
    many,
  )
import Text.Megaparsec.Byte (string)

--  EnumValueDefinition: https://graphql.github.io/graphql-spec/June2018/#EnumValueDefinition
--
--  EnumValueDefinition
--    Description(opt) EnumValue Directives(Const)(opt)
--
enumValueDefinition ::
  Parse (Value s) =>
  Parser (DataEnumValue s)
enumValueDefinition :: Parser (DataEnumValue s)
enumValueDefinition =
  String -> Parser (DataEnumValue s) -> Parser (DataEnumValue s)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"EnumValueDefinition" (Parser (DataEnumValue s) -> Parser (DataEnumValue s))
-> Parser (DataEnumValue s) -> Parser (DataEnumValue s)
forall a b. (a -> b) -> a -> b
$
    Maybe Description -> TypeName -> Directives s -> DataEnumValue s
forall (s :: Stage).
Maybe Description -> TypeName -> Directives s -> DataEnumValue s
DataEnumValue
      (Maybe Description -> TypeName -> Directives s -> DataEnumValue s)
-> ParsecT MyError ByteString GQLResult (Maybe Description)
-> ParsecT
     MyError
     ByteString
     GQLResult
     (TypeName -> Directives s -> DataEnumValue s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString GQLResult (Maybe Description)
optDescription
      ParsecT
  MyError
  ByteString
  GQLResult
  (TypeName -> Directives s -> DataEnumValue s)
-> ParsecT MyError ByteString GQLResult TypeName
-> ParsecT
     MyError ByteString GQLResult (Directives s -> DataEnumValue s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString GQLResult TypeName
parseTypeName
      ParsecT
  MyError ByteString GQLResult (Directives s -> DataEnumValue s)
-> ParsecT MyError ByteString GQLResult (Directives s)
-> Parser (DataEnumValue s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString GQLResult (Directives s)
forall (s :: Stage). Parse (Value s) => Parser (Directives s)
optionalDirectives
{-# INLINEABLE enumValueDefinition #-}

-- InputValue : https://graphql.github.io/graphql-spec/June2018/#InputValueDefinition
--
-- InputValueDefinition
--   Description(opt) Name : Type DefaultValue(opt) Directives (Const)(opt)
--
inputValueDefinition ::
  Parse (Value s) =>
  Parser (FieldDefinition IN s)
inputValueDefinition :: Parser (FieldDefinition IN s)
inputValueDefinition =
  String
-> Parser (FieldDefinition IN s) -> Parser (FieldDefinition IN s)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"InputValueDefinition" (Parser (FieldDefinition IN s) -> Parser (FieldDefinition IN s))
-> Parser (FieldDefinition IN s) -> Parser (FieldDefinition IN s)
forall a b. (a -> b) -> a -> b
$
    Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE IN s)
-> Directives s
-> FieldDefinition IN s
forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition
      (Maybe Description
 -> FieldName
 -> TypeRef
 -> Maybe (FieldContent TRUE IN s)
 -> Directives s
 -> FieldDefinition IN s)
-> ParsecT MyError ByteString GQLResult (Maybe Description)
-> ParsecT
     MyError
     ByteString
     GQLResult
     (FieldName
      -> TypeRef
      -> Maybe (FieldContent TRUE IN s)
      -> Directives s
      -> FieldDefinition IN s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString GQLResult (Maybe Description)
optDescription
      ParsecT
  MyError
  ByteString
  GQLResult
  (FieldName
   -> TypeRef
   -> Maybe (FieldContent TRUE IN s)
   -> Directives s
   -> FieldDefinition IN s)
-> ParsecT MyError ByteString GQLResult FieldName
-> ParsecT
     MyError
     ByteString
     GQLResult
     (TypeRef
      -> Maybe (FieldContent TRUE IN s)
      -> Directives s
      -> FieldDefinition IN s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString GQLResult FieldName
forall (t :: NAME). Parser (Name t)
parseName
      ParsecT
  MyError
  ByteString
  GQLResult
  (TypeRef
   -> Maybe (FieldContent TRUE IN s)
   -> Directives s
   -> FieldDefinition IN s)
-> ParsecT MyError ByteString GQLResult TypeRef
-> ParsecT
     MyError
     ByteString
     GQLResult
     (Maybe (FieldContent TRUE IN s)
      -> Directives s -> FieldDefinition IN s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
colon Parser ()
-> ParsecT MyError ByteString GQLResult TypeRef
-> ParsecT MyError ByteString GQLResult TypeRef
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MyError ByteString GQLResult TypeRef
parseType)
      ParsecT
  MyError
  ByteString
  GQLResult
  (Maybe (FieldContent TRUE IN s)
   -> Directives s -> FieldDefinition IN s)
-> ParsecT
     MyError ByteString GQLResult (Maybe (FieldContent TRUE IN s))
-> ParsecT
     MyError ByteString GQLResult (Directives s -> FieldDefinition IN s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString GQLResult (FieldContent TRUE IN s)
-> ParsecT
     MyError ByteString GQLResult (Maybe (FieldContent TRUE IN s))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Value s -> FieldContent TRUE IN s
forall (s :: Stage) (cat :: TypeCategory).
Value s -> FieldContent (IN <=? cat) cat s
DefaultInputValue (Value s -> FieldContent TRUE IN s)
-> ParsecT MyError ByteString GQLResult (Value s)
-> ParsecT MyError ByteString GQLResult (FieldContent TRUE IN s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString GQLResult (Value s)
forall (s :: Stage). Parser (Value s)
parseDefaultValue)
      ParsecT
  MyError ByteString GQLResult (Directives s -> FieldDefinition IN s)
-> ParsecT MyError ByteString GQLResult (Directives s)
-> Parser (FieldDefinition IN s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString GQLResult (Directives s)
forall (s :: Stage). Parse (Value s) => Parser (Directives s)
optionalDirectives
{-# INLINEABLE inputValueDefinition #-}

-- Field Arguments: https://graphql.github.io/graphql-spec/June2018/#sec-Field-Arguments
--
-- ArgumentsDefinition:
--   ( InputValueDefinition(list) )
--
argumentsDefinition ::
  Parse (Value s) =>
  Parser (ArgumentsDefinition s)
argumentsDefinition :: Parser (ArgumentsDefinition s)
argumentsDefinition =
  String
-> Parser (ArgumentsDefinition s) -> Parser (ArgumentsDefinition s)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"ArgumentsDefinition" (Parser (ArgumentsDefinition s) -> Parser (ArgumentsDefinition s))
-> Parser (ArgumentsDefinition s) -> Parser (ArgumentsDefinition s)
forall a b. (a -> b) -> a -> b
$
    Parser (ArgumentDefinition s) -> Parser (ArgumentsDefinition s)
forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, KeyOf k a) =>
Parser a -> Parser (map k a)
uniqTuple ((FieldDefinition IN s -> ArgumentDefinition s)
-> ParsecT MyError ByteString GQLResult (FieldDefinition IN s)
-> Parser (ArgumentDefinition s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldDefinition IN s -> ArgumentDefinition s
forall (s :: Stage). FieldDefinition IN s -> ArgumentDefinition s
ArgumentDefinition ParsecT MyError ByteString GQLResult (FieldDefinition IN s)
forall (s :: Stage).
Parse (Value s) =>
Parser (FieldDefinition IN s)
inputValueDefinition)
{-# INLINEABLE argumentsDefinition #-}

--  FieldsDefinition : https://graphql.github.io/graphql-spec/June2018/#FieldsDefinition
--
--  FieldsDefinition :
--    { FieldDefinition(list) }
--
fieldsDefinition ::
  Parse (Value s) =>
  Parser (FieldsDefinition OUT s)
fieldsDefinition :: Parser (FieldsDefinition OUT s)
fieldsDefinition = String
-> Parser (FieldsDefinition OUT s)
-> Parser (FieldsDefinition OUT s)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"FieldsDefinition" (Parser (FieldsDefinition OUT s)
 -> Parser (FieldsDefinition OUT s))
-> Parser (FieldsDefinition OUT s)
-> Parser (FieldsDefinition OUT s)
forall a b. (a -> b) -> a -> b
$ Parser (FieldDefinition OUT s) -> Parser (FieldsDefinition OUT s)
forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, KeyOf k a) =>
Parser a -> Parser (map k a)
setOf Parser (FieldDefinition OUT s)
forall (s :: Stage).
Parse (Value s) =>
Parser (FieldDefinition OUT s)
fieldDefinition
{-# INLINEABLE fieldsDefinition #-}

--  FieldDefinition
--    Description(opt) Name ArgumentsDefinition(opt) : Type Directives(Const)(opt)
--
fieldDefinition :: Parse (Value s) => Parser (FieldDefinition OUT s)
fieldDefinition :: Parser (FieldDefinition OUT s)
fieldDefinition =
  String
-> Parser (FieldDefinition OUT s) -> Parser (FieldDefinition OUT s)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"FieldDefinition" (Parser (FieldDefinition OUT s) -> Parser (FieldDefinition OUT s))
-> Parser (FieldDefinition OUT s) -> Parser (FieldDefinition OUT s)
forall a b. (a -> b) -> a -> b
$
    Maybe Description
-> FieldName
-> Maybe (FieldContent TRUE OUT s)
-> TypeRef
-> Directives s
-> FieldDefinition OUT s
forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> Maybe (FieldContent TRUE cat s)
-> TypeRef
-> Directives s
-> FieldDefinition cat s
mkField
      (Maybe Description
 -> FieldName
 -> Maybe (FieldContent TRUE OUT s)
 -> TypeRef
 -> Directives s
 -> FieldDefinition OUT s)
-> ParsecT MyError ByteString GQLResult (Maybe Description)
-> ParsecT
     MyError
     ByteString
     GQLResult
     (FieldName
      -> Maybe (FieldContent TRUE OUT s)
      -> TypeRef
      -> Directives s
      -> FieldDefinition OUT s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString GQLResult (Maybe Description)
optDescription
      ParsecT
  MyError
  ByteString
  GQLResult
  (FieldName
   -> Maybe (FieldContent TRUE OUT s)
   -> TypeRef
   -> Directives s
   -> FieldDefinition OUT s)
-> ParsecT MyError ByteString GQLResult FieldName
-> ParsecT
     MyError
     ByteString
     GQLResult
     (Maybe (FieldContent TRUE OUT s)
      -> TypeRef -> Directives s -> FieldDefinition OUT s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString GQLResult FieldName
forall (t :: NAME). Parser (Name t)
parseName
      ParsecT
  MyError
  ByteString
  GQLResult
  (Maybe (FieldContent TRUE OUT s)
   -> TypeRef -> Directives s -> FieldDefinition OUT s)
-> ParsecT
     MyError ByteString GQLResult (Maybe (FieldContent TRUE OUT s))
-> ParsecT
     MyError
     ByteString
     GQLResult
     (TypeRef -> Directives s -> FieldDefinition OUT s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString GQLResult (FieldContent TRUE OUT s)
-> ParsecT
     MyError ByteString GQLResult (Maybe (FieldContent TRUE OUT s))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ArgumentsDefinition s -> FieldContent TRUE OUT s
forall (s :: Stage) (cat :: TypeCategory).
ArgumentsDefinition s -> FieldContent (OUT <=? cat) cat s
FieldArgs (ArgumentsDefinition s -> FieldContent TRUE OUT s)
-> ParsecT MyError ByteString GQLResult (ArgumentsDefinition s)
-> ParsecT MyError ByteString GQLResult (FieldContent TRUE OUT s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString GQLResult (ArgumentsDefinition s)
forall (s :: Stage).
Parse (Value s) =>
Parser (ArgumentsDefinition s)
argumentsDefinition)
      ParsecT
  MyError
  ByteString
  GQLResult
  (TypeRef -> Directives s -> FieldDefinition OUT s)
-> ParsecT MyError ByteString GQLResult TypeRef
-> ParsecT
     MyError
     ByteString
     GQLResult
     (Directives s -> FieldDefinition OUT s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
colon Parser ()
-> ParsecT MyError ByteString GQLResult TypeRef
-> ParsecT MyError ByteString GQLResult TypeRef
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MyError ByteString GQLResult TypeRef
parseType)
      ParsecT
  MyError
  ByteString
  GQLResult
  (Directives s -> FieldDefinition OUT s)
-> ParsecT MyError ByteString GQLResult (Directives s)
-> Parser (FieldDefinition OUT s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString GQLResult (Directives s)
forall (s :: Stage). Parse (Value s) => Parser (Directives s)
optionalDirectives
{-# INLINEABLE fieldDefinition #-}

mkField ::
  Maybe Description ->
  FieldName ->
  Maybe (FieldContent TRUE cat s) ->
  TypeRef ->
  Directives s ->
  FieldDefinition cat s
mkField :: Maybe Description
-> FieldName
-> Maybe (FieldContent TRUE cat s)
-> TypeRef
-> Directives s
-> FieldDefinition cat s
mkField Maybe Description
fieldDescription FieldName
fieldName Maybe (FieldContent TRUE cat s)
fieldContent TypeRef
fieldType Directives s
fieldDirectives =
  FieldDefinition :: forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition {Maybe Description
Maybe (FieldContent TRUE cat s)
Directives s
FieldName
TypeRef
fieldDirectives :: Directives s
fieldContent :: Maybe (FieldContent TRUE cat s)
fieldType :: TypeRef
fieldName :: FieldName
fieldDescription :: Maybe Description
fieldDirectives :: Directives s
fieldType :: TypeRef
fieldContent :: Maybe (FieldContent TRUE cat s)
fieldName :: FieldName
fieldDescription :: Maybe Description
..}
{-# INLINEABLE mkField #-}

-- InputFieldsDefinition : https://graphql.github.io/graphql-spec/June2018/#sec-Language.Directives
--   InputFieldsDefinition:
--     { InputValueDefinition(list) }
--
inputFieldsDefinition ::
  Parse (Value s) =>
  Parser (InputFieldsDefinition s)
inputFieldsDefinition :: Parser (InputFieldsDefinition s)
inputFieldsDefinition = String
-> Parser (InputFieldsDefinition s)
-> Parser (InputFieldsDefinition s)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"InputFieldsDefinition" (Parser (InputFieldsDefinition s)
 -> Parser (InputFieldsDefinition s))
-> Parser (InputFieldsDefinition s)
-> Parser (InputFieldsDefinition s)
forall a b. (a -> b) -> a -> b
$ Parser (FieldDefinition IN s) -> Parser (InputFieldsDefinition s)
forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, KeyOf k a) =>
Parser a -> Parser (map k a)
setOf Parser (FieldDefinition IN s)
forall (s :: Stage).
Parse (Value s) =>
Parser (FieldDefinition IN s)
inputValueDefinition
{-# INLINEABLE inputFieldsDefinition #-}

-- Directives : https://graphql.github.io/graphql-spec/June2018/#sec-Language.Directives
--
-- example: @directive ( arg1: "value" , .... )
--
-- Directives[Const]
-- Directive[Const](list)
--
optionalDirectives :: Parse (Value s) => Parser (Directives s)
optionalDirectives :: Parser (Directives s)
optionalDirectives = String -> Parser (Directives s) -> Parser (Directives s)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Directives" (Parser (Directives s) -> Parser (Directives s))
-> Parser (Directives s) -> Parser (Directives s)
forall a b. (a -> b) -> a -> b
$ ParsecT MyError ByteString GQLResult (Directive s)
-> ParsecT MyError ByteString GQLResult [Directive s]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT MyError ByteString GQLResult (Directive s)
forall (s :: Stage). Parse (Value s) => Parser (Directive s)
directive ParsecT MyError ByteString GQLResult [Directive s]
-> ([Directive s] -> Parser (Directives s))
-> Parser (Directives s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GQLResult (Directives s) -> Parser (Directives s)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GQLResult (Directives s) -> Parser (Directives s))
-> ([Directive s] -> GQLResult (Directives s))
-> [Directive s]
-> Parser (Directives s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Directive s] -> GQLResult (Directives s)
forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems
{-# INLINEABLE optionalDirectives #-}

-- Directive[Const]
--
-- @ Name Arguments[Const](opt)
directive :: Parse (Value s) => Parser (Directive s)
directive :: Parser (Directive s)
directive =
  String -> Parser (Directive s) -> Parser (Directive s)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Directive" (Parser (Directive s) -> Parser (Directive s))
-> Parser (Directive s) -> Parser (Directive s)
forall a b. (a -> b) -> a -> b
$
    Position -> FieldName -> Arguments s -> Directive s
forall (s :: Stage).
Position -> FieldName -> Arguments s -> Directive s
Directive
      (Position -> FieldName -> Arguments s -> Directive s)
-> ParsecT MyError ByteString GQLResult Position
-> ParsecT
     MyError
     ByteString
     GQLResult
     (FieldName -> Arguments s -> Directive s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString GQLResult Position
getLocation
      ParsecT
  MyError
  ByteString
  GQLResult
  (FieldName -> Arguments s -> Directive s)
-> ParsecT MyError ByteString GQLResult FieldName
-> ParsecT
     MyError ByteString GQLResult (Arguments s -> Directive s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
at Parser ()
-> ParsecT MyError ByteString GQLResult FieldName
-> ParsecT MyError ByteString GQLResult FieldName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MyError ByteString GQLResult FieldName
forall (t :: NAME). Parser (Name t)
parseName)
      ParsecT MyError ByteString GQLResult (Arguments s -> Directive s)
-> ParsecT MyError ByteString GQLResult (Arguments s)
-> Parser (Directive s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString GQLResult (Arguments s)
forall (s :: Stage). Parse (Value s) => Parser (Arguments s)
maybeArguments
{-# INLINEABLE directive #-}

-- typDeclaration : Not in spec ,start part of type definitions
--
--  typDeclaration
--   Description(opt) scalar Name
--
typeDeclaration :: ByteString -> Parser TypeName
typeDeclaration :: ByteString -> ParsecT MyError ByteString GQLResult TypeName
typeDeclaration ByteString
kind = ByteString -> Parser ()
keyword ByteString
kind Parser ()
-> ParsecT MyError ByteString GQLResult TypeName
-> ParsecT MyError ByteString GQLResult TypeName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MyError ByteString GQLResult TypeName
parseTypeName
{-# INLINEABLE typeDeclaration #-}

parseOperationType :: Parser OperationType
parseOperationType :: Parser OperationType
parseOperationType =
  String -> Parser OperationType -> Parser OperationType
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"OperationType" (Parser OperationType -> Parser OperationType)
-> Parser OperationType -> Parser OperationType
forall a b. (a -> b) -> a -> b
$
    ( (Tokens ByteString
-> ParsecT MyError ByteString GQLResult (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"query" ParsecT MyError ByteString GQLResult ByteString
-> OperationType -> Parser OperationType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> OperationType
Query)
        Parser OperationType
-> Parser OperationType -> Parser OperationType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens ByteString
-> ParsecT MyError ByteString GQLResult (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"mutation" ParsecT MyError ByteString GQLResult ByteString
-> OperationType -> Parser OperationType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> OperationType
Mutation)
        Parser OperationType
-> Parser OperationType -> Parser OperationType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens ByteString
-> ParsecT MyError ByteString GQLResult (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"subscription" ParsecT MyError ByteString GQLResult ByteString
-> OperationType -> Parser OperationType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> OperationType
Subscription)
    )
      Parser OperationType -> Parser () -> Parser OperationType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
{-# INLINEABLE parseOperationType #-}

parseDirectiveLocation :: Parser DirectiveLocation
parseDirectiveLocation :: Parser DirectiveLocation
parseDirectiveLocation =
  String -> Parser DirectiveLocation -> Parser DirectiveLocation
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label
    String
"DirectiveLocation"
    ( [Parser DirectiveLocation] -> Parser DirectiveLocation
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser DirectiveLocation] -> Parser DirectiveLocation)
-> [Parser DirectiveLocation] -> Parser DirectiveLocation
forall a b. (a -> b) -> a -> b
$
        DirectiveLocation -> Parser DirectiveLocation
forall a. Show a => a -> Parser a
toKeyword
          (DirectiveLocation -> Parser DirectiveLocation)
-> [DirectiveLocation] -> [Parser DirectiveLocation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ DirectiveLocation
FIELD_DEFINITION,
                DirectiveLocation
FRAGMENT_DEFINITION,
                DirectiveLocation
FRAGMENT_SPREAD,
                DirectiveLocation
INLINE_FRAGMENT,
                DirectiveLocation
ARGUMENT_DEFINITION,
                DirectiveLocation
INTERFACE,
                DirectiveLocation
ENUM_VALUE,
                DirectiveLocation
INPUT_OBJECT,
                DirectiveLocation
INPUT_FIELD_DEFINITION,
                DirectiveLocation
SCHEMA,
                DirectiveLocation
SCALAR,
                DirectiveLocation
OBJECT,
                DirectiveLocation
QUERY,
                DirectiveLocation
MUTATION,
                DirectiveLocation
SUBSCRIPTION,
                DirectiveLocation
UNION,
                DirectiveLocation
ENUM,
                DirectiveLocation
FIELD
              ]
    )
    Parser DirectiveLocation -> Parser () -> Parser DirectiveLocation
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
{-# INLINEABLE parseDirectiveLocation #-}

toKeyword :: Show a => a -> Parser a
toKeyword :: a -> Parser a
toKeyword a
x = Tokens ByteString
-> ParsecT MyError ByteString GQLResult (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> String
forall b a. (Show a, IsString b) => a -> b
show a
x) ParsecT MyError ByteString GQLResult ByteString -> a -> Parser a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
x
{-# INLINEABLE toKeyword #-}