Add Union and Interface type definitions
This commit is contained in:
parent
61dbe6c728
commit
c06d0b8e95
16
CHANGELOG.md
16
CHANGELOG.md
@ -23,10 +23,8 @@ and this project adheres to
|
|||||||
returns a resolver (just the function). There is no need in special functions
|
returns a resolver (just the function). There is no need in special functions
|
||||||
to construct field resolvers anymore, they can be constructed with just
|
to construct field resolvers anymore, they can be constructed with just
|
||||||
`Resolver "fieldName" $ pure $ object [...]`.
|
`Resolver "fieldName" $ pure $ object [...]`.
|
||||||
- `Execute.Transform.operation` has the prior responsibility of
|
- `AST.Core.Document` was modified to contain only slightly modified AST and
|
||||||
`Execute.Transform.document`, but transforms only the chosen operation and not
|
moved into `Execute.Transform.Document`.
|
||||||
the whole document. `Execute.Transform.document` translates
|
|
||||||
`AST.Document.Document` into `Execute.Transform.Document`.
|
|
||||||
- `AST.Core.Value` was moved into `Type.In`. Input values are used only in the
|
- `AST.Core.Value` was moved into `Type.In`. Input values are used only in the
|
||||||
execution and type system, it is not a part of the parsing tree.
|
execution and type system, it is not a part of the parsing tree.
|
||||||
- `Type` module is superseded by `Type.Out`. This module contains now only
|
- `Type` module is superseded by `Type.Out`. This module contains now only
|
||||||
@ -38,18 +36,18 @@ and this project adheres to
|
|||||||
- `Type.Schema` describes a schema. Both public functions that execute queries
|
- `Type.Schema` describes a schema. Both public functions that execute queries
|
||||||
accept a `Schema` now instead of a `HashMap`. The execution fails if the root
|
accept a `Schema` now instead of a `HashMap`. The execution fails if the root
|
||||||
operation doesn't match the root Query type in the schema.
|
operation doesn't match the root Query type in the schema.
|
||||||
- `Type.In` and `Type.Out` contain definitions for input and the most output
|
- `Type.In` and `Type.Out` contain definitions for input and output types.
|
||||||
types.
|
|
||||||
- `Execute.Coerce` defines a typeclass responsible for input, variable value
|
- `Execute.Coerce` defines a typeclass responsible for input, variable value
|
||||||
coercion. It decouples us a bit from JSON since any format can be used to pass
|
coercion. It decouples us a bit from JSON since any format can be used to pass
|
||||||
query variables. Execution functions accept (`HashMap Name a`) instead of
|
query variables. Execution functions accept (`HashMap Name a`) instead of
|
||||||
`Subs`, where a is an instance of `VariableValue`.
|
`Subs`, where a is an instance of `VariableValue`.
|
||||||
|
|
||||||
### Removed
|
### Removed
|
||||||
- `AST.Core.Document`. Transforming the whole document is probably not
|
- `Execute.Transform.document`. Transforming the whole document is probably not
|
||||||
reasonable since a document can define multiple operations and we're
|
reasonable since a document can define multiple operations and we're
|
||||||
interested only in one of them. Therefore `Document` was modified, moved to
|
interested only in one of them. `Execute.Transform.operation` has the prior
|
||||||
`Execute.Transform` and made private.
|
responsibility of `Execute.Transform.document`, but transforms only the
|
||||||
|
chosen operation and not the whole document.
|
||||||
- `Schema.scalar`, `Schema.wrappedScalar`. They accepted everything can be
|
- `Schema.scalar`, `Schema.wrappedScalar`. They accepted everything can be
|
||||||
converted to JSON and JSON is not suitable as an internal representation for
|
converted to JSON and JSON is not suitable as an internal representation for
|
||||||
GraphQL. E.g. GraphQL distinguishes between Floats and Integersa and we need
|
GraphQL. E.g. GraphQL distinguishes between Floats and Integersa and we need
|
||||||
|
@ -40,7 +40,7 @@ First we build a GraphQL schema.
|
|||||||
> schema1 = Schema queryType Nothing
|
> schema1 = Schema queryType Nothing
|
||||||
>
|
>
|
||||||
> queryType :: ObjectType IO
|
> queryType :: ObjectType IO
|
||||||
> queryType = ObjectType "Query" Nothing
|
> queryType = ObjectType "Query" Nothing []
|
||||||
> $ HashMap.singleton "hello"
|
> $ HashMap.singleton "hello"
|
||||||
> $ Field Nothing (Out.NamedScalarType string) mempty hello
|
> $ Field Nothing (Out.NamedScalarType string) mempty hello
|
||||||
>
|
>
|
||||||
@ -75,7 +75,7 @@ For this example, we're going to be using time.
|
|||||||
> schema2 = Schema queryType2 Nothing
|
> schema2 = Schema queryType2 Nothing
|
||||||
>
|
>
|
||||||
> queryType2 :: ObjectType IO
|
> queryType2 :: ObjectType IO
|
||||||
> queryType2 = ObjectType "Query" Nothing
|
> queryType2 = ObjectType "Query" Nothing []
|
||||||
> $ HashMap.singleton "time"
|
> $ HashMap.singleton "time"
|
||||||
> $ Field Nothing (Out.NamedScalarType string) mempty time
|
> $ Field Nothing (Out.NamedScalarType string) mempty time
|
||||||
>
|
>
|
||||||
@ -139,7 +139,7 @@ Now that we have two resolvers, we can define a schema which uses them both.
|
|||||||
> schema3 = Schema queryType3 Nothing
|
> schema3 = Schema queryType3 Nothing
|
||||||
>
|
>
|
||||||
> queryType3 :: ObjectType IO
|
> queryType3 :: ObjectType IO
|
||||||
> queryType3 = ObjectType "Query" Nothing $ HashMap.fromList
|
> queryType3 = ObjectType "Query" Nothing [] $ HashMap.fromList
|
||||||
> [ ("hello", Field Nothing (Out.NamedScalarType string) mempty hello)
|
> [ ("hello", Field Nothing (Out.NamedScalarType string) mempty hello)
|
||||||
> , ("time", Field Nothing (Out.NamedScalarType string) mempty time)
|
> , ("time", Field Nothing (Out.NamedScalarType string) mempty time)
|
||||||
> ]
|
> ]
|
||||||
|
@ -9,6 +9,7 @@ module Language.GraphQL.Execute
|
|||||||
|
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as Aeson
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
import qualified Data.HashMap.Strict as HashMap
|
||||||
|
import Data.Sequence (Seq(..))
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Language.GraphQL.AST.Document
|
import Language.GraphQL.AST.Document
|
||||||
import qualified Language.GraphQL.AST.Core as AST.Core
|
import qualified Language.GraphQL.AST.Core as AST.Core
|
||||||
@ -29,7 +30,7 @@ execute :: (Monad m, VariableValue a)
|
|||||||
-> HashMap.HashMap Name a -- ^ Variable substitution function.
|
-> HashMap.HashMap Name a -- ^ Variable substitution function.
|
||||||
-> Document -- @GraphQL@ document.
|
-> Document -- @GraphQL@ document.
|
||||||
-> m Aeson.Value
|
-> m Aeson.Value
|
||||||
execute schema = document schema Nothing
|
execute schema = executeRequest schema Nothing
|
||||||
|
|
||||||
-- | The substitution is applied to the document, and the resolvers are applied
|
-- | The substitution is applied to the document, and the resolvers are applied
|
||||||
-- to the resulting fields. The operation name can be used if the document
|
-- to the resulting fields. The operation name can be used if the document
|
||||||
@ -43,36 +44,34 @@ executeWithName :: (Monad m, VariableValue a)
|
|||||||
-> HashMap.HashMap Name a -- ^ Variable substitution function.
|
-> HashMap.HashMap Name a -- ^ Variable substitution function.
|
||||||
-> Document -- ^ @GraphQL@ Document.
|
-> Document -- ^ @GraphQL@ Document.
|
||||||
-> m Aeson.Value
|
-> m Aeson.Value
|
||||||
executeWithName schema operationName = document schema (Just operationName)
|
executeWithName schema operationName =
|
||||||
|
executeRequest schema (Just operationName)
|
||||||
|
|
||||||
document :: (Monad m, VariableValue a)
|
executeRequest :: (Monad m, VariableValue a)
|
||||||
=> Schema m
|
=> Schema m
|
||||||
-> Maybe Text
|
-> Maybe Text
|
||||||
-> HashMap.HashMap Name a
|
-> HashMap.HashMap Name a
|
||||||
-> Document
|
-> Document
|
||||||
-> m Aeson.Value
|
-> m Aeson.Value
|
||||||
document schema operationName subs document' =
|
executeRequest schema operationName subs document =
|
||||||
case Transform.document schema operationName subs document' of
|
case Transform.document schema operationName subs document of
|
||||||
Left queryError -> pure $ singleError $ Transform.queryError queryError
|
Left queryError -> pure $ singleError $ Transform.queryError queryError
|
||||||
Right (Transform.Document operation') -> operation schema operation'
|
Right (Transform.Document rootObjectType operation)
|
||||||
|
| (AST.Core.Query _ fields) <- operation ->
|
||||||
|
executeOperation rootObjectType fields
|
||||||
|
| (AST.Core.Mutation _ fields) <- operation ->
|
||||||
|
executeOperation rootObjectType fields
|
||||||
|
|
||||||
operation :: Monad m
|
-- This is actually executeMutation, but we don't distinguish between queries
|
||||||
=> Schema m
|
-- and mutations yet.
|
||||||
-> AST.Core.Operation
|
executeOperation :: Monad m
|
||||||
|
=> Out.ObjectType m
|
||||||
|
-> Seq AST.Core.Selection
|
||||||
-> m Aeson.Value
|
-> m Aeson.Value
|
||||||
operation = schemaOperation
|
executeOperation (Out.ObjectType _ _ _ objectFields) fields
|
||||||
|
= runCollectErrs
|
||||||
|
$ flip Schema.resolve fields
|
||||||
|
$ fmap getResolver
|
||||||
|
$ objectFields
|
||||||
where
|
where
|
||||||
resolve queryFields = runCollectErrs
|
|
||||||
. flip Schema.resolve queryFields
|
|
||||||
. fmap getResolver
|
|
||||||
. fields
|
|
||||||
fields (Out.ObjectType _ _ objectFields) = objectFields
|
|
||||||
lookupError = pure
|
|
||||||
$ singleError "Root operation type couldn't be found in the schema."
|
|
||||||
schemaOperation Schema {query} (AST.Core.Query _ fields') =
|
|
||||||
resolve fields' query
|
|
||||||
schemaOperation Schema {mutation = Just mutation} (AST.Core.Mutation _ fields') =
|
|
||||||
resolve fields' mutation
|
|
||||||
schemaOperation Schema {mutation = Nothing} (AST.Core.Mutation _ _) =
|
|
||||||
lookupError
|
|
||||||
getResolver (Out.Field _ _ _ resolver) = resolver
|
getResolver (Out.Field _ _ _ resolver) = resolver
|
||||||
|
@ -1,11 +1,20 @@
|
|||||||
{-# LANGUAGE ExplicitForAll #-}
|
{-# LANGUAGE ExplicitForAll #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
|
||||||
-- | After the document is parsed, before getting executed the AST is
|
-- | After the document is parsed, before getting executed, the AST is
|
||||||
-- transformed into a similar, simpler AST. This module is responsible for
|
-- transformed into a similar, simpler AST. Performed transformations include:
|
||||||
-- this transformation.
|
--
|
||||||
|
-- * Replacing variables with their values.
|
||||||
|
-- * Inlining fragments. Some fragments can be completely eliminated and
|
||||||
|
-- replaced by the selection set they represent. Invalid (recursive and
|
||||||
|
-- non-existing) fragments are skipped. The most fragments are inlined, so the
|
||||||
|
-- executor doesn't have to perform additional lookups later.
|
||||||
|
--
|
||||||
|
-- This module is also responsible for smaller rewrites that touch only parts of
|
||||||
|
-- the original AST.
|
||||||
module Language.GraphQL.Execute.Transform
|
module Language.GraphQL.Execute.Transform
|
||||||
( Document(..)
|
( Document(..)
|
||||||
, QueryError(..)
|
, QueryError(..)
|
||||||
@ -32,19 +41,21 @@ import Language.GraphQL.Execute.Coerce
|
|||||||
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
|
||||||
import qualified Language.GraphQL.Type.In as In
|
import qualified Language.GraphQL.Type.In as In
|
||||||
|
import qualified Language.GraphQL.Type.Out as Out
|
||||||
import Language.GraphQL.Type.Schema
|
import Language.GraphQL.Type.Schema
|
||||||
|
|
||||||
-- | Associates a fragment name with a list of 'Core.Field's.
|
-- | Associates a fragment name with a list of 'Core.Field's.
|
||||||
data Replacement = Replacement
|
data Replacement m = Replacement
|
||||||
{ fragments :: HashMap Core.Name Core.Fragment
|
{ fragments :: HashMap Core.Name Core.Fragment
|
||||||
, fragmentDefinitions :: HashMap Full.Name Full.FragmentDefinition
|
, fragmentDefinitions :: FragmentDefinitions
|
||||||
, variableValues :: Schema.Subs
|
, variableValues :: Schema.Subs
|
||||||
|
, types :: HashMap Full.Name (Type m)
|
||||||
}
|
}
|
||||||
|
|
||||||
type TransformT a = State Replacement a
|
type FragmentDefinitions = HashMap Full.Name Full.FragmentDefinition
|
||||||
|
|
||||||
-- | GraphQL document is a non-empty list of operations.
|
-- | Contains the operation to be executed along with its root type.
|
||||||
newtype Document = Document Core.Operation
|
data Document m = Document (Out.ObjectType m) Core.Operation
|
||||||
|
|
||||||
data OperationDefinition = OperationDefinition
|
data OperationDefinition = OperationDefinition
|
||||||
Full.OperationType
|
Full.OperationType
|
||||||
@ -60,6 +71,7 @@ data QueryError
|
|||||||
| CoercionError
|
| CoercionError
|
||||||
| TransformationError
|
| TransformationError
|
||||||
| EmptyDocument
|
| EmptyDocument
|
||||||
|
| UnsupportedRootOperation
|
||||||
|
|
||||||
queryError :: QueryError -> Text
|
queryError :: QueryError -> Text
|
||||||
queryError (OperationNotFound operationName) = Text.unwords
|
queryError (OperationNotFound operationName) = Text.unwords
|
||||||
@ -69,6 +81,8 @@ queryError CoercionError = "Coercion error."
|
|||||||
queryError TransformationError = "Schema transformation error."
|
queryError TransformationError = "Schema transformation error."
|
||||||
queryError EmptyDocument =
|
queryError EmptyDocument =
|
||||||
"The document doesn't contain any executable operations."
|
"The document doesn't contain any executable operations."
|
||||||
|
queryError UnsupportedRootOperation =
|
||||||
|
"Root operation type couldn't be found in the schema."
|
||||||
|
|
||||||
getOperation
|
getOperation
|
||||||
:: Maybe Full.Name
|
:: Maybe Full.Name
|
||||||
@ -112,25 +126,24 @@ lookupInputType (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types
|
|||||||
= In.NonNullListType
|
= In.NonNullListType
|
||||||
<$> lookupInputType nonNull types
|
<$> lookupInputType nonNull types
|
||||||
|
|
||||||
coerceVariableValues :: (Monad m, VariableValue a)
|
coerceVariableValues :: VariableValue a
|
||||||
=> Schema m
|
=> forall m
|
||||||
|
. HashMap Full.Name (Type m)
|
||||||
-> OperationDefinition
|
-> OperationDefinition
|
||||||
-> HashMap.HashMap Full.Name a
|
-> HashMap.HashMap Full.Name a
|
||||||
-> Either QueryError Schema.Subs
|
-> Either QueryError Schema.Subs
|
||||||
coerceVariableValues schema operationDefinition variableValues' =
|
coerceVariableValues types operationDefinition variableValues' =
|
||||||
let referencedTypes = collectReferencedTypes schema
|
let OperationDefinition _ _ variableDefinitions _ _ = operationDefinition
|
||||||
OperationDefinition _ _ variableDefinitions _ _ = operationDefinition
|
|
||||||
coerceValue' = coerceValue referencedTypes
|
|
||||||
in maybe (Left CoercionError) Right
|
in maybe (Left CoercionError) Right
|
||||||
$ foldr coerceValue' (Just HashMap.empty) variableDefinitions
|
$ foldr coerceValue (Just HashMap.empty) variableDefinitions
|
||||||
where
|
where
|
||||||
coerceValue referencedTypes variableDefinition coercedValues = do
|
coerceValue variableDefinition coercedValues = do
|
||||||
let Full.VariableDefinition variableName variableTypeName defaultValue =
|
let Full.VariableDefinition variableName variableTypeName defaultValue =
|
||||||
variableDefinition
|
variableDefinition
|
||||||
let defaultValue' = constValue <$> defaultValue
|
let defaultValue' = constValue <$> defaultValue
|
||||||
let value' = HashMap.lookup variableName variableValues'
|
let value' = HashMap.lookup variableName variableValues'
|
||||||
|
|
||||||
variableType <- lookupInputType variableTypeName referencedTypes
|
variableType <- lookupInputType variableTypeName types
|
||||||
HashMap.insert variableName
|
HashMap.insert variableName
|
||||||
<$> choose value' defaultValue' variableType
|
<$> choose value' defaultValue' variableType
|
||||||
<*> coercedValues
|
<*> coercedValues
|
||||||
@ -158,23 +171,46 @@ constValue (Full.ConstObject o) =
|
|||||||
|
|
||||||
-- | 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 :: (Monad m, VariableValue a)
|
document :: VariableValue a
|
||||||
=> Schema m
|
=> forall m
|
||||||
|
. Schema m
|
||||||
-> Maybe Full.Name
|
-> Maybe Full.Name
|
||||||
-> HashMap Full.Name a
|
-> HashMap Full.Name a
|
||||||
-> Full.Document
|
-> Full.Document
|
||||||
-> Either QueryError Document
|
-> Either QueryError (Document m)
|
||||||
document schema operationName subs ast = do
|
document schema operationName subs ast = do
|
||||||
let (operations, fragmentTable) = foldr defragment ([], HashMap.empty) ast
|
let referencedTypes = collectReferencedTypes schema
|
||||||
nonEmptyOperations <- maybe (Left EmptyDocument) Right
|
|
||||||
$ NonEmpty.nonEmpty operations
|
|
||||||
chosenOperation <- getOperation operationName nonEmptyOperations
|
|
||||||
coercedValues <- coerceVariableValues schema chosenOperation subs
|
|
||||||
|
|
||||||
pure $ Document
|
(operations, fragmentTable) <- defragment ast
|
||||||
$ operation fragmentTable coercedValues chosenOperation
|
chosenOperation <- getOperation operationName operations
|
||||||
|
coercedValues <- coerceVariableValues referencedTypes chosenOperation subs
|
||||||
|
|
||||||
|
let replacement = Replacement
|
||||||
|
{ fragments = HashMap.empty
|
||||||
|
, fragmentDefinitions = fragmentTable
|
||||||
|
, variableValues = coercedValues
|
||||||
|
, types = referencedTypes
|
||||||
|
}
|
||||||
|
case chosenOperation of
|
||||||
|
OperationDefinition Full.Query _ _ _ _ ->
|
||||||
|
pure $ Document (query schema)
|
||||||
|
$ operation (query schema) chosenOperation replacement
|
||||||
|
OperationDefinition Full.Mutation _ _ _ _
|
||||||
|
| Just mutationType <- mutation schema ->
|
||||||
|
pure $ Document mutationType
|
||||||
|
$ operation mutationType chosenOperation replacement
|
||||||
|
_ -> Left UnsupportedRootOperation
|
||||||
|
|
||||||
|
defragment
|
||||||
|
:: Full.Document
|
||||||
|
-> Either QueryError (NonEmpty OperationDefinition, FragmentDefinitions)
|
||||||
|
defragment ast =
|
||||||
|
let (operations, fragmentTable) = foldr defragment' ([], HashMap.empty) ast
|
||||||
|
nonEmptyOperations = NonEmpty.nonEmpty operations
|
||||||
|
emptyDocument = Left EmptyDocument
|
||||||
|
in (, fragmentTable) <$> maybe emptyDocument Right nonEmptyOperations
|
||||||
where
|
where
|
||||||
defragment definition (operations, fragments')
|
defragment' definition (operations, fragments')
|
||||||
| (Full.ExecutableDefinition executable) <- definition
|
| (Full.ExecutableDefinition executable) <- definition
|
||||||
, (Full.DefinitionOperation operation') <- executable =
|
, (Full.DefinitionOperation operation') <- executable =
|
||||||
(transform operation' : operations, fragments')
|
(transform operation' : operations, fragments')
|
||||||
@ -182,7 +218,7 @@ document schema operationName subs ast = do
|
|||||||
, (Full.DefinitionFragment fragment) <- executable
|
, (Full.DefinitionFragment fragment) <- executable
|
||||||
, (Full.FragmentDefinition name _ _ _) <- fragment =
|
, (Full.FragmentDefinition name _ _ _) <- fragment =
|
||||||
(operations, HashMap.insert name fragment fragments')
|
(operations, HashMap.insert name fragment fragments')
|
||||||
defragment _ acc = acc
|
defragment' _ acc = acc
|
||||||
transform = \case
|
transform = \case
|
||||||
Full.OperationDefinition type' name variables directives' selections ->
|
Full.OperationDefinition type' name variables directives' selections ->
|
||||||
OperationDefinition type' name variables directives' selections
|
OperationDefinition type' name variables directives' selections
|
||||||
@ -191,35 +227,34 @@ document schema operationName subs ast = do
|
|||||||
|
|
||||||
-- * Operation
|
-- * Operation
|
||||||
|
|
||||||
operation
|
operation :: forall m
|
||||||
:: HashMap Full.Name Full.FragmentDefinition
|
. Out.ObjectType m
|
||||||
-> Schema.Subs
|
|
||||||
-> OperationDefinition
|
-> OperationDefinition
|
||||||
|
-> Replacement m
|
||||||
-> Core.Operation
|
-> Core.Operation
|
||||||
operation fragmentTable subs operationDefinition
|
operation rootType operationDefinition replacement
|
||||||
= runIdentity
|
= runIdentity
|
||||||
$ evalStateT (collectFragments >> transform operationDefinition)
|
$ evalStateT (collectFragments rootType >> transform operationDefinition) replacement
|
||||||
$ Replacement HashMap.empty fragmentTable subs
|
|
||||||
where
|
where
|
||||||
transform :: OperationDefinition -> TransformT Core.Operation
|
|
||||||
transform (OperationDefinition Full.Query name _ _ sels) =
|
transform (OperationDefinition Full.Query name _ _ sels) =
|
||||||
Core.Query name <$> appendSelection sels
|
Core.Query name <$> appendSelection sels rootType
|
||||||
transform (OperationDefinition Full.Mutation name _ _ sels) =
|
transform (OperationDefinition Full.Mutation name _ _ sels) =
|
||||||
Core.Mutation name <$> appendSelection sels
|
Core.Mutation name <$> appendSelection sels rootType
|
||||||
|
|
||||||
-- * Selection
|
-- * Selection
|
||||||
|
|
||||||
selection ::
|
selection :: forall m
|
||||||
Full.Selection ->
|
. Full.Selection
|
||||||
TransformT (Either (Seq Core.Selection) Core.Selection)
|
-> Out.ObjectType m
|
||||||
selection (Full.Field alias name arguments' directives' selections) =
|
-> State (Replacement m) (Either (Seq Core.Selection) Core.Selection)
|
||||||
|
selection (Full.Field alias name arguments' directives' selections) objectType =
|
||||||
maybe (Left mempty) (Right . Core.SelectionField) <$> do
|
maybe (Left mempty) (Right . Core.SelectionField) <$> do
|
||||||
fieldArguments <- arguments arguments'
|
fieldArguments <- arguments arguments'
|
||||||
fieldSelections <- appendSelection selections
|
fieldSelections <- appendSelection selections objectType
|
||||||
fieldDirectives <- Directive.selection <$> directives directives'
|
fieldDirectives <- Directive.selection <$> directives directives'
|
||||||
let field' = Core.Field alias name fieldArguments fieldSelections
|
let field' = Core.Field alias name fieldArguments fieldSelections
|
||||||
pure $ field' <$ fieldDirectives
|
pure $ field' <$ fieldDirectives
|
||||||
selection (Full.FragmentSpread name directives') =
|
selection (Full.FragmentSpread name directives') objectType =
|
||||||
maybe (Left mempty) (Right . Core.SelectionFragment) <$> do
|
maybe (Left mempty) (Right . Core.SelectionFragment) <$> do
|
||||||
spreadDirectives <- Directive.selection <$> directives directives'
|
spreadDirectives <- Directive.selection <$> directives directives'
|
||||||
fragments' <- gets fragments
|
fragments' <- gets fragments
|
||||||
@ -229,32 +264,35 @@ selection (Full.FragmentSpread name directives') =
|
|||||||
Just definition -> lift $ pure $ definition <$ spreadDirectives
|
Just definition -> lift $ pure $ definition <$ spreadDirectives
|
||||||
Nothing -> case HashMap.lookup name fragmentDefinitions' of
|
Nothing -> case HashMap.lookup name fragmentDefinitions' of
|
||||||
Just definition -> do
|
Just definition -> do
|
||||||
fragment <- fragmentDefinition definition
|
fragment <- fragmentDefinition definition objectType
|
||||||
lift $ pure $ fragment <$ spreadDirectives
|
lift $ pure $ fragment <$ spreadDirectives
|
||||||
Nothing -> lift $ pure Nothing
|
Nothing -> lift $ pure Nothing
|
||||||
selection (Full.InlineFragment type' directives' selections) = do
|
selection (Full.InlineFragment type' directives' selections) objectType = do
|
||||||
fragmentDirectives <- Directive.selection <$> directives directives'
|
fragmentDirectives <- Directive.selection <$> directives directives'
|
||||||
case fragmentDirectives of
|
case fragmentDirectives of
|
||||||
Nothing -> pure $ Left mempty
|
Nothing -> pure $ Left mempty
|
||||||
_ -> do
|
_ -> do
|
||||||
fragmentSelectionSet <- appendSelection selections
|
fragmentSelectionSet <- appendSelection selections objectType
|
||||||
pure $ maybe Left selectionFragment type' fragmentSelectionSet
|
pure $ maybe Left selectionFragment type' fragmentSelectionSet
|
||||||
where
|
where
|
||||||
selectionFragment typeName = Right
|
selectionFragment typeName = Right
|
||||||
. Core.SelectionFragment
|
. Core.SelectionFragment
|
||||||
. Core.Fragment typeName
|
. Core.Fragment typeName
|
||||||
|
|
||||||
appendSelection ::
|
appendSelection :: Traversable t
|
||||||
Traversable t =>
|
=> forall m
|
||||||
t Full.Selection ->
|
. t Full.Selection
|
||||||
TransformT (Seq Core.Selection)
|
-> Out.ObjectType m
|
||||||
appendSelection = foldM go mempty
|
-> State (Replacement m) (Seq Core.Selection)
|
||||||
|
appendSelection selectionSet objectType = foldM go mempty selectionSet
|
||||||
where
|
where
|
||||||
go acc sel = append acc <$> selection sel
|
go acc sel = append acc <$> selection sel objectType
|
||||||
append acc (Left list) = list >< acc
|
append acc (Left list) = list >< acc
|
||||||
append acc (Right one) = one <| acc
|
append acc (Right one) = one <| acc
|
||||||
|
|
||||||
directives :: [Full.Directive] -> TransformT [Core.Directive]
|
directives :: forall m
|
||||||
|
. [Full.Directive]
|
||||||
|
-> State (Replacement m) [Core.Directive]
|
||||||
directives = traverse directive
|
directives = traverse directive
|
||||||
where
|
where
|
||||||
directive (Full.Directive directiveName directiveArguments) =
|
directive (Full.Directive directiveName directiveArguments) =
|
||||||
@ -263,38 +301,40 @@ directives = traverse directive
|
|||||||
-- * Fragment replacement
|
-- * Fragment replacement
|
||||||
|
|
||||||
-- | Extract fragment definitions into a single 'HashMap'.
|
-- | Extract fragment definitions into a single 'HashMap'.
|
||||||
collectFragments :: TransformT ()
|
collectFragments :: forall m. Out.ObjectType m -> State (Replacement m) ()
|
||||||
collectFragments = do
|
collectFragments objectType = do
|
||||||
fragDefs <- gets fragmentDefinitions
|
fragDefs <- gets fragmentDefinitions
|
||||||
let nextValue = head $ HashMap.elems fragDefs
|
let nextValue = head $ HashMap.elems fragDefs
|
||||||
unless (HashMap.null fragDefs) $ do
|
unless (HashMap.null fragDefs) $ do
|
||||||
_ <- fragmentDefinition nextValue
|
_ <- fragmentDefinition nextValue objectType
|
||||||
collectFragments
|
collectFragments objectType
|
||||||
|
|
||||||
fragmentDefinition ::
|
fragmentDefinition :: forall m
|
||||||
Full.FragmentDefinition ->
|
. Full.FragmentDefinition
|
||||||
TransformT Core.Fragment
|
-> Out.ObjectType m
|
||||||
fragmentDefinition (Full.FragmentDefinition name type' _ selections) = do
|
-> State (Replacement m) Core.Fragment
|
||||||
|
fragmentDefinition (Full.FragmentDefinition name type' _ selections) objectType = do
|
||||||
modify deleteFragmentDefinition
|
modify deleteFragmentDefinition
|
||||||
fragmentSelection <- appendSelection selections
|
fragmentSelection <- appendSelection selections objectType
|
||||||
let newValue = Core.Fragment type' fragmentSelection
|
let newValue = Core.Fragment type' fragmentSelection
|
||||||
modify $ insertFragment newValue
|
modify $ insertFragment newValue
|
||||||
lift $ pure newValue
|
lift $ pure newValue
|
||||||
where
|
where
|
||||||
deleteFragmentDefinition (Replacement fragments' fragmentDefinitions' subs) =
|
deleteFragmentDefinition replacement@Replacement{..} =
|
||||||
Replacement fragments' (HashMap.delete name fragmentDefinitions') subs
|
let newDefinitions = HashMap.delete name fragmentDefinitions
|
||||||
insertFragment newValue (Replacement fragments' fragmentDefinitions' subs) =
|
in replacement{ fragmentDefinitions = newDefinitions }
|
||||||
let newFragments = HashMap.insert name newValue fragments'
|
insertFragment newValue replacement@Replacement{..} =
|
||||||
in Replacement newFragments fragmentDefinitions' subs
|
let newFragments = HashMap.insert name newValue fragments
|
||||||
|
in replacement{ fragments = newFragments }
|
||||||
|
|
||||||
arguments :: [Full.Argument] -> TransformT Core.Arguments
|
arguments :: forall m. [Full.Argument] -> State (Replacement m) Core.Arguments
|
||||||
arguments = fmap Core.Arguments . foldM go HashMap.empty
|
arguments = fmap Core.Arguments . foldM go HashMap.empty
|
||||||
where
|
where
|
||||||
go arguments' (Full.Argument name value') = do
|
go arguments' (Full.Argument name value') = do
|
||||||
substitutedValue <- value value'
|
substitutedValue <- value value'
|
||||||
return $ HashMap.insert name substitutedValue arguments'
|
return $ HashMap.insert name substitutedValue arguments'
|
||||||
|
|
||||||
value :: Full.Value -> TransformT In.Value
|
value :: forall m. Full.Value -> State (Replacement m) In.Value
|
||||||
value (Full.Variable name) =
|
value (Full.Variable name) =
|
||||||
gets $ fromMaybe In.Null . HashMap.lookup name . variableValues
|
gets $ fromMaybe In.Null . HashMap.lookup name . variableValues
|
||||||
value (Full.Int i) = pure $ In.Int i
|
value (Full.Int i) = pure $ In.Int i
|
||||||
@ -303,10 +343,11 @@ value (Full.String x) = pure $ In.String x
|
|||||||
value (Full.Boolean b) = pure $ In.Boolean b
|
value (Full.Boolean b) = pure $ In.Boolean b
|
||||||
value Full.Null = pure In.Null
|
value Full.Null = pure In.Null
|
||||||
value (Full.Enum e) = pure $ In.Enum e
|
value (Full.Enum e) = pure $ In.Enum e
|
||||||
value (Full.List l) =
|
value (Full.List l) = In.List <$> traverse value l
|
||||||
In.List <$> traverse value l
|
|
||||||
value (Full.Object o) =
|
value (Full.Object o) =
|
||||||
In.Object . HashMap.fromList <$> traverse objectField o
|
In.Object . HashMap.fromList <$> traverse objectField o
|
||||||
|
|
||||||
objectField :: Full.ObjectField Full.Value -> TransformT (Core.Name, In.Value)
|
objectField :: forall m
|
||||||
|
. Full.ObjectField Full.Value
|
||||||
|
-> State (Replacement m) (Core.Name, In.Value)
|
||||||
objectField (Full.ObjectField name value') = (name,) <$> value value'
|
objectField (Full.ObjectField name value') = (name,) <$> value value'
|
||||||
|
@ -3,7 +3,9 @@ module Language.GraphQL.Type
|
|||||||
( In.InputField(..)
|
( In.InputField(..)
|
||||||
, In.InputObjectType(..)
|
, In.InputObjectType(..)
|
||||||
, Out.Field(..)
|
, Out.Field(..)
|
||||||
|
, Out.InterfaceType(..)
|
||||||
, Out.ObjectType(..)
|
, Out.ObjectType(..)
|
||||||
|
, Out.UnionType(..)
|
||||||
, module Language.GraphQL.Type.Definition
|
, module Language.GraphQL.Type.Definition
|
||||||
, module Language.GraphQL.Type.Schema
|
, module Language.GraphQL.Type.Schema
|
||||||
) where
|
) where
|
||||||
|
@ -9,14 +9,18 @@
|
|||||||
-- with 'Language.GraphQL.Type.In'.
|
-- with 'Language.GraphQL.Type.In'.
|
||||||
module Language.GraphQL.Type.Out
|
module Language.GraphQL.Type.Out
|
||||||
( Field(..)
|
( Field(..)
|
||||||
|
, InterfaceType(..)
|
||||||
, ObjectType(..)
|
, ObjectType(..)
|
||||||
, Type(..)
|
, Type(..)
|
||||||
|
, UnionType(..)
|
||||||
, Value(..)
|
, Value(..)
|
||||||
, isNonNullType
|
, isNonNullType
|
||||||
, pattern EnumBaseType
|
, pattern EnumBaseType
|
||||||
|
, pattern InterfaceBaseType
|
||||||
, pattern ListBaseType
|
, pattern ListBaseType
|
||||||
, pattern ObjectBaseType
|
, pattern ObjectBaseType
|
||||||
, pattern ScalarBaseType
|
, pattern ScalarBaseType
|
||||||
|
, pattern UnionBaseType
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.HashMap.Strict (HashMap)
|
import Data.HashMap.Strict (HashMap)
|
||||||
@ -34,7 +38,22 @@ import qualified Language.GraphQL.Type.In as In
|
|||||||
--
|
--
|
||||||
-- Almost all of the GraphQL types you define will be object types. Object
|
-- Almost all of the GraphQL types you define will be object types. Object
|
||||||
-- types have a name, but most importantly describe their fields.
|
-- types have a name, but most importantly describe their fields.
|
||||||
data ObjectType m = ObjectType Name (Maybe Text) (HashMap Name (Field m))
|
data ObjectType m = ObjectType
|
||||||
|
Name (Maybe Text) [InterfaceType m] (HashMap Name (Field m))
|
||||||
|
|
||||||
|
-- | Interface Type Definition.
|
||||||
|
--
|
||||||
|
-- When a field can return one of a heterogeneous set of types, a Interface type
|
||||||
|
-- is used to describe what types are possible, and what fields are in common
|
||||||
|
-- across all types.
|
||||||
|
data InterfaceType m = InterfaceType
|
||||||
|
Name (Maybe Text) [InterfaceType m] (HashMap Name (Field m))
|
||||||
|
|
||||||
|
-- | Union Type Definition.
|
||||||
|
--
|
||||||
|
-- When a field can return one of a heterogeneous set of types, a Union type is
|
||||||
|
-- used to describe what types are possible.
|
||||||
|
data UnionType m = UnionType Name (Maybe Text) [ObjectType m]
|
||||||
|
|
||||||
-- | Output object field definition.
|
-- | Output object field definition.
|
||||||
data Field m = Field
|
data Field m = Field
|
||||||
@ -48,10 +67,14 @@ data Type m
|
|||||||
= NamedScalarType ScalarType
|
= NamedScalarType ScalarType
|
||||||
| NamedEnumType EnumType
|
| NamedEnumType EnumType
|
||||||
| NamedObjectType (ObjectType m)
|
| NamedObjectType (ObjectType m)
|
||||||
|
| NamedInterfaceType (InterfaceType m)
|
||||||
|
| NamedUnionType (UnionType m)
|
||||||
| ListType (Type m)
|
| ListType (Type m)
|
||||||
| NonNullScalarType ScalarType
|
| NonNullScalarType ScalarType
|
||||||
| NonNullEnumType EnumType
|
| NonNullEnumType EnumType
|
||||||
| NonNullObjectType (ObjectType m)
|
| NonNullObjectType (ObjectType m)
|
||||||
|
| NonNullInterfaceType (InterfaceType m)
|
||||||
|
| NonNullUnionType (UnionType m)
|
||||||
| NonNullListType (Type m)
|
| NonNullListType (Type m)
|
||||||
|
|
||||||
-- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
|
-- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
|
||||||
@ -108,11 +131,26 @@ pattern EnumBaseType enumType <- (isEnumType -> Just enumType)
|
|||||||
pattern ObjectBaseType :: forall m. ObjectType m -> Type m
|
pattern ObjectBaseType :: forall m. ObjectType m -> Type m
|
||||||
pattern ObjectBaseType objectType <- (isObjectType -> Just objectType)
|
pattern ObjectBaseType objectType <- (isObjectType -> Just objectType)
|
||||||
|
|
||||||
|
-- | Matches either 'NamedInterfaceType' or 'NonNullInterfaceType'.
|
||||||
|
pattern InterfaceBaseType :: forall m. InterfaceType m -> Type m
|
||||||
|
pattern InterfaceBaseType interfaceType <-
|
||||||
|
(isInterfaceType -> Just interfaceType)
|
||||||
|
|
||||||
|
-- | Matches either 'NamedUnionType' or 'NonNullUnionType'.
|
||||||
|
pattern UnionBaseType :: forall m. UnionType m -> Type m
|
||||||
|
pattern UnionBaseType unionType <- (isUnionType -> Just unionType)
|
||||||
|
|
||||||
-- | Matches either 'ListType' or 'NonNullListType'.
|
-- | Matches either 'ListType' or 'NonNullListType'.
|
||||||
pattern ListBaseType :: forall m. Type m -> Type m
|
pattern ListBaseType :: forall m. Type m -> Type m
|
||||||
pattern ListBaseType listType <- (isListType -> Just listType)
|
pattern ListBaseType listType <- (isListType -> Just listType)
|
||||||
|
|
||||||
{-# COMPLETE ScalarBaseType, EnumBaseType, ObjectBaseType, ListBaseType #-}
|
{-# COMPLETE ScalarBaseType
|
||||||
|
, EnumBaseType
|
||||||
|
, ObjectBaseType
|
||||||
|
, ListBaseType
|
||||||
|
, InterfaceBaseType
|
||||||
|
, UnionBaseType
|
||||||
|
#-}
|
||||||
|
|
||||||
isScalarType :: forall m. Type m -> Maybe ScalarType
|
isScalarType :: forall m. Type m -> Maybe ScalarType
|
||||||
isScalarType (NamedScalarType outputType) = Just outputType
|
isScalarType (NamedScalarType outputType) = Just outputType
|
||||||
@ -129,6 +167,16 @@ isEnumType (NamedEnumType outputType) = Just outputType
|
|||||||
isEnumType (NonNullEnumType outputType) = Just outputType
|
isEnumType (NonNullEnumType outputType) = Just outputType
|
||||||
isEnumType _ = Nothing
|
isEnumType _ = Nothing
|
||||||
|
|
||||||
|
isInterfaceType :: forall m. Type m -> Maybe (InterfaceType m)
|
||||||
|
isInterfaceType (NamedInterfaceType interfaceType) = Just interfaceType
|
||||||
|
isInterfaceType (NonNullInterfaceType interfaceType) = Just interfaceType
|
||||||
|
isInterfaceType _ = Nothing
|
||||||
|
|
||||||
|
isUnionType :: forall m. Type m -> Maybe (UnionType m)
|
||||||
|
isUnionType (NamedUnionType unionType) = Just unionType
|
||||||
|
isUnionType (NonNullUnionType unionType) = Just unionType
|
||||||
|
isUnionType _ = Nothing
|
||||||
|
|
||||||
isListType :: forall m. Type m -> Maybe (Type m)
|
isListType :: forall m. Type m -> Maybe (Type m)
|
||||||
isListType (ListType outputType) = Just outputType
|
isListType (ListType outputType) = Just outputType
|
||||||
isListType (NonNullListType outputType) = Just outputType
|
isListType (NonNullListType outputType) = Just outputType
|
||||||
@ -139,5 +187,7 @@ isNonNullType :: forall m. Type m -> Bool
|
|||||||
isNonNullType (NonNullScalarType _) = True
|
isNonNullType (NonNullScalarType _) = True
|
||||||
isNonNullType (NonNullEnumType _) = True
|
isNonNullType (NonNullEnumType _) = True
|
||||||
isNonNullType (NonNullObjectType _) = True
|
isNonNullType (NonNullObjectType _) = True
|
||||||
|
isNonNullType (NonNullInterfaceType _) = True
|
||||||
|
isNonNullType (NonNullUnionType _) = True
|
||||||
isNonNullType (NonNullListType _) = True
|
isNonNullType (NonNullListType _) = True
|
||||||
isNonNullType _ = False
|
isNonNullType _ = False
|
||||||
|
@ -20,6 +20,8 @@ data Type m
|
|||||||
| EnumType Definition.EnumType
|
| EnumType Definition.EnumType
|
||||||
| ObjectType (Out.ObjectType m)
|
| ObjectType (Out.ObjectType m)
|
||||||
| InputObjectType In.InputObjectType
|
| InputObjectType In.InputObjectType
|
||||||
|
| InterfaceType (Out.InterfaceType m)
|
||||||
|
| UnionType (Out.UnionType m)
|
||||||
|
|
||||||
-- | A Schema is created by supplying the root types of each type of operation,
|
-- | A Schema is created by supplying the root types of each type of operation,
|
||||||
-- query and mutation (optional). A schema definition is then supplied to the
|
-- query and mutation (optional). A schema definition is then supplied to the
|
||||||
@ -39,10 +41,9 @@ collectReferencedTypes schema =
|
|||||||
let queryTypes = traverseObjectType (query schema) HashMap.empty
|
let queryTypes = traverseObjectType (query schema) HashMap.empty
|
||||||
in maybe queryTypes (`traverseObjectType` queryTypes) $ mutation schema
|
in maybe queryTypes (`traverseObjectType` queryTypes) $ mutation schema
|
||||||
where
|
where
|
||||||
collect traverser typeName element foundTypes =
|
collect traverser typeName element foundTypes
|
||||||
let newMap = HashMap.insert typeName element foundTypes
|
| HashMap.member typeName foundTypes = foundTypes
|
||||||
in maybe (traverser newMap) (const foundTypes)
|
| otherwise = traverser $ HashMap.insert typeName element foundTypes
|
||||||
$ HashMap.lookup typeName foundTypes
|
|
||||||
visitFields (Out.Field _ outputType arguments _) foundTypes
|
visitFields (Out.Field _ outputType arguments _) foundTypes
|
||||||
= traverseOutputType outputType
|
= traverseOutputType outputType
|
||||||
$ foldr visitArguments foundTypes arguments
|
$ foldr visitArguments foundTypes arguments
|
||||||
@ -63,6 +64,12 @@ collectReferencedTypes schema =
|
|||||||
in collect Prelude.id typeName (EnumType enumType)
|
in collect Prelude.id typeName (EnumType enumType)
|
||||||
traverseOutputType (Out.ObjectBaseType objectType) =
|
traverseOutputType (Out.ObjectBaseType objectType) =
|
||||||
traverseObjectType objectType
|
traverseObjectType objectType
|
||||||
|
traverseOutputType (Out.InterfaceBaseType interfaceType) =
|
||||||
|
traverseInterfaceType interfaceType
|
||||||
|
traverseOutputType (Out.UnionBaseType unionType) =
|
||||||
|
let (Out.UnionType typeName _ types) = unionType
|
||||||
|
traverser = flip (foldr traverseObjectType) types
|
||||||
|
in collect traverser typeName (UnionType unionType)
|
||||||
traverseOutputType (Out.ListBaseType listType) =
|
traverseOutputType (Out.ListBaseType listType) =
|
||||||
traverseOutputType listType
|
traverseOutputType listType
|
||||||
traverseOutputType (Out.ScalarBaseType scalarType) =
|
traverseOutputType (Out.ScalarBaseType scalarType) =
|
||||||
@ -72,7 +79,15 @@ collectReferencedTypes schema =
|
|||||||
let (Definition.EnumType typeName _ _) = enumType
|
let (Definition.EnumType typeName _ _) = enumType
|
||||||
in collect Prelude.id typeName (EnumType enumType)
|
in collect Prelude.id typeName (EnumType enumType)
|
||||||
traverseObjectType objectType foundTypes =
|
traverseObjectType objectType foundTypes =
|
||||||
let (Out.ObjectType typeName _ objectFields) = objectType
|
let (Out.ObjectType typeName _ interfaces fields) = objectType
|
||||||
element = ObjectType objectType
|
element = ObjectType objectType
|
||||||
traverser = flip (foldr visitFields) objectFields
|
traverser = polymorphicTypeTraverser interfaces fields
|
||||||
in collect traverser typeName element foundTypes
|
in collect traverser typeName element foundTypes
|
||||||
|
traverseInterfaceType interfaceType foundTypes =
|
||||||
|
let (Out.InterfaceType typeName _ interfaces fields) = interfaceType
|
||||||
|
element = InterfaceType interfaceType
|
||||||
|
traverser = polymorphicTypeTraverser interfaces fields
|
||||||
|
in collect traverser typeName element foundTypes
|
||||||
|
polymorphicTypeTraverser interfaces fields
|
||||||
|
= flip (foldr visitFields) fields
|
||||||
|
. flip (foldr traverseInterfaceType) interfaces
|
||||||
|
@ -17,7 +17,7 @@ experimentalResolver :: Schema IO
|
|||||||
experimentalResolver = Schema { query = queryType, mutation = Nothing }
|
experimentalResolver = Schema { query = queryType, mutation = Nothing }
|
||||||
where
|
where
|
||||||
resolver = pure $ Out.Int 5
|
resolver = pure $ Out.Int 5
|
||||||
queryType = Out.ObjectType "Query" Nothing
|
queryType = Out.ObjectType "Query" Nothing []
|
||||||
$ HashMap.singleton "experimentalField"
|
$ HashMap.singleton "experimentalField"
|
||||||
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolver
|
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolver
|
||||||
|
|
||||||
|
@ -51,14 +51,14 @@ hasErrors (Object object') = HashMap.member "errors" object'
|
|||||||
hasErrors _ = True
|
hasErrors _ = True
|
||||||
|
|
||||||
shirtType :: Out.ObjectType IO
|
shirtType :: Out.ObjectType IO
|
||||||
shirtType = Out.ObjectType "Shirt" Nothing
|
shirtType = Out.ObjectType "Shirt" Nothing []
|
||||||
$ HashMap.singleton resolverName
|
$ HashMap.singleton resolverName
|
||||||
$ Out.Field Nothing (Out.NamedScalarType string) mempty resolve
|
$ Out.Field Nothing (Out.NamedScalarType string) mempty resolve
|
||||||
where
|
where
|
||||||
(Schema.Resolver resolverName resolve) = size
|
(Schema.Resolver resolverName resolve) = size
|
||||||
|
|
||||||
hatType :: Out.ObjectType IO
|
hatType :: Out.ObjectType IO
|
||||||
hatType = Out.ObjectType "Hat" Nothing
|
hatType = Out.ObjectType "Hat" Nothing []
|
||||||
$ HashMap.singleton resolverName
|
$ HashMap.singleton resolverName
|
||||||
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
|
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
|
||||||
where
|
where
|
||||||
@ -69,7 +69,7 @@ toSchema (Schema.Resolver resolverName resolve) = Schema
|
|||||||
{ query = queryType, mutation = Nothing }
|
{ query = queryType, mutation = Nothing }
|
||||||
where
|
where
|
||||||
unionMember = if resolverName == "Hat" then hatType else shirtType
|
unionMember = if resolverName == "Hat" then hatType else shirtType
|
||||||
queryType = Out.ObjectType "Query" Nothing
|
queryType = Out.ObjectType "Query" Nothing []
|
||||||
$ HashMap.singleton resolverName
|
$ HashMap.singleton resolverName
|
||||||
$ Out.Field Nothing (Out.NamedObjectType unionMember) mempty resolve
|
$ Out.Field Nothing (Out.NamedObjectType unionMember) mempty resolve
|
||||||
|
|
||||||
|
@ -15,7 +15,7 @@ import qualified Language.GraphQL.Type.Out as Out
|
|||||||
import Language.GraphQL.Type.Schema
|
import Language.GraphQL.Type.Schema
|
||||||
|
|
||||||
hatType :: Out.ObjectType IO
|
hatType :: Out.ObjectType IO
|
||||||
hatType = Out.ObjectType "Hat" Nothing
|
hatType = Out.ObjectType "Hat" Nothing []
|
||||||
$ HashMap.singleton resolverName
|
$ HashMap.singleton resolverName
|
||||||
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
|
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
|
||||||
where
|
where
|
||||||
@ -24,8 +24,8 @@ hatType = Out.ObjectType "Hat" Nothing
|
|||||||
|
|
||||||
schema :: Schema IO
|
schema :: Schema IO
|
||||||
schema = Schema
|
schema = Schema
|
||||||
(Out.ObjectType "Query" Nothing hatField)
|
(Out.ObjectType "Query" Nothing [] hatField)
|
||||||
(Just $ Out.ObjectType "Mutation" Nothing incrementField)
|
(Just $ Out.ObjectType "Mutation" Nothing [] incrementField)
|
||||||
where
|
where
|
||||||
garment = pure $ Schema.object
|
garment = pure $ Schema.object
|
||||||
[ Schema.Resolver "circumference" $ pure $ Out.Int 60
|
[ Schema.Resolver "circumference" $ pure $ Out.Int 60
|
||||||
|
@ -25,7 +25,7 @@ import Test.StarWars.Data
|
|||||||
schema :: Schema Identity
|
schema :: Schema Identity
|
||||||
schema = Schema { query = queryType, mutation = Nothing }
|
schema = Schema { query = queryType, mutation = Nothing }
|
||||||
where
|
where
|
||||||
queryType = Out.ObjectType "Query" Nothing $ HashMap.fromList
|
queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
|
||||||
[ ("hero", Out.Field Nothing (Out.NamedScalarType string) mempty hero)
|
[ ("hero", Out.Field Nothing (Out.NamedScalarType string) mempty hero)
|
||||||
, ("human", Out.Field Nothing (Out.NamedScalarType string) mempty human)
|
, ("human", Out.Field Nothing (Out.NamedScalarType string) mempty human)
|
||||||
, ("droid", Out.Field Nothing (Out.NamedScalarType string) mempty droid)
|
, ("droid", Out.Field Nothing (Out.NamedScalarType string) mempty droid)
|
||||||
|
Loading…
Reference in New Issue
Block a user