Add definition module
This commit is contained in:
parent
e3a495a778
commit
56d88310df
@ -7,12 +7,13 @@ and this project adheres to
|
||||
[Haskell Package Versioning Policy](https://pvp.haskell.org/).
|
||||
|
||||
## [Unreleased]
|
||||
### Added
|
||||
- AST for the GraphQL schema.
|
||||
|
||||
### Changed
|
||||
- Rename `AST.Definition` into `AST.ExecutableDefinition`.
|
||||
TypeSystemDefinition and TypeSystemExtension can also be definitions.
|
||||
- Define `AST.Definition` as
|
||||
`newtype Definition = ExecutableDefinition ExecutableDefinition` for now. It
|
||||
should be soon extended to contain missing definition types.
|
||||
`AST.TypeSystemDefinition` and `AST.TypeSystemExtension` can also be
|
||||
definitions.
|
||||
|
||||
### Removed
|
||||
- `AST.Field`, `AST.InlineFragment` and `AST.FragmentSpread`.
|
||||
|
@ -5,10 +5,8 @@
|
||||
module Language.GraphQL.AST
|
||||
( Alias
|
||||
, Argument(..)
|
||||
, Definition(..)
|
||||
, Directive(..)
|
||||
, Document
|
||||
, ExecutableDefinition(..)
|
||||
, Directive(..)
|
||||
, FragmentDefinition(..)
|
||||
, Name
|
||||
, NonNullType(..)
|
||||
@ -28,15 +26,6 @@ import Data.Int (Int32)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Text (Text)
|
||||
|
||||
-- * Document
|
||||
|
||||
-- | GraphQL document.
|
||||
type Document = NonEmpty Definition
|
||||
|
||||
-- | All kinds of definitions that can occur in a GraphQL document.
|
||||
newtype Definition = ExecutableDefinition ExecutableDefinition
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Name
|
||||
type Name = Text
|
||||
|
||||
@ -74,8 +63,6 @@ type SelectionSet = NonEmpty Selection
|
||||
-- | Field selection.
|
||||
type SelectionSetOpt = [Selection]
|
||||
|
||||
-- * Field
|
||||
|
||||
-- | Single GraphQL field.
|
||||
--
|
||||
-- The only required property of a field is its name. Optionally it can also
|
||||
|
34
src/Language/GraphQL/AST/DirectiveLocation.hs
Normal file
34
src/Language/GraphQL/AST/DirectiveLocation.hs
Normal file
@ -0,0 +1,34 @@
|
||||
module Language.GraphQL.AST.DirectiveLocation
|
||||
( DirectiveLocation
|
||||
, ExecutableDirectiveLocation
|
||||
, TypeSystemDirectiveLocation
|
||||
) where
|
||||
|
||||
data DirectiveLocation
|
||||
= ExecutableDirectiveLocation ExecutableDirectiveLocation
|
||||
| TypeSystemDirectiveLocation TypeSystemDirectiveLocation
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ExecutableDirectiveLocation
|
||||
= Query
|
||||
| Mutation
|
||||
| Subscription
|
||||
| Field
|
||||
| FragmentDefinition
|
||||
| FragmentSpread
|
||||
| InlineFragment
|
||||
deriving (Eq, Show)
|
||||
|
||||
data TypeSystemDirectiveLocation
|
||||
= Schema
|
||||
| Scalar
|
||||
| Object
|
||||
| FieldDefinition
|
||||
| ArgumentDefinition
|
||||
| Interface
|
||||
| Union
|
||||
| Enum
|
||||
| EnumValue
|
||||
| InputObject
|
||||
| InputFieldDefinition
|
||||
deriving (Eq, Show)
|
107
src/Language/GraphQL/AST/Document.hs
Normal file
107
src/Language/GraphQL/AST/Document.hs
Normal file
@ -0,0 +1,107 @@
|
||||
-- | This module defines data structures representing a GraphQL document.
|
||||
module Language.GraphQL.AST.Document
|
||||
( Definition(..)
|
||||
, Document
|
||||
, ExecutableDefinition(..)
|
||||
) where
|
||||
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST
|
||||
( ExecutableDefinition(..)
|
||||
, Directive
|
||||
, Name
|
||||
, OperationType
|
||||
, Type
|
||||
, Value
|
||||
)
|
||||
import Language.GraphQL.AST.DirectiveLocation
|
||||
|
||||
-- | GraphQL document.
|
||||
type Document = NonEmpty Definition
|
||||
|
||||
type NamedType = Name
|
||||
|
||||
newtype Description = Description (Maybe Text)
|
||||
deriving (Eq, Show)
|
||||
|
||||
type RootOperationTypeDefinitions = NonEmpty RootOperationTypeDefinition
|
||||
|
||||
data RootOperationTypeDefinition
|
||||
= RootOperationTypeDefinition OperationType NamedType
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | All kinds of definitions that can occur in a GraphQL document.
|
||||
data Definition
|
||||
= ExecutableDefinition ExecutableDefinition
|
||||
| TypeSystemDefinition TypeSystemDefinition
|
||||
| TypeSystemExtension TypeSystemExtension
|
||||
deriving (Eq, Show)
|
||||
|
||||
data TypeSystemDefinition
|
||||
= SchemaDefinition [Directive] RootOperationTypeDefinitions
|
||||
| TypeDefinition TypeDefinition
|
||||
| DirectiveDefinition Description Name ArgumentsDefinition DirectiveLocation
|
||||
deriving (Eq, Show)
|
||||
|
||||
data SchemaExtension
|
||||
= SchemaOperationExtension [Directive] RootOperationTypeDefinitions
|
||||
| SchemaDirectiveExtension (NonEmpty Directive)
|
||||
deriving (Eq, Show)
|
||||
|
||||
data TypeSystemExtension
|
||||
= SchemaExtension SchemaExtension
|
||||
| TypeExtension TypeExtension
|
||||
deriving (Eq, Show)
|
||||
|
||||
newtype ImplementsInterfaces = ImplementsInterfaces (NonEmpty NamedType)
|
||||
deriving (Eq, Show)
|
||||
newtype ImplementsInterfacesOpt = ImplementsInterfacesOpt [NamedType]
|
||||
deriving (Eq, Show)
|
||||
|
||||
newtype UnionMemberTypes = UnionMemberTypes (NonEmpty NamedType)
|
||||
deriving (Eq, Show)
|
||||
newtype UnionMemberTypesOpt = UnionMemberTypesOpt [NamedType]
|
||||
deriving (Eq, Show)
|
||||
|
||||
newtype InputFieldsDefinition = InputFieldsDefinition (NonEmpty InputValueDefinition)
|
||||
deriving (Eq, Show)
|
||||
newtype InputFieldsDefinitionOpt = InputFieldsDefinitionOpt [InputValueDefinition]
|
||||
deriving (Eq, Show)
|
||||
|
||||
data InputValueDefinition
|
||||
= InputValueDefinition Description Name Type (Maybe Value) [Directive]
|
||||
deriving (Eq, Show)
|
||||
|
||||
newtype ArgumentsDefinition = ArgumentsDefinition [InputValueDefinition]
|
||||
deriving (Eq, Show)
|
||||
|
||||
data EnumValueDefinition = EnumValueDefinition Description Name [Directive]
|
||||
deriving (Eq, Show)
|
||||
|
||||
data FieldDefinition = FieldDefinition Description Name ArgumentsDefinition Type
|
||||
deriving (Eq, Show)
|
||||
|
||||
data TypeDefinition
|
||||
= ScalarTypeDefinition Description Name [Directive]
|
||||
| ObjectTypeDefinition Description Name ImplementsInterfacesOpt [Directive] [FieldDefinition]
|
||||
| InterfaceTypeDefinition Description Name [Directive] [FieldDefinition]
|
||||
| UnionTypeDefinition Description Name [Directive] UnionMemberTypesOpt
|
||||
| EnumTypeDefinition Description Name [Directive] [EnumValueDefinition]
|
||||
| InputObjectTypeDefinition Description Name [Directive] InputFieldsDefinitionOpt
|
||||
deriving (Eq, Show)
|
||||
|
||||
data TypeExtension
|
||||
= ScalarTypeExtension Name (NonEmpty Directive)
|
||||
| ObjectTypeFieldsDefinitionExtension Name ImplementsInterfacesOpt [Directive] (NonEmpty FieldDefinition)
|
||||
| ObjectTypeDirectivesExtension Name ImplementsInterfacesOpt (NonEmpty Directive)
|
||||
| ObjectTypeImplementsInterfacesExtension Name ImplementsInterfaces
|
||||
| InterfaceTypeFieldsDefinitionExtension Name [Directive] (NonEmpty FieldDefinition)
|
||||
| InterfaceTypeDirectivesExtension Name (NonEmpty Directive)
|
||||
| UnionTypeUnionMemberTypesExtension Name [Directive] UnionMemberTypes
|
||||
| UnionDirectivesExtension Name (NonEmpty Directive)
|
||||
| EnumTypeEnumValuesDefinitionExtension Name [Directive] (NonEmpty EnumValueDefinition)
|
||||
| EnumTypeDirectivesExtension Name (NonEmpty Directive)
|
||||
| InputObjectTypeInputFieldsDefinitionExtension Name [Directive] InputFieldsDefinition
|
||||
| InputObjectTypeDirectivesExtension Name (NonEmpty Directive)
|
||||
deriving (Eq, Show)
|
@ -26,6 +26,7 @@ import qualified Data.Text.Lazy.Builder as Builder
|
||||
import Data.Text.Lazy.Builder.Int (decimal, hexadecimal)
|
||||
import Data.Text.Lazy.Builder.RealFloat (realFloat)
|
||||
import qualified Language.GraphQL.AST as Full
|
||||
import Language.GraphQL.AST.Document
|
||||
|
||||
-- | Instructs the encoder whether the GraphQL document should be minified or
|
||||
-- pretty printed.
|
||||
@ -43,17 +44,18 @@ pretty = Pretty 0
|
||||
minified :: Formatter
|
||||
minified = Minified
|
||||
|
||||
-- | Converts a 'Full.Document' into a string.
|
||||
document :: Formatter -> Full.Document -> Lazy.Text
|
||||
-- | Converts a Document' into a string.
|
||||
document :: Formatter -> Document -> Lazy.Text
|
||||
document formatter defs
|
||||
| Pretty _ <- formatter = Lazy.Text.intercalate "\n" encodeDocument
|
||||
| Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'
|
||||
where
|
||||
encodeDocument = foldr executableDefinition [] defs
|
||||
executableDefinition (Full.ExecutableDefinition x) acc = definition formatter x : acc
|
||||
executableDefinition (ExecutableDefinition x) acc = definition formatter x : acc
|
||||
executableDefinition _ acc = acc
|
||||
|
||||
-- | Converts a 'Full.Definition' into a string.
|
||||
definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text
|
||||
definition :: Formatter -> ExecutableDefinition -> Lazy.Text
|
||||
definition formatter x
|
||||
| Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n'
|
||||
| Minified <- formatter = encodeDefinition x
|
||||
|
@ -9,14 +9,15 @@ module Language.GraphQL.AST.Parser
|
||||
import Control.Applicative (Alternative(..), optional)
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Language.GraphQL.AST
|
||||
import qualified Language.GraphQL.AST.Document as Document
|
||||
import Language.GraphQL.AST.Lexer
|
||||
import Text.Megaparsec (lookAhead, option, try, (<?>))
|
||||
|
||||
-- | Parser for the GraphQL documents.
|
||||
document :: Parser Document
|
||||
document :: Parser Document.Document
|
||||
document = unicodeBOM
|
||||
>> spaceConsumer
|
||||
>> lexeme (manyNE $ ExecutableDefinition <$> definition)
|
||||
>> lexeme (manyNE $ Document.ExecutableDefinition <$> definition)
|
||||
|
||||
definition :: Parser ExecutableDefinition
|
||||
definition = DefinitionOperation <$> operationDefinition
|
||||
|
@ -13,7 +13,7 @@ import Data.List.NonEmpty (NonEmpty(..))
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Language.GraphQL.AST as AST
|
||||
import Language.GraphQL.AST.Document
|
||||
import qualified Language.GraphQL.AST.Core as AST.Core
|
||||
import qualified Language.GraphQL.Execute.Transform as Transform
|
||||
import Language.GraphQL.Error
|
||||
@ -27,7 +27,7 @@ import qualified Language.GraphQL.Schema as Schema
|
||||
execute :: MonadIO m
|
||||
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers.
|
||||
-> Schema.Subs -- ^ Variable substitution function.
|
||||
-> AST.Document -- @GraphQL@ document.
|
||||
-> Document -- @GraphQL@ document.
|
||||
-> m Aeson.Value
|
||||
execute schema subs doc =
|
||||
maybe transformError (document schema Nothing) $ Transform.document subs doc
|
||||
@ -44,7 +44,7 @@ executeWithName :: MonadIO m
|
||||
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers
|
||||
-> Text -- ^ Operation name.
|
||||
-> Schema.Subs -- ^ Variable substitution function.
|
||||
-> AST.Document -- ^ @GraphQL@ Document.
|
||||
-> Document -- ^ @GraphQL@ Document.
|
||||
-> m Aeson.Value
|
||||
executeWithName schema name subs doc =
|
||||
maybe transformError (document schema $ Just name) $ Transform.document subs doc
|
||||
|
@ -19,6 +19,7 @@ import qualified Data.List.NonEmpty as NonEmpty
|
||||
import Data.Sequence (Seq, (<|), (><))
|
||||
import qualified Language.GraphQL.AST as Full
|
||||
import qualified Language.GraphQL.AST.Core as Core
|
||||
import Language.GraphQL.AST.Document (Definition(..), Document)
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
import qualified Language.GraphQL.Type.Directive as Directive
|
||||
|
||||
@ -35,18 +36,19 @@ liftJust = lift . lift . Just
|
||||
|
||||
-- | Rewrites the original syntax tree into an intermediate representation used
|
||||
-- for query execution.
|
||||
document :: Schema.Subs -> Full.Document -> Maybe Core.Document
|
||||
document :: Schema.Subs -> Document -> Maybe Core.Document
|
||||
document subs document' =
|
||||
flip runReaderT subs
|
||||
$ evalStateT (collectFragments >> operations operationDefinitions)
|
||||
$ Replacement HashMap.empty fragmentTable
|
||||
where
|
||||
(fragmentTable, operationDefinitions) = foldr defragment mempty document'
|
||||
defragment (Full.ExecutableDefinition (Full.DefinitionOperation definition)) acc =
|
||||
defragment (ExecutableDefinition (Full.DefinitionOperation definition)) acc =
|
||||
(definition :) <$> acc
|
||||
defragment (Full.ExecutableDefinition (Full.DefinitionFragment definition)) acc =
|
||||
defragment (ExecutableDefinition (Full.DefinitionFragment definition)) acc =
|
||||
let (Full.FragmentDefinition name _ _ _) = definition
|
||||
in first (HashMap.insert name definition) acc
|
||||
defragment _ acc = acc
|
||||
|
||||
-- * Operation
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user