{-# LANGUAGE NamedFieldPuns #-}
module Data.Morpheus.Parsing.Internal.Pattern
( inputValueDefinition
, fieldsDefinition
, typDeclaration
, optionalDirectives
, enumValueDefinition
, inputFieldsDefinition
)
where
import Text.Megaparsec ( label
, many
, (<|>)
)
import Data.Morpheus.Parsing.Internal.Internal
( Parser )
import Data.Morpheus.Parsing.Internal.Terms
( keyword
, litAssignment
, operator
, optDescription
, parseName
, parseType
, setOf
, uniqTuple
)
import Data.Morpheus.Parsing.Internal.Arguments
( parseArgumentsOpt )
import Data.Morpheus.Parsing.Internal.Value
( parseDefaultValue )
import Data.Morpheus.Types.Internal.AST
( FieldDefinition(..)
, Directive(..)
, Meta(..)
, DataEnumValue(..)
, Name
, ArgumentsDefinition(..)
, FieldsDefinition(..)
, InputFieldsDefinition(..)
)
enumValueDefinition :: Parser DataEnumValue
enumValueDefinition = label "EnumValueDefinition" $ do
metaDescription <- optDescription
enumName <- parseName
metaDirectives <- optionalDirectives
return $ DataEnumValue
{ enumName
, enumMeta = Just Meta { metaDescription, metaDirectives }
}
inputValueDefinition :: Parser FieldDefinition
inputValueDefinition = label "InputValueDefinition" $ do
metaDescription <- optDescription
fieldName <- parseName
litAssignment
fieldType <- parseType
_ <- parseDefaultValue
metaDirectives <- optionalDirectives
pure FieldDefinition
{ fieldArgs = NoArguments
, fieldName
, fieldType
, fieldMeta = Just Meta { metaDescription, metaDirectives }
}
argumentsDefinition :: Parser ArgumentsDefinition
argumentsDefinition = label "ArgumentsDefinition"
$ uniqTuple inputValueDefinition
<|> pure NoArguments
fieldsDefinition :: Parser FieldsDefinition
fieldsDefinition = label "FieldsDefinition" $ setOf fieldDefinition
fieldDefinition :: Parser FieldDefinition
fieldDefinition = label "FieldDefinition" $ do
metaDescription <- optDescription
fieldName <- parseName
fieldArgs <- argumentsDefinition
litAssignment
fieldType <- parseType
metaDirectives <- optionalDirectives
pure FieldDefinition
{ fieldName
, fieldArgs
, fieldType
, fieldMeta = Just Meta { metaDescription, metaDirectives }
}
inputFieldsDefinition :: Parser InputFieldsDefinition
inputFieldsDefinition = label "InputFieldsDefinition" $ setOf inputValueDefinition
optionalDirectives :: Parser [Directive]
optionalDirectives = label "Directives" $ many directive
directive :: Parser Directive
directive = label "Directive" $ do
operator '@'
directiveName <- parseName
directiveArgs <- parseArgumentsOpt
pure Directive { directiveName, directiveArgs }
typDeclaration :: Name -> Parser Name
typDeclaration kind = do
keyword kind
parseName