{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Parsing.Request.Selection
( parseSelectionSet,
parseFragmentDefinition,
)
where
import Data.Morpheus.Parsing.Internal.Arguments
( maybeArguments,
)
import Data.Morpheus.Parsing.Internal.Internal
( Parser,
getLocation,
)
import Data.Morpheus.Parsing.Internal.Pattern
( optionalDirectives,
)
import Data.Morpheus.Parsing.Internal.Terms
( keyword,
parseAlias,
parseName,
parseTypeCondition,
setOf,
spreadLiteral,
)
import Data.Morpheus.Types.Internal.AST
( FieldName,
Fragment (..),
Position,
RAW,
Ref (..),
Selection (..),
SelectionContent (..),
SelectionSet,
)
import Relude
import Text.Megaparsec
( label,
try,
)
parseSelectionSet :: Parser (SelectionSet RAW)
parseSelectionSet :: Parser (SelectionSet RAW)
parseSelectionSet = String -> Parser (SelectionSet RAW) -> Parser (SelectionSet RAW)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"SelectionSet" (Parser (SelectionSet RAW) -> Parser (SelectionSet RAW))
-> Parser (SelectionSet RAW) -> Parser (SelectionSet RAW)
forall a b. (a -> b) -> a -> b
$ Parser (Selection RAW) -> Parser (SelectionSet RAW)
forall a coll k.
(FromElems Eventless a coll, KeyOf k a) =>
Parser a -> Parser coll
setOf Parser (Selection RAW)
parseSelection
where
parseSelection :: Parser (Selection RAW)
parseSelection =
String -> Parser (Selection RAW) -> Parser (Selection RAW)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Selection" (Parser (Selection RAW) -> Parser (Selection RAW))
-> Parser (Selection RAW) -> Parser (Selection RAW)
forall a b. (a -> b) -> a -> b
$
Parser (Selection RAW) -> Parser (Selection RAW)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Selection RAW)
inlineFragment
Parser (Selection RAW)
-> Parser (Selection RAW) -> Parser (Selection RAW)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Selection RAW)
spread
Parser (Selection RAW)
-> Parser (Selection RAW) -> Parser (Selection RAW)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Selection RAW)
parseSelectionField
parseSelectionField :: Parser (Selection RAW)
parseSelectionField :: Parser (Selection RAW)
parseSelectionField =
String -> Parser (Selection RAW) -> Parser (Selection RAW)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"SelectionField" (Parser (Selection RAW) -> Parser (Selection RAW))
-> Parser (Selection RAW) -> Parser (Selection RAW)
forall a b. (a -> b) -> a -> b
$
Position
-> Maybe FieldName
-> FieldName
-> Arguments RAW
-> Directives RAW
-> SelectionContent RAW
-> Selection RAW
forall (s :: Stage).
Position
-> Maybe FieldName
-> FieldName
-> Arguments s
-> Directives s
-> SelectionContent s
-> Selection s
Selection
(Position
-> Maybe FieldName
-> FieldName
-> Arguments RAW
-> Directives RAW
-> SelectionContent RAW
-> Selection RAW)
-> ParsecT MyError ByteString Eventless Position
-> ParsecT
MyError
ByteString
Eventless
(Maybe FieldName
-> FieldName
-> Arguments RAW
-> Directives RAW
-> SelectionContent RAW
-> Selection RAW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString Eventless Position
getLocation
ParsecT
MyError
ByteString
Eventless
(Maybe FieldName
-> FieldName
-> Arguments RAW
-> Directives RAW
-> SelectionContent RAW
-> Selection RAW)
-> ParsecT MyError ByteString Eventless (Maybe FieldName)
-> ParsecT
MyError
ByteString
Eventless
(FieldName
-> Arguments RAW
-> Directives RAW
-> SelectionContent RAW
-> Selection RAW)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString Eventless (Maybe FieldName)
parseAlias
ParsecT
MyError
ByteString
Eventless
(FieldName
-> Arguments RAW
-> Directives RAW
-> SelectionContent RAW
-> Selection RAW)
-> ParsecT MyError ByteString Eventless FieldName
-> ParsecT
MyError
ByteString
Eventless
(Arguments RAW
-> Directives RAW -> SelectionContent RAW -> Selection RAW)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString Eventless FieldName
parseName
ParsecT
MyError
ByteString
Eventless
(Arguments RAW
-> Directives RAW -> SelectionContent RAW -> Selection RAW)
-> ParsecT MyError ByteString Eventless (Arguments RAW)
-> ParsecT
MyError
ByteString
Eventless
(Directives RAW -> SelectionContent RAW -> Selection RAW)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString Eventless (Arguments RAW)
forall (s :: Stage). Parse (Value s) => Parser (Arguments s)
maybeArguments
ParsecT
MyError
ByteString
Eventless
(Directives RAW -> SelectionContent RAW -> Selection RAW)
-> ParsecT MyError ByteString Eventless (Directives RAW)
-> ParsecT
MyError
ByteString
Eventless
(SelectionContent RAW -> Selection RAW)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString Eventless (Directives RAW)
forall (s :: Stage). Parse (Value s) => Parser [Directive s]
optionalDirectives
ParsecT
MyError
ByteString
Eventless
(SelectionContent RAW -> Selection RAW)
-> ParsecT MyError ByteString Eventless (SelectionContent RAW)
-> Parser (Selection RAW)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString Eventless (SelectionContent RAW)
parseSelectionContent
parseSelectionContent :: Parser (SelectionContent RAW)
parseSelectionContent :: ParsecT MyError ByteString Eventless (SelectionContent RAW)
parseSelectionContent =
String
-> ParsecT MyError ByteString Eventless (SelectionContent RAW)
-> ParsecT MyError ByteString Eventless (SelectionContent RAW)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"SelectionContent" (ParsecT MyError ByteString Eventless (SelectionContent RAW)
-> ParsecT MyError ByteString Eventless (SelectionContent RAW))
-> ParsecT MyError ByteString Eventless (SelectionContent RAW)
-> ParsecT MyError ByteString Eventless (SelectionContent RAW)
forall a b. (a -> b) -> a -> b
$
SelectionSet RAW -> SelectionContent RAW
forall (s :: Stage). SelectionSet s -> SelectionContent s
SelectionSet (SelectionSet RAW -> SelectionContent RAW)
-> Parser (SelectionSet RAW)
-> ParsecT MyError ByteString Eventless (SelectionContent RAW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SelectionSet RAW)
parseSelectionSet
ParsecT MyError ByteString Eventless (SelectionContent RAW)
-> ParsecT MyError ByteString Eventless (SelectionContent RAW)
-> ParsecT MyError ByteString Eventless (SelectionContent RAW)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SelectionContent RAW
-> ParsecT MyError ByteString Eventless (SelectionContent RAW)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SelectionContent RAW
forall (s :: Stage). SelectionContent s
SelectionField
spread :: Parser (Selection RAW)
spread :: Parser (Selection RAW)
spread = String -> Parser (Selection RAW) -> Parser (Selection RAW)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"FragmentSpread" (Parser (Selection RAW) -> Parser (Selection RAW))
-> Parser (Selection RAW) -> Parser (Selection RAW)
forall a b. (a -> b) -> a -> b
$ do
Position
refPosition <- ParsecT MyError ByteString Eventless Position
spreadLiteral
FieldName
refName <- ParsecT MyError ByteString Eventless FieldName
parseName
Directives RAW
directives <- ParsecT MyError ByteString Eventless (Directives RAW)
forall (s :: Stage). Parse (Value s) => Parser [Directive s]
optionalDirectives
Selection RAW -> Parser (Selection RAW)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selection RAW -> Parser (Selection RAW))
-> Selection RAW -> Parser (Selection RAW)
forall a b. (a -> b) -> a -> b
$ Directives RAW -> Ref -> Selection RAW
Spread Directives RAW
directives Ref :: FieldName -> Position -> Ref
Ref {Position
FieldName
refPosition :: Position
refName :: FieldName
refName :: FieldName
refPosition :: Position
..}
parseFragmentDefinition :: Parser (Fragment RAW)
parseFragmentDefinition :: Parser (Fragment RAW)
parseFragmentDefinition = String -> Parser (Fragment RAW) -> Parser (Fragment RAW)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Fragment" (Parser (Fragment RAW) -> Parser (Fragment RAW))
-> Parser (Fragment RAW) -> Parser (Fragment RAW)
forall a b. (a -> b) -> a -> b
$ do
FieldName -> Parser ()
keyword FieldName
"fragment"
Position
fragmentPosition <- ParsecT MyError ByteString Eventless Position
getLocation
FieldName
fragmentName <- ParsecT MyError ByteString Eventless FieldName
parseName
FieldName -> Position -> Parser (Fragment RAW)
fragmentBody FieldName
fragmentName Position
fragmentPosition
inlineFragment :: Parser (Selection RAW)
inlineFragment :: Parser (Selection RAW)
inlineFragment = String -> Parser (Selection RAW) -> Parser (Selection RAW)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"InlineFragment" (Parser (Selection RAW) -> Parser (Selection RAW))
-> Parser (Selection RAW) -> Parser (Selection RAW)
forall a b. (a -> b) -> a -> b
$ do
Position
fragmentPosition <- ParsecT MyError ByteString Eventless Position
spreadLiteral
Fragment RAW -> Selection RAW
InlineFragment (Fragment RAW -> Selection RAW)
-> Parser (Fragment RAW) -> Parser (Selection RAW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName -> Position -> Parser (Fragment RAW)
fragmentBody FieldName
"INLINE_FRAGMENT" Position
fragmentPosition
fragmentBody :: FieldName -> Position -> Parser (Fragment RAW)
fragmentBody :: FieldName -> Position -> Parser (Fragment RAW)
fragmentBody FieldName
fragmentName Position
fragmentPosition = String -> Parser (Fragment RAW) -> Parser (Fragment RAW)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"FragmentBody" (Parser (Fragment RAW) -> Parser (Fragment RAW))
-> Parser (Fragment RAW) -> Parser (Fragment RAW)
forall a b. (a -> b) -> a -> b
$ do
TypeName
fragmentType <- Parser TypeName
parseTypeCondition
Directives RAW
fragmentDirectives <- ParsecT MyError ByteString Eventless (Directives RAW)
forall (s :: Stage). Parse (Value s) => Parser [Directive s]
optionalDirectives
SelectionSet RAW
fragmentSelection <- Parser (SelectionSet RAW)
parseSelectionSet
Fragment RAW -> Parser (Fragment RAW)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fragment RAW -> Parser (Fragment RAW))
-> Fragment RAW -> Parser (Fragment RAW)
forall a b. (a -> b) -> a -> b
$ Fragment :: forall (stage :: Stage).
FieldName
-> TypeName
-> Position
-> SelectionSet stage
-> Directives stage
-> Fragment stage
Fragment {Directives RAW
Position
TypeName
FieldName
SelectionSet RAW
fragmentDirectives :: Directives RAW
fragmentSelection :: SelectionSet RAW
fragmentPosition :: Position
fragmentType :: TypeName
fragmentName :: FieldName
fragmentSelection :: SelectionSet RAW
fragmentDirectives :: Directives RAW
fragmentType :: TypeName
fragmentPosition :: Position
fragmentName :: FieldName
..}