graphql/src/Language/GraphQL/AST/Document.hs

365 lines
9.3 KiB
Haskell
Raw Normal View History

2020-01-07 13:56:58 +01:00
{-# LANGUAGE OverloadedStrings #-}
-- | This module defines an abstract syntax tree for the @GraphQL@ language. It
2019-12-28 07:07:58 +01:00
-- follows closely the structure given in the specification. Please refer to
-- <https://facebook.github.io/graphql/ Facebook's GraphQL Specification>.
-- for more information.
2019-12-26 13:00:47 +01:00
module Language.GraphQL.AST.Document
2019-12-28 07:07:58 +01:00
( Alias
, Argument(..)
2020-01-05 07:42:04 +01:00
, ArgumentsDefinition(..)
, Definition(..)
2020-01-05 07:42:04 +01:00
, Description(..)
2019-12-28 07:07:58 +01:00
, Directive(..)
2019-12-26 13:00:47 +01:00
, Document
, EnumValueDefinition(..)
2019-12-26 13:00:47 +01:00
, ExecutableDefinition(..)
2020-01-05 07:42:04 +01:00
, FieldDefinition(..)
2019-12-28 07:07:58 +01:00
, FragmentDefinition(..)
2020-01-05 07:42:04 +01:00
, ImplementsInterfaces(..)
, InputValueDefinition(..)
2019-12-28 07:07:58 +01:00
, Name
2020-01-07 13:56:58 +01:00
, NamedType
2019-12-28 07:07:58 +01:00
, NonNullType(..)
, ObjectField(..)
, OperationDefinition(..)
, OperationType(..)
2020-01-03 07:20:48 +01:00
, OperationTypeDefinition(..)
, SchemaExtension(..)
2019-12-28 07:07:58 +01:00
, Selection(..)
, SelectionSet
, SelectionSetOpt
, Type(..)
, TypeCondition
2020-01-05 07:42:04 +01:00
, TypeDefinition(..)
2020-01-07 13:56:58 +01:00
, TypeExtension(..)
2020-01-03 07:20:48 +01:00
, TypeSystemDefinition(..)
, TypeSystemExtension(..)
2020-01-07 13:56:58 +01:00
, UnionMemberTypes(..)
2019-12-28 07:07:58 +01:00
, Value(..)
, VariableDefinition(..)
2019-12-26 13:00:47 +01:00
) where
2020-01-07 13:56:58 +01:00
import Data.Foldable (toList)
2019-12-28 07:07:58 +01:00
import Data.Int (Int32)
2019-12-26 13:00:47 +01:00
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
2020-01-07 13:56:58 +01:00
import qualified Data.Text as Text
2019-12-26 13:00:47 +01:00
import Language.GraphQL.AST.DirectiveLocation
-- * Language
2019-12-28 07:07:58 +01:00
-- ** Source Text
-- | Name.
type Name = Text
-- ** Document
2019-12-26 13:00:47 +01:00
-- | GraphQL document.
type Document = NonEmpty Definition
-- | All kinds of definitions that can occur in a GraphQL document.
data Definition
= ExecutableDefinition ExecutableDefinition
| TypeSystemDefinition TypeSystemDefinition
| TypeSystemExtension TypeSystemExtension
deriving (Eq, Show)
2019-12-28 07:07:58 +01:00
-- | Top-level definition of a document, either an operation or a fragment.
data ExecutableDefinition
= DefinitionOperation OperationDefinition
| DefinitionFragment FragmentDefinition
deriving (Eq, Show)
-- ** Operations
-- | Operation definition.
data OperationDefinition
= SelectionSet SelectionSet
| OperationDefinition
OperationType
(Maybe Name)
[VariableDefinition]
[Directive]
SelectionSet
deriving (Eq, Show)
-- | GraphQL has 3 operation types:
--
-- * query - a read-only fetch.
-- * mutation - a write operation followed by a fetch.
-- * subscription - a long-lived request that fetches data in response to
-- source events.
--
-- Currently only queries and mutations are supported.
data OperationType = Query | Mutation deriving (Eq, Show)
-- ** Selection Sets
-- | "Top-level" selection, selection on an operation or fragment.
type SelectionSet = NonEmpty Selection
-- | Field selection.
type SelectionSetOpt = [Selection]
-- | Selection is a single entry in a selection set. It can be a single field,
-- fragment spread or inline fragment.
--
-- The only required property of a field is its name. Optionally it can also
-- have an alias, arguments, directives and a list of subfields.
--
-- In the following query "user" is a field with two subfields, "id" and "name":
--
-- @
-- {
-- user {
-- id
-- name
-- }
-- }
-- @
--
-- A fragment spread refers to a fragment defined outside the operation and is
-- expanded at the execution time.
--
-- @
-- {
-- user {
-- ...userFragment
-- }
-- }
--
-- fragment userFragment on UserType {
-- id
-- name
-- }
-- @
--
-- Inline fragments are similar but they don't have any name and the type
-- condition ("on UserType") is optional.
--
-- @
-- {
-- user {
-- ... on UserType {
-- id
-- name
-- }
-- }
-- @
data Selection
= Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt
| FragmentSpread Name [Directive]
| InlineFragment (Maybe TypeCondition) [Directive] SelectionSet
deriving (Eq, Show)
-- ** Arguments
-- | Single argument.
--
-- @
-- {
-- user(id: 4) {
-- name
-- }
-- }
-- @
--
-- Here "id" is an argument for the field "user" and its value is 4.
data Argument = Argument Name Value deriving (Eq,Show)
-- ** Field Alias
-- | Alternative field name.
--
-- @
-- {
-- smallPic: profilePic(size: 64)
-- bigPic: profilePic(size: 1024)
-- }
-- @
--
-- Here "smallPic" and "bigPic" are aliases for the same field, "profilePic",
-- used to distinquish between profile pictures with different arguments
-- (sizes).
type Alias = Name
-- ** Fragments
-- | Fragment definition.
data FragmentDefinition
= FragmentDefinition Name TypeCondition [Directive] SelectionSet
deriving (Eq, Show)
-- | Type condition.
type TypeCondition = Name
-- ** Input Values
-- | Input value.
data Value
= Variable Name
| Int Int32
| Float Double
| String Text
| Boolean Bool
| Null
| Enum Name
| List [Value]
| Object [ObjectField]
deriving (Eq, Show)
-- | Key-value pair.
--
-- A list of 'ObjectField's represents a GraphQL object type.
data ObjectField = ObjectField Name Value deriving (Eq, Show)
-- ** Variables
-- | Variable definition.
data VariableDefinition = VariableDefinition Name Type (Maybe Value)
deriving (Eq, Show)
-- ** Type References
-- | Type representation.
data Type
= TypeNamed Name
| TypeList Type
| TypeNonNull NonNullType
deriving (Eq, Show)
type NamedType = Name
-- | Helper type to represent Non-Null types and lists of such types.
data NonNullType
= NonNullTypeNamed Name
| NonNullTypeList Type
deriving (Eq, Show)
-- ** Directives
-- | Directive.
data Directive = Directive Name [Argument] deriving (Eq, Show)
-- * Type System
2019-12-26 13:00:47 +01:00
data TypeSystemDefinition
2020-01-25 16:37:17 +01:00
= SchemaDefinition [Directive] (NonEmpty OperationTypeDefinition)
2019-12-26 13:00:47 +01:00
| TypeDefinition TypeDefinition
2019-12-28 07:07:58 +01:00
| DirectiveDefinition
2020-01-15 20:20:50 +01:00
Description Name ArgumentsDefinition (NonEmpty DirectiveLocation)
2019-12-26 13:00:47 +01:00
deriving (Eq, Show)
-- ** Type System Extensions
2019-12-26 13:00:47 +01:00
data TypeSystemExtension
= SchemaExtension SchemaExtension
| TypeExtension TypeExtension
deriving (Eq, Show)
-- ** Schema
2019-12-26 13:00:47 +01:00
2020-01-03 07:20:48 +01:00
data OperationTypeDefinition
= OperationTypeDefinition OperationType NamedType
2019-12-26 13:00:47 +01:00
deriving (Eq, Show)
data SchemaExtension
2020-01-25 16:37:17 +01:00
= SchemaOperationExtension [Directive] (NonEmpty OperationTypeDefinition)
2020-01-28 11:08:28 +01:00
| SchemaDirectivesExtension (NonEmpty Directive)
2019-12-26 13:00:47 +01:00
deriving (Eq, Show)
-- ** Descriptions
2019-12-26 13:00:47 +01:00
newtype Description = Description (Maybe Text)
2019-12-26 13:00:47 +01:00
deriving (Eq, Show)
-- ** Types
2019-12-26 13:00:47 +01:00
data TypeDefinition
= ScalarTypeDefinition Description Name [Directive]
| ObjectTypeDefinition
2020-01-07 13:56:58 +01:00
Description
Name
(ImplementsInterfaces [])
[Directive]
[FieldDefinition]
2019-12-26 13:00:47 +01:00
| InterfaceTypeDefinition Description Name [Directive] [FieldDefinition]
2020-01-07 13:56:58 +01:00
| UnionTypeDefinition Description Name [Directive] (UnionMemberTypes [])
2019-12-26 13:00:47 +01:00
| EnumTypeDefinition Description Name [Directive] [EnumValueDefinition]
| InputObjectTypeDefinition
Description Name [Directive] [InputValueDefinition]
2019-12-26 13:00:47 +01:00
deriving (Eq, Show)
data TypeExtension
= ScalarTypeExtension Name (NonEmpty Directive)
| ObjectTypeFieldsDefinitionExtension
2020-01-07 13:56:58 +01:00
Name (ImplementsInterfaces []) [Directive] (NonEmpty FieldDefinition)
| ObjectTypeDirectivesExtension
2020-01-07 13:56:58 +01:00
Name (ImplementsInterfaces []) (NonEmpty Directive)
| ObjectTypeImplementsInterfacesExtension
Name (ImplementsInterfaces NonEmpty)
| InterfaceTypeFieldsDefinitionExtension
Name [Directive] (NonEmpty FieldDefinition)
2019-12-26 13:00:47 +01:00
| InterfaceTypeDirectivesExtension Name (NonEmpty Directive)
2020-01-07 13:56:58 +01:00
| UnionTypeUnionMemberTypesExtension
Name [Directive] (UnionMemberTypes NonEmpty)
| UnionTypeDirectivesExtension Name (NonEmpty Directive)
| EnumTypeEnumValuesDefinitionExtension
Name [Directive] (NonEmpty EnumValueDefinition)
2019-12-26 13:00:47 +01:00
| EnumTypeDirectivesExtension Name (NonEmpty Directive)
| InputObjectTypeInputFieldsDefinitionExtension
Name [Directive] (NonEmpty InputValueDefinition)
2019-12-26 13:00:47 +01:00
| InputObjectTypeDirectivesExtension Name (NonEmpty Directive)
deriving (Eq, Show)
-- ** Objects
2020-01-07 13:56:58 +01:00
newtype ImplementsInterfaces t = ImplementsInterfaces (t NamedType)
2020-01-07 13:56:58 +01:00
instance Foldable t => Eq (ImplementsInterfaces t) where
(ImplementsInterfaces xs) == (ImplementsInterfaces ys)
= toList xs == toList ys
2020-01-05 07:42:04 +01:00
2020-01-07 13:56:58 +01:00
instance Foldable t => Show (ImplementsInterfaces t) where
show (ImplementsInterfaces interfaces) = Text.unpack
$ Text.append "implements"
$ Text.intercalate " & "
$ toList interfaces
2020-01-05 07:42:04 +01:00
2019-12-28 07:07:58 +01:00
data FieldDefinition
2020-01-05 07:42:04 +01:00
= FieldDefinition Description Name ArgumentsDefinition Type [Directive]
deriving (Eq, Show)
newtype ArgumentsDefinition = ArgumentsDefinition [InputValueDefinition]
deriving (Eq, Show)
2020-01-05 07:42:04 +01:00
instance Semigroup ArgumentsDefinition where
(ArgumentsDefinition xs) <> (ArgumentsDefinition ys) =
ArgumentsDefinition $ xs <> ys
instance Monoid ArgumentsDefinition where
mempty = ArgumentsDefinition []
data InputValueDefinition
= InputValueDefinition Description Name Type (Maybe Value) [Directive]
deriving (Eq, Show)
-- ** Unions
2020-01-07 13:56:58 +01:00
newtype UnionMemberTypes t = UnionMemberTypes (t NamedType)
2020-01-07 13:56:58 +01:00
instance Foldable t => Eq (UnionMemberTypes t) where
(UnionMemberTypes xs) == (UnionMemberTypes ys) = toList xs == toList ys
instance Foldable t => Show (UnionMemberTypes t) where
show (UnionMemberTypes memberTypes) = Text.unpack
$ Text.intercalate " | "
$ toList memberTypes
-- ** Enums
data EnumValueDefinition = EnumValueDefinition Description Name [Directive]
deriving (Eq, Show)