{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
module Data.Morpheus.Parsing.Internal.Pattern
( inputValueDefinition,
fieldsDefinition,
typeDeclaration,
optionalDirectives,
enumValueDefinition,
inputFieldsDefinition,
)
where
import Data.Morpheus.Parsing.Internal.Arguments
( maybeArguments,
)
import Data.Morpheus.Parsing.Internal.Internal
( Parser,
getLocation,
)
import Data.Morpheus.Parsing.Internal.Terms
( keyword,
litAssignment,
operator,
optDescription,
parseName,
parseType,
parseTypeName,
setOf,
uniqTuple,
)
import Data.Morpheus.Parsing.Internal.Value
( Parse (..),
parseDefaultValue,
)
import Data.Morpheus.Types.Internal.AST
( ArgumentsDefinition (..),
DataEnumValue (..),
Directive (..),
FieldContent (..),
FieldDefinition (..),
FieldName,
FieldsDefinition,
IN,
InputFieldsDefinition,
OUT,
TypeName,
Value,
)
import Text.Megaparsec
( label,
many,
optional,
)
enumValueDefinition :: Parser DataEnumValue
enumValueDefinition = label "EnumValueDefinition" $ do
enumDescription <- optDescription
enumName <- parseTypeName
enumDirectives <- optionalDirectives
return DataEnumValue {..}
inputValueDefinition :: Parser (FieldDefinition IN)
inputValueDefinition = label "InputValueDefinition" $ do
fieldDescription <- optDescription
fieldName <- parseName
litAssignment
fieldType <- parseType
fieldContent <- optional (DefaultInputValue <$> parseDefaultValue)
fieldDirectives <- optionalDirectives
pure FieldDefinition {..}
argumentsDefinition :: Parser ArgumentsDefinition
argumentsDefinition =
label "ArgumentsDefinition" $
uniqTuple inputValueDefinition
fieldsDefinition :: Parser (FieldsDefinition OUT)
fieldsDefinition = label "FieldsDefinition" $ setOf fieldDefinition
fieldDefinition :: Parser (FieldDefinition OUT)
fieldDefinition = label "FieldDefinition" $ do
fieldDescription <- optDescription
fieldName <- parseName
fieldContent <- optional (FieldArgs <$> argumentsDefinition)
litAssignment
fieldType <- parseType
fieldDirectives <- optionalDirectives
pure FieldDefinition {..}
inputFieldsDefinition :: Parser InputFieldsDefinition
inputFieldsDefinition = label "InputFieldsDefinition" $ setOf inputValueDefinition
optionalDirectives :: Parse (Value s) => Parser [Directive s]
optionalDirectives = label "Directives" $ many directive
directive :: Parse (Value s) => Parser (Directive s)
directive = label "Directive" $ do
directivePosition <- getLocation
operator '@'
directiveName <- parseName
directiveArgs <- maybeArguments
pure Directive {..}
typeDeclaration :: FieldName -> Parser TypeName
typeDeclaration kind = do
keyword kind
parseTypeName