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