{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
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 Text.Megaparsec
( (<|>),
label,
try,
)
parseSelectionSet :: Parser (SelectionSet RAW)
parseSelectionSet = label "SelectionSet" $ setOf parseSelection
where
parseSelection =
label "Selection" $
try inlineFragment
<|> try spread
<|> parseSelectionField
parseSelectionField :: Parser (Selection RAW)
parseSelectionField =
label "SelectionField" $
do
selectionPosition <- getLocation
selectionAlias <- parseAlias
selectionName <- parseName
selectionArguments <- maybeArguments
selectionDirectives <- optionalDirectives
selectionContent <- parseSelectionContent
pure Selection {..}
parseSelectionContent :: Parser (SelectionContent RAW)
parseSelectionContent =
label "SelectionContent" $
SelectionSet <$> parseSelectionSet
<|> pure SelectionField
spread :: Parser (Selection RAW)
spread = label "FragmentSpread" $ do
refPosition <- spreadLiteral
refName <- parseName
directives <- optionalDirectives
pure $ Spread directives Ref {..}
parseFragmentDefinition :: Parser (Fragment RAW)
parseFragmentDefinition = label "FragmentDefinition" $ do
keyword "fragment"
fragmentPosition <- getLocation
fragmentName <- parseName
fragmentBody fragmentName fragmentPosition
inlineFragment :: Parser (Selection RAW)
inlineFragment = label "InlineFragment" $ do
fragmentPosition <- spreadLiteral
InlineFragment <$> fragmentBody "INLINE_FRAGMENT" fragmentPosition
fragmentBody :: FieldName -> Position -> Parser (Fragment RAW)
fragmentBody fragmentName fragmentPosition = label "FragmentBody" $ do
fragmentType <- parseTypeCondition
fragmentDirectives <- optionalDirectives
fragmentSelection <- parseSelectionSet
pure $ Fragment {..}