{-# 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 ::
Parse (Value s) =>
Parser (DataEnumValue s)
enumValueDefinition :: forall (s :: Stage). Parse (Value s) => Parser (DataEnumValue s)
enumValueDefinition =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"EnumValueDefinition" forall a b. (a -> b) -> a -> b
$
forall (s :: Stage).
Maybe Description -> TypeName -> Directives s -> DataEnumValue s
DataEnumValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Description)
optDescription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TypeName
parseTypeName
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (s :: Stage). Parse (Value s) => Parser (Directives s)
optionalDirectives
{-# INLINEABLE enumValueDefinition #-}
inputValueDefinition ::
Parse (Value s) =>
Parser (FieldDefinition IN s)
inputValueDefinition :: forall (s :: Stage).
Parse (Value s) =>
Parser (FieldDefinition IN s)
inputValueDefinition =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"InputValueDefinition" forall a b. (a -> b) -> a -> b
$
forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Description)
optDescription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: NAME). Parser (Name t)
parseName
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
colon forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MyError ByteString GQLResult TypeRef
parseType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (s :: Stage) (cat :: TypeCategory).
Value s -> FieldContent (IN <=? cat) cat s
DefaultInputValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (s :: Stage). Parser (Value s)
parseDefaultValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (s :: Stage). Parse (Value s) => Parser (Directives s)
optionalDirectives
{-# INLINEABLE inputValueDefinition #-}
argumentsDefinition ::
Parse (Value s) =>
Parser (ArgumentsDefinition s)
argumentsDefinition :: forall (s :: Stage).
Parse (Value s) =>
Parser (ArgumentsDefinition s)
argumentsDefinition =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"ArgumentsDefinition" forall a b. (a -> b) -> a -> b
$
forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, KeyOf k a) =>
Parser a -> Parser (map k a)
uniqTuple (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: Stage). FieldDefinition IN s -> ArgumentDefinition s
ArgumentDefinition forall (s :: Stage).
Parse (Value s) =>
Parser (FieldDefinition IN s)
inputValueDefinition)
{-# INLINEABLE argumentsDefinition #-}
fieldsDefinition ::
Parse (Value s) =>
Parser (FieldsDefinition OUT s)
fieldsDefinition :: forall (s :: Stage).
Parse (Value s) =>
Parser (FieldsDefinition OUT s)
fieldsDefinition = forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"FieldsDefinition" forall a b. (a -> b) -> a -> b
$ forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, KeyOf k a) =>
Parser a -> Parser (map k a)
setOf forall (s :: Stage).
Parse (Value s) =>
Parser (FieldDefinition OUT s)
fieldDefinition
{-# INLINEABLE fieldsDefinition #-}
fieldDefinition :: Parse (Value s) => Parser (FieldDefinition OUT s)
fieldDefinition :: forall (s :: Stage).
Parse (Value s) =>
Parser (FieldDefinition OUT s)
fieldDefinition =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"FieldDefinition" forall a b. (a -> b) -> a -> b
$
forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> Maybe (FieldContent TRUE cat s)
-> TypeRef
-> Directives s
-> FieldDefinition cat s
mkField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Description)
optDescription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: NAME). Parser (Name t)
parseName
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (s :: Stage) (cat :: TypeCategory).
ArgumentsDefinition s -> FieldContent (OUT <=? cat) cat s
FieldArgs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (s :: Stage).
Parse (Value s) =>
Parser (ArgumentsDefinition s)
argumentsDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
colon forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MyError ByteString GQLResult TypeRef
parseType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 :: forall (cat :: TypeCategory) (s :: Stage).
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 {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 ::
Parse (Value s) =>
Parser (InputFieldsDefinition s)
inputFieldsDefinition :: forall (s :: Stage).
Parse (Value s) =>
Parser (InputFieldsDefinition s)
inputFieldsDefinition = forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"InputFieldsDefinition" forall a b. (a -> b) -> a -> b
$ forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, KeyOf k a) =>
Parser a -> Parser (map k a)
setOf forall (s :: Stage).
Parse (Value s) =>
Parser (FieldDefinition IN s)
inputValueDefinition
{-# INLINEABLE inputFieldsDefinition #-}
optionalDirectives :: Parse (Value s) => Parser (Directives s)
optionalDirectives :: forall (s :: Stage). Parse (Value s) => Parser (Directives s)
optionalDirectives = forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Directives" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall (s :: Stage). Parse (Value s) => Parser (Directive s)
directive forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems
{-# INLINEABLE optionalDirectives #-}
directive :: Parse (Value s) => Parser (Directive s)
directive :: forall (s :: Stage). Parse (Value s) => Parser (Directive s)
directive =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Directive" forall a b. (a -> b) -> a -> b
$
forall (s :: Stage).
Position -> FieldName -> Arguments s -> Directive s
Directive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Position
getLocation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
at forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (t :: NAME). Parser (Name t)
parseName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (s :: Stage). Parse (Value s) => Parser (Arguments s)
maybeArguments
{-# INLINEABLE directive #-}
typeDeclaration :: ByteString -> Parser TypeName
typeDeclaration :: ByteString -> Parser TypeName
typeDeclaration ByteString
kind = ByteString -> Parser ()
keyword ByteString
kind forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser TypeName
parseTypeName
{-# INLINEABLE typeDeclaration #-}
parseOperationType :: Parser OperationType
parseOperationType :: Parser OperationType
parseOperationType =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"OperationType" forall a b. (a -> b) -> a -> b
$
( (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"query" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> OperationType
Query)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"mutation" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> OperationType
Mutation)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"subscription" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> OperationType
Subscription)
)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
{-# INLINEABLE parseOperationType #-}
parseDirectiveLocation :: Parser DirectiveLocation
parseDirectiveLocation :: Parser DirectiveLocation
parseDirectiveLocation =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label
String
"DirectiveLocation"
( forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice forall a b. (a -> b) -> a -> b
$
forall a. Show a => a -> Parser a
toKeyword
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
]
)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
{-# INLINEABLE parseDirectiveLocation #-}
toKeyword :: Show a => a -> Parser a
toKeyword :: forall a. Show a => a -> Parser a
toKeyword a
x = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show a
x) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
x
{-# INLINEABLE toKeyword #-}