{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# 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,
)
import Data.Morpheus.Parsing.Internal.Internal
( 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 (..),
FieldDefinition (..),
FieldName,
FieldsDefinition,
IN,
InputFieldsDefinition,
Meta (..),
OUT,
TypeName,
Value,
)
import Text.Megaparsec
( (<|>),
label,
many,
)
enumValueDefinition :: Parser DataEnumValue
enumValueDefinition = label "EnumValueDefinition" $ do
metaDescription <- optDescription
enumName <- parseTypeName
metaDirectives <- optionalDirectives
return $
DataEnumValue
{ enumName,
enumMeta = Just Meta {metaDescription, metaDirectives}
}
inputValueDefinition :: Parser (FieldDefinition IN)
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 OUT)
fieldsDefinition = label "FieldsDefinition" $ setOf fieldDefinition
fieldDefinition :: Parser (FieldDefinition OUT)
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 :: 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