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/).
|
[Haskell Package Versioning Policy](https://pvp.haskell.org/).
|
||||||
|
|
||||||
## [Unreleased]
|
## [Unreleased]
|
||||||
|
### Added
|
||||||
|
- AST for the GraphQL schema.
|
||||||
|
|
||||||
### Changed
|
### Changed
|
||||||
- Rename `AST.Definition` into `AST.ExecutableDefinition`.
|
- Rename `AST.Definition` into `AST.ExecutableDefinition`.
|
||||||
TypeSystemDefinition and TypeSystemExtension can also be definitions.
|
`AST.TypeSystemDefinition` and `AST.TypeSystemExtension` can also be
|
||||||
- Define `AST.Definition` as
|
definitions.
|
||||||
`newtype Definition = ExecutableDefinition ExecutableDefinition` for now. It
|
|
||||||
should be soon extended to contain missing definition types.
|
|
||||||
|
|
||||||
### Removed
|
### Removed
|
||||||
- `AST.Field`, `AST.InlineFragment` and `AST.FragmentSpread`.
|
- `AST.Field`, `AST.InlineFragment` and `AST.FragmentSpread`.
|
||||||
|
@ -5,10 +5,8 @@
|
|||||||
module Language.GraphQL.AST
|
module Language.GraphQL.AST
|
||||||
( Alias
|
( Alias
|
||||||
, Argument(..)
|
, Argument(..)
|
||||||
, Definition(..)
|
|
||||||
, Directive(..)
|
|
||||||
, Document
|
|
||||||
, ExecutableDefinition(..)
|
, ExecutableDefinition(..)
|
||||||
|
, Directive(..)
|
||||||
, FragmentDefinition(..)
|
, FragmentDefinition(..)
|
||||||
, Name
|
, Name
|
||||||
, NonNullType(..)
|
, NonNullType(..)
|
||||||
@ -28,15 +26,6 @@ import Data.Int (Int32)
|
|||||||
import Data.List.NonEmpty (NonEmpty)
|
import Data.List.NonEmpty (NonEmpty)
|
||||||
import Data.Text (Text)
|
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
|
-- | Name
|
||||||
type Name = Text
|
type Name = Text
|
||||||
|
|
||||||
@ -74,8 +63,6 @@ type SelectionSet = NonEmpty Selection
|
|||||||
-- | Field selection.
|
-- | Field selection.
|
||||||
type SelectionSetOpt = [Selection]
|
type SelectionSetOpt = [Selection]
|
||||||
|
|
||||||
-- * Field
|
|
||||||
|
|
||||||
-- | Single GraphQL field.
|
-- | Single GraphQL field.
|
||||||
--
|
--
|
||||||
-- The only required property of a field is its name. Optionally it can also
|
-- 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.Int (decimal, hexadecimal)
|
||||||
import Data.Text.Lazy.Builder.RealFloat (realFloat)
|
import Data.Text.Lazy.Builder.RealFloat (realFloat)
|
||||||
import qualified Language.GraphQL.AST as Full
|
import qualified Language.GraphQL.AST as Full
|
||||||
|
import Language.GraphQL.AST.Document
|
||||||
|
|
||||||
-- | Instructs the encoder whether the GraphQL document should be minified or
|
-- | Instructs the encoder whether the GraphQL document should be minified or
|
||||||
-- pretty printed.
|
-- pretty printed.
|
||||||
@ -43,17 +44,18 @@ pretty = Pretty 0
|
|||||||
minified :: Formatter
|
minified :: Formatter
|
||||||
minified = Minified
|
minified = Minified
|
||||||
|
|
||||||
-- | Converts a 'Full.Document' into a string.
|
-- | Converts a Document' into a string.
|
||||||
document :: Formatter -> Full.Document -> Lazy.Text
|
document :: Formatter -> Document -> Lazy.Text
|
||||||
document formatter defs
|
document formatter defs
|
||||||
| Pretty _ <- formatter = Lazy.Text.intercalate "\n" encodeDocument
|
| Pretty _ <- formatter = Lazy.Text.intercalate "\n" encodeDocument
|
||||||
| Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'
|
| Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'
|
||||||
where
|
where
|
||||||
encodeDocument = foldr executableDefinition [] defs
|
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.
|
-- | Converts a 'Full.Definition' into a string.
|
||||||
definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text
|
definition :: Formatter -> ExecutableDefinition -> Lazy.Text
|
||||||
definition formatter x
|
definition formatter x
|
||||||
| Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n'
|
| Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n'
|
||||||
| Minified <- formatter = encodeDefinition x
|
| Minified <- formatter = encodeDefinition x
|
||||||
|
@ -9,14 +9,15 @@ module Language.GraphQL.AST.Parser
|
|||||||
import Control.Applicative (Alternative(..), optional)
|
import Control.Applicative (Alternative(..), optional)
|
||||||
import Data.List.NonEmpty (NonEmpty(..))
|
import Data.List.NonEmpty (NonEmpty(..))
|
||||||
import Language.GraphQL.AST
|
import Language.GraphQL.AST
|
||||||
|
import qualified Language.GraphQL.AST.Document as Document
|
||||||
import Language.GraphQL.AST.Lexer
|
import Language.GraphQL.AST.Lexer
|
||||||
import Text.Megaparsec (lookAhead, option, try, (<?>))
|
import Text.Megaparsec (lookAhead, option, try, (<?>))
|
||||||
|
|
||||||
-- | Parser for the GraphQL documents.
|
-- | Parser for the GraphQL documents.
|
||||||
document :: Parser Document
|
document :: Parser Document.Document
|
||||||
document = unicodeBOM
|
document = unicodeBOM
|
||||||
>> spaceConsumer
|
>> spaceConsumer
|
||||||
>> lexeme (manyNE $ ExecutableDefinition <$> definition)
|
>> lexeme (manyNE $ Document.ExecutableDefinition <$> definition)
|
||||||
|
|
||||||
definition :: Parser ExecutableDefinition
|
definition :: Parser ExecutableDefinition
|
||||||
definition = DefinitionOperation <$> operationDefinition
|
definition = DefinitionOperation <$> operationDefinition
|
||||||
|
@ -13,7 +13,7 @@ import Data.List.NonEmpty (NonEmpty(..))
|
|||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.List.NonEmpty as NE
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as 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.AST.Core as AST.Core
|
||||||
import qualified Language.GraphQL.Execute.Transform as Transform
|
import qualified Language.GraphQL.Execute.Transform as Transform
|
||||||
import Language.GraphQL.Error
|
import Language.GraphQL.Error
|
||||||
@ -27,7 +27,7 @@ import qualified Language.GraphQL.Schema as Schema
|
|||||||
execute :: MonadIO m
|
execute :: MonadIO m
|
||||||
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers.
|
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers.
|
||||||
-> Schema.Subs -- ^ Variable substitution function.
|
-> Schema.Subs -- ^ Variable substitution function.
|
||||||
-> AST.Document -- @GraphQL@ document.
|
-> Document -- @GraphQL@ document.
|
||||||
-> m Aeson.Value
|
-> m Aeson.Value
|
||||||
execute schema subs doc =
|
execute schema subs doc =
|
||||||
maybe transformError (document schema Nothing) $ Transform.document subs doc
|
maybe transformError (document schema Nothing) $ Transform.document subs doc
|
||||||
@ -44,7 +44,7 @@ executeWithName :: MonadIO m
|
|||||||
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers
|
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers
|
||||||
-> Text -- ^ Operation name.
|
-> Text -- ^ Operation name.
|
||||||
-> Schema.Subs -- ^ Variable substitution function.
|
-> Schema.Subs -- ^ Variable substitution function.
|
||||||
-> AST.Document -- ^ @GraphQL@ Document.
|
-> Document -- ^ @GraphQL@ Document.
|
||||||
-> m Aeson.Value
|
-> m Aeson.Value
|
||||||
executeWithName schema name subs doc =
|
executeWithName schema name subs doc =
|
||||||
maybe transformError (document schema $ Just name) $ Transform.document 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 Data.Sequence (Seq, (<|), (><))
|
||||||
import qualified Language.GraphQL.AST as Full
|
import qualified Language.GraphQL.AST as Full
|
||||||
import qualified Language.GraphQL.AST.Core as Core
|
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.Schema as Schema
|
||||||
import qualified Language.GraphQL.Type.Directive as Directive
|
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
|
-- | Rewrites the original syntax tree into an intermediate representation used
|
||||||
-- for query execution.
|
-- for query execution.
|
||||||
document :: Schema.Subs -> Full.Document -> Maybe Core.Document
|
document :: Schema.Subs -> Document -> Maybe Core.Document
|
||||||
document subs document' =
|
document subs document' =
|
||||||
flip runReaderT subs
|
flip runReaderT subs
|
||||||
$ evalStateT (collectFragments >> operations operationDefinitions)
|
$ evalStateT (collectFragments >> operations operationDefinitions)
|
||||||
$ Replacement HashMap.empty fragmentTable
|
$ Replacement HashMap.empty fragmentTable
|
||||||
where
|
where
|
||||||
(fragmentTable, operationDefinitions) = foldr defragment mempty document'
|
(fragmentTable, operationDefinitions) = foldr defragment mempty document'
|
||||||
defragment (Full.ExecutableDefinition (Full.DefinitionOperation definition)) acc =
|
defragment (ExecutableDefinition (Full.DefinitionOperation definition)) acc =
|
||||||
(definition :) <$> acc
|
(definition :) <$> acc
|
||||||
defragment (Full.ExecutableDefinition (Full.DefinitionFragment definition)) acc =
|
defragment (ExecutableDefinition (Full.DefinitionFragment definition)) acc =
|
||||||
let (Full.FragmentDefinition name _ _ _) = definition
|
let (Full.FragmentDefinition name _ _ _) = definition
|
||||||
in first (HashMap.insert name definition) acc
|
in first (HashMap.insert name definition) acc
|
||||||
|
defragment _ acc = acc
|
||||||
|
|
||||||
-- * Operation
|
-- * Operation
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user