Compare commits
6 Commits
Author | SHA1 | Date |
---|---|---|
Eugen Wissner | 16cbe3fc28 | |
Eugen Wissner | f20cd02048 | |
Eugen Wissner | 116aa1f6bb | |
Eugen Wissner | df078a59d0 | |
Eugen Wissner | 930b8f10b7 | |
Eugen Wissner | 0047a13bc0 |
|
@ -6,6 +6,13 @@ The format is based on
|
||||||
and this project adheres to
|
and this project adheres to
|
||||||
[Haskell Package Versioning Policy](https://pvp.haskell.org/).
|
[Haskell Package Versioning Policy](https://pvp.haskell.org/).
|
||||||
|
|
||||||
|
## [1.0.2.0] - 2021-12-26
|
||||||
|
### Added
|
||||||
|
- `Serialize` instance for `Type.Definition.Value`.
|
||||||
|
- `VariableValue` instance for `Type.Definition.Value`.
|
||||||
|
- `Json` build flag, enabled by default. JSON and Aeson support can be disabled
|
||||||
|
by disabling this flag.
|
||||||
|
|
||||||
## [1.0.1.0] - 2021-09-27
|
## [1.0.1.0] - 2021-09-27
|
||||||
### Added
|
### Added
|
||||||
- Custom `Show` instance for `Type.Definition.Value` (for error
|
- Custom `Show` instance for `Type.Definition.Value` (for error
|
||||||
|
@ -459,6 +466,7 @@ and this project adheres to
|
||||||
### Added
|
### Added
|
||||||
- Data types for the GraphQL language.
|
- Data types for the GraphQL language.
|
||||||
|
|
||||||
|
[1.0.2.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=1.0.2.0&rev_to=v1.0.1.0
|
||||||
[1.0.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.1.0&rev_to=v1.0.0.0
|
[1.0.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.1.0&rev_to=v1.0.0.0
|
||||||
[1.0.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.0.0&rev_to=v0.11.1.0
|
[1.0.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.0.0&rev_to=v0.11.1.0
|
||||||
[0.11.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.11.1.0&rev_to=v0.11.0.0
|
[0.11.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.11.1.0&rev_to=v0.11.0.0
|
||||||
|
|
147
graphql.cabal
147
graphql.cabal
|
@ -1,7 +1,7 @@
|
||||||
cabal-version: 2.2
|
cabal-version: 2.4
|
||||||
|
|
||||||
name: graphql
|
name: graphql
|
||||||
version: 1.0.1.0
|
version: 1.0.2.0
|
||||||
synopsis: Haskell GraphQL implementation
|
synopsis: Haskell GraphQL implementation
|
||||||
description: Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation.
|
description: Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation.
|
||||||
category: Language
|
category: Language
|
||||||
|
@ -18,93 +18,100 @@ license-files: LICENSE,
|
||||||
LICENSE.MPL
|
LICENSE.MPL
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
CHANGELOG.md
|
CHANGELOG.md
|
||||||
README.md
|
README.md
|
||||||
tested-with:
|
tested-with:
|
||||||
GHC == 8.10.7
|
GHC == 8.10.7,
|
||||||
, GHC == 9.0.1
|
GHC == 9.0.1,
|
||||||
|
GHC == 9.2.1
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
location: git://caraus.tech/pub/graphql.git
|
location: git://caraus.tech/pub/graphql.git
|
||||||
|
|
||||||
|
flag Json
|
||||||
|
description: Whether to build against @aeson 1.x@
|
||||||
|
default: True
|
||||||
|
manual: True
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Language.GraphQL
|
Language.GraphQL
|
||||||
Language.GraphQL.AST
|
Language.GraphQL.AST
|
||||||
Language.GraphQL.AST.DirectiveLocation
|
Language.GraphQL.AST.DirectiveLocation
|
||||||
Language.GraphQL.AST.Document
|
Language.GraphQL.AST.Document
|
||||||
Language.GraphQL.AST.Encoder
|
Language.GraphQL.AST.Encoder
|
||||||
Language.GraphQL.AST.Lexer
|
Language.GraphQL.AST.Lexer
|
||||||
Language.GraphQL.AST.Parser
|
Language.GraphQL.AST.Parser
|
||||||
Language.GraphQL.Error
|
Language.GraphQL.Error
|
||||||
Language.GraphQL.Execute
|
Language.GraphQL.Execute
|
||||||
Language.GraphQL.Execute.Coerce
|
Language.GraphQL.Execute.Coerce
|
||||||
Language.GraphQL.Execute.OrderedMap
|
Language.GraphQL.Execute.OrderedMap
|
||||||
Language.GraphQL.TH
|
Language.GraphQL.TH
|
||||||
Language.GraphQL.Type
|
Language.GraphQL.Type
|
||||||
Language.GraphQL.Type.In
|
Language.GraphQL.Type.In
|
||||||
Language.GraphQL.Type.Out
|
Language.GraphQL.Type.Out
|
||||||
Language.GraphQL.Type.Schema
|
Language.GraphQL.Type.Schema
|
||||||
Language.GraphQL.Validate
|
Language.GraphQL.Validate
|
||||||
Language.GraphQL.Validate.Validation
|
Language.GraphQL.Validate.Validation
|
||||||
Test.Hspec.GraphQL
|
Test.Hspec.GraphQL
|
||||||
other-modules:
|
other-modules:
|
||||||
Language.GraphQL.Execute.Transform
|
Language.GraphQL.Execute.Transform
|
||||||
Language.GraphQL.Type.Definition
|
Language.GraphQL.Type.Definition
|
||||||
Language.GraphQL.Type.Internal
|
Language.GraphQL.Type.Internal
|
||||||
Language.GraphQL.Validate.Rules
|
Language.GraphQL.Validate.Rules
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
src
|
src
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson >= 1.5.6 && < 1.6
|
base >= 4.7 && < 5,
|
||||||
, base >= 4.7 && < 5
|
conduit ^>= 1.3.4,
|
||||||
, conduit >= 1.3.4 && < 1.4
|
containers ^>= 0.6.2,
|
||||||
, containers >= 0.6.2 && < 0.7
|
exceptions ^>= 0.10.4,
|
||||||
, exceptions >= 0.10.4 && < 0.11
|
megaparsec >= 9.0 && < 10,
|
||||||
, hspec-expectations >= 0.8.2 && < 0.9
|
parser-combinators >= 1.3 && < 2,
|
||||||
, megaparsec >= 9.0.1 && < 9.1
|
template-haskell >= 2.16 && < 3,
|
||||||
, parser-combinators >= 1.3.0 && < 1.4
|
text ^>= 1.2.4,
|
||||||
, scientific >= 0.3.7 && < 0.4
|
transformers ^>= 0.5.6,
|
||||||
, template-haskell >= 2.16 && < 2.18
|
unordered-containers ^>= 0.2.14,
|
||||||
, text >= 1.2.4 && < 1.3
|
vector ^>= 0.12.3
|
||||||
, transformers >= 0.5.6 && < 0.6
|
if flag(Json)
|
||||||
, unordered-containers >= 0.2.14 && < 0.3
|
build-depends:
|
||||||
, vector >= 0.12.3 && < 0.13
|
aeson >= 1.5.6 && < 1.6,
|
||||||
|
hspec-expectations >= 0.8.2 && < 0.9,
|
||||||
|
scientific >= 0.3.7 && < 0.4
|
||||||
|
cpp-options: -DWITH_JSON
|
||||||
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
test-suite graphql-test
|
test-suite graphql-test
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: Spec.hs
|
main-is: Spec.hs
|
||||||
other-modules:
|
other-modules:
|
||||||
Language.GraphQL.AST.DocumentSpec
|
Language.GraphQL.AST.DocumentSpec
|
||||||
Language.GraphQL.AST.EncoderSpec
|
Language.GraphQL.AST.EncoderSpec
|
||||||
Language.GraphQL.AST.LexerSpec
|
Language.GraphQL.AST.LexerSpec
|
||||||
Language.GraphQL.AST.ParserSpec
|
Language.GraphQL.AST.ParserSpec
|
||||||
Language.GraphQL.ErrorSpec
|
Language.GraphQL.ErrorSpec
|
||||||
Language.GraphQL.Execute.CoerceSpec
|
Language.GraphQL.Execute.CoerceSpec
|
||||||
Language.GraphQL.Execute.OrderedMapSpec
|
Language.GraphQL.Execute.OrderedMapSpec
|
||||||
Language.GraphQL.ExecuteSpec
|
Language.GraphQL.ExecuteSpec
|
||||||
Language.GraphQL.Type.OutSpec
|
Language.GraphQL.Type.OutSpec
|
||||||
Language.GraphQL.Validate.RulesSpec
|
Language.GraphQL.Validate.RulesSpec
|
||||||
Test.DirectiveSpec
|
|
||||||
Test.FragmentSpec
|
|
||||||
Test.RootOperationSpec
|
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
tests
|
tests
|
||||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
|
||||||
|
|
||||||
build-depends:
|
build-depends:
|
||||||
QuickCheck >= 2.14.1 && < 2.15
|
QuickCheck ^>= 2.14.1,
|
||||||
, aeson
|
base,
|
||||||
, base >= 4.8 && < 5
|
conduit,
|
||||||
, conduit
|
exceptions,
|
||||||
, exceptions
|
graphql,
|
||||||
, graphql
|
hspec ^>= 2.9.1,
|
||||||
, hspec >= 2.8.2 && < 2.9
|
hspec-megaparsec ^>= 2.2.0,
|
||||||
, hspec-megaparsec >= 2.2.0 && < 2.3
|
megaparsec,
|
||||||
, megaparsec
|
text,
|
||||||
, scientific
|
unordered-containers
|
||||||
, text
|
|
||||||
, unordered-containers
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -1,3 +1,6 @@
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
|
#ifdef WITH_JSON
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
|
||||||
|
@ -73,3 +76,9 @@ graphqlSubs schema operationName variableValues document' =
|
||||||
[ ("line", Aeson.toJSON line)
|
[ ("line", Aeson.toJSON line)
|
||||||
, ("column", Aeson.toJSON column)
|
, ("column", Aeson.toJSON column)
|
||||||
]
|
]
|
||||||
|
#else
|
||||||
|
-- | This module provides the functions to parse and execute @GraphQL@ queries.
|
||||||
|
module Language.GraphQL
|
||||||
|
(
|
||||||
|
) where
|
||||||
|
#endif
|
||||||
|
|
|
@ -5,6 +5,7 @@
|
||||||
{-# LANGUAGE ExplicitForAll #-}
|
{-# LANGUAGE ExplicitForAll #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
-- | Types and functions used for input and result coercion.
|
-- | Types and functions used for input and result coercion.
|
||||||
module Language.GraphQL.Execute.Coerce
|
module Language.GraphQL.Execute.Coerce
|
||||||
|
@ -15,7 +16,10 @@ module Language.GraphQL.Execute.Coerce
|
||||||
, matchFieldValues
|
, matchFieldValues
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
#ifdef WITH_JSON
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as Aeson
|
||||||
|
import Data.Scientific (toBoundedInteger, toRealFloat)
|
||||||
|
#endif
|
||||||
import Data.Int (Int32)
|
import Data.Int (Int32)
|
||||||
import Data.HashMap.Strict (HashMap)
|
import Data.HashMap.Strict (HashMap)
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
import qualified Data.HashMap.Strict as HashMap
|
||||||
|
@ -24,7 +28,6 @@ import Data.Text (Text)
|
||||||
import qualified Data.Text.Lazy as Text.Lazy
|
import qualified Data.Text.Lazy as Text.Lazy
|
||||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||||
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
|
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
|
||||||
import Data.Scientific (toBoundedInteger, toRealFloat)
|
|
||||||
import Language.GraphQL.AST (Name)
|
import Language.GraphQL.AST (Name)
|
||||||
import Language.GraphQL.Execute.OrderedMap (OrderedMap)
|
import Language.GraphQL.Execute.OrderedMap (OrderedMap)
|
||||||
import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
|
import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
|
||||||
|
@ -61,20 +64,13 @@ class VariableValue a where
|
||||||
-> a -- ^ Variable value being coerced.
|
-> a -- ^ Variable value being coerced.
|
||||||
-> Maybe Type.Value -- ^ Coerced value on success, 'Nothing' otherwise.
|
-> Maybe Type.Value -- ^ Coerced value on success, 'Nothing' otherwise.
|
||||||
|
|
||||||
instance VariableValue Aeson.Value where
|
instance VariableValue Type.Value where
|
||||||
coerceVariableValue _ Aeson.Null = Just Type.Null
|
coerceVariableValue _ Type.Null = Just Type.Null
|
||||||
coerceVariableValue (In.ScalarBaseType scalarType) value
|
coerceVariableValue (In.ScalarBaseType _) value = Just value
|
||||||
| (Aeson.String stringValue) <- value = Just $ Type.String stringValue
|
coerceVariableValue (In.EnumBaseType _) (Type.Enum stringValue) =
|
||||||
| (Aeson.Bool booleanValue) <- value = Just $ Type.Boolean booleanValue
|
|
||||||
| (Aeson.Number numberValue) <- value
|
|
||||||
, (Type.ScalarType "Float" _) <- scalarType =
|
|
||||||
Just $ Type.Float $ toRealFloat numberValue
|
|
||||||
| (Aeson.Number numberValue) <- value = -- ID or Int
|
|
||||||
Type.Int <$> toBoundedInteger numberValue
|
|
||||||
coerceVariableValue (In.EnumBaseType _) (Aeson.String stringValue) =
|
|
||||||
Just $ Type.Enum stringValue
|
Just $ Type.Enum stringValue
|
||||||
coerceVariableValue (In.InputObjectBaseType objectType) value
|
coerceVariableValue (In.InputObjectBaseType objectType) value
|
||||||
| (Aeson.Object objectValue) <- value = do
|
| (Type.Object objectValue) <- value = do
|
||||||
let (In.InputObjectType _ _ inputFields) = objectType
|
let (In.InputObjectType _ _ inputFields) = objectType
|
||||||
(newObjectValue, resultMap) <- foldWithKey objectValue inputFields
|
(newObjectValue, resultMap) <- foldWithKey objectValue inputFields
|
||||||
if HashMap.null newObjectValue
|
if HashMap.null newObjectValue
|
||||||
|
@ -94,14 +90,9 @@ instance VariableValue Aeson.Value where
|
||||||
pure (newObjectValue, insert coerced)
|
pure (newObjectValue, insert coerced)
|
||||||
Nothing -> Just (objectValue, resultMap)
|
Nothing -> Just (objectValue, resultMap)
|
||||||
coerceVariableValue (In.ListBaseType listType) value
|
coerceVariableValue (In.ListBaseType listType) value
|
||||||
| (Aeson.Array arrayValue) <- value =
|
| (Type.List arrayValue) <- value =
|
||||||
Type.List <$> foldr foldVector (Just []) arrayValue
|
Type.List <$> traverse (coerceVariableValue listType) arrayValue
|
||||||
| otherwise = coerceVariableValue listType value
|
| otherwise = coerceVariableValue listType value
|
||||||
where
|
|
||||||
foldVector _ Nothing = Nothing
|
|
||||||
foldVector variableValue (Just list) = do
|
|
||||||
coerced <- coerceVariableValue listType variableValue
|
|
||||||
pure $ coerced : list
|
|
||||||
coerceVariableValue _ _ = Nothing
|
coerceVariableValue _ _ = Nothing
|
||||||
|
|
||||||
-- | Looks up a value by name in the given map, coerces it and inserts into the
|
-- | Looks up a value by name in the given map, coerces it and inserts into the
|
||||||
|
@ -216,6 +207,28 @@ data Output a
|
||||||
instance forall a. IsString (Output a) where
|
instance forall a. IsString (Output a) where
|
||||||
fromString = String . fromString
|
fromString = String . fromString
|
||||||
|
|
||||||
|
instance Serialize Type.Value where
|
||||||
|
null = Type.Null
|
||||||
|
serialize (Out.ScalarBaseType scalarType) value
|
||||||
|
| Type.ScalarType "Int" _ <- scalarType
|
||||||
|
, Int int <- value = Just $ Type.Int int
|
||||||
|
| Type.ScalarType "Float" _ <- scalarType
|
||||||
|
, Float float <- value = Just $ Type.Float float
|
||||||
|
| Type.ScalarType "String" _ <- scalarType
|
||||||
|
, String string <- value = Just $ Type.String string
|
||||||
|
| Type.ScalarType "ID" _ <- scalarType
|
||||||
|
, String string <- value = Just $ Type.String string
|
||||||
|
| Type.ScalarType "Boolean" _ <- scalarType
|
||||||
|
, Boolean boolean <- value = Just $ Type.Boolean boolean
|
||||||
|
serialize _ (Enum enum) = Just $ Type.Enum enum
|
||||||
|
serialize _ (List list) = Just $ Type.List list
|
||||||
|
serialize _ (Object object) = Just
|
||||||
|
$ Type.Object
|
||||||
|
$ HashMap.fromList
|
||||||
|
$ OrderedMap.toList object
|
||||||
|
serialize _ _ = Nothing
|
||||||
|
|
||||||
|
#ifdef WITH_JSON
|
||||||
instance Serialize Aeson.Value where
|
instance Serialize Aeson.Value where
|
||||||
serialize (Out.ScalarBaseType scalarType) value
|
serialize (Out.ScalarBaseType scalarType) value
|
||||||
| Type.ScalarType "Int" _ <- scalarType
|
| Type.ScalarType "Int" _ <- scalarType
|
||||||
|
@ -236,3 +249,47 @@ instance Serialize Aeson.Value where
|
||||||
$ Aeson.toJSON <$> object
|
$ Aeson.toJSON <$> object
|
||||||
serialize _ _ = Nothing
|
serialize _ _ = Nothing
|
||||||
null = Aeson.Null
|
null = Aeson.Null
|
||||||
|
|
||||||
|
instance VariableValue Aeson.Value where
|
||||||
|
coerceVariableValue _ Aeson.Null = Just Type.Null
|
||||||
|
coerceVariableValue (In.ScalarBaseType scalarType) value
|
||||||
|
| (Aeson.String stringValue) <- value = Just $ Type.String stringValue
|
||||||
|
| (Aeson.Bool booleanValue) <- value = Just $ Type.Boolean booleanValue
|
||||||
|
| (Aeson.Number numberValue) <- value
|
||||||
|
, (Type.ScalarType "Float" _) <- scalarType =
|
||||||
|
Just $ Type.Float $ toRealFloat numberValue
|
||||||
|
| (Aeson.Number numberValue) <- value = -- ID or Int
|
||||||
|
Type.Int <$> toBoundedInteger numberValue
|
||||||
|
coerceVariableValue (In.EnumBaseType _) (Aeson.String stringValue) =
|
||||||
|
Just $ Type.Enum stringValue
|
||||||
|
coerceVariableValue (In.InputObjectBaseType objectType) value
|
||||||
|
| (Aeson.Object objectValue) <- value = do
|
||||||
|
let (In.InputObjectType _ _ inputFields) = objectType
|
||||||
|
(newObjectValue, resultMap) <- foldWithKey objectValue inputFields
|
||||||
|
if HashMap.null newObjectValue
|
||||||
|
then Just $ Type.Object resultMap
|
||||||
|
else Nothing
|
||||||
|
where
|
||||||
|
foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues'
|
||||||
|
$ Just (objectValue, HashMap.empty)
|
||||||
|
matchFieldValues' _ _ Nothing = Nothing
|
||||||
|
matchFieldValues' fieldName inputField (Just (objectValue, resultMap)) =
|
||||||
|
let (In.InputField _ fieldType _) = inputField
|
||||||
|
insert = flip (HashMap.insert fieldName) resultMap
|
||||||
|
newObjectValue = HashMap.delete fieldName objectValue
|
||||||
|
in case HashMap.lookup fieldName objectValue of
|
||||||
|
Just variableValue -> do
|
||||||
|
coerced <- coerceVariableValue fieldType variableValue
|
||||||
|
pure (newObjectValue, insert coerced)
|
||||||
|
Nothing -> Just (objectValue, resultMap)
|
||||||
|
coerceVariableValue (In.ListBaseType listType) value
|
||||||
|
| (Aeson.Array arrayValue) <- value =
|
||||||
|
Type.List <$> foldr foldVector (Just []) arrayValue
|
||||||
|
| otherwise = coerceVariableValue listType value
|
||||||
|
where
|
||||||
|
foldVector _ Nothing = Nothing
|
||||||
|
foldVector variableValue (Just list) = do
|
||||||
|
coerced <- coerceVariableValue listType variableValue
|
||||||
|
pure $ coerced : list
|
||||||
|
coerceVariableValue _ _ = Nothing
|
||||||
|
#endif
|
||||||
|
|
|
@ -205,5 +205,5 @@ collectImplementations = HashMap.foldr go HashMap.empty
|
||||||
let Out.ObjectType _ _ interfaces _ = objectType
|
let Out.ObjectType _ _ interfaces _ = objectType
|
||||||
in foldr (add implementation) accumulator interfaces
|
in foldr (add implementation) accumulator interfaces
|
||||||
go _ accumulator = accumulator
|
go _ accumulator = accumulator
|
||||||
add implementation (Out.InterfaceType typeName _ _ _) accumulator =
|
add implementation (Out.InterfaceType typeName _ _ _) =
|
||||||
HashMap.insertWith (++) typeName [implementation] accumulator
|
HashMap.insertWith (++) typeName [implementation]
|
||||||
|
|
|
@ -152,7 +152,7 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
|
||||||
where
|
where
|
||||||
errorMessage =
|
errorMessage =
|
||||||
"Anonymous Subscription must select only one top level field."
|
"Anonymous Subscription must select only one top level field."
|
||||||
collectFields selectionSet = foldM forEach HashSet.empty selectionSet
|
collectFields = foldM forEach HashSet.empty
|
||||||
forEach accumulator = \case
|
forEach accumulator = \case
|
||||||
Full.FieldSelection fieldSelection -> forField accumulator fieldSelection
|
Full.FieldSelection fieldSelection -> forField accumulator fieldSelection
|
||||||
Full.FragmentSpreadSelection fragmentSelection ->
|
Full.FragmentSpreadSelection fragmentSelection ->
|
||||||
|
@ -472,7 +472,7 @@ noFragmentCyclesRule = FragmentDefinitionRule $ \case
|
||||||
collectCycles :: Traversable t
|
collectCycles :: Traversable t
|
||||||
=> t Full.Selection
|
=> t Full.Selection
|
||||||
-> StateT (Int, Full.Name) (ReaderT (Validation m) Seq) (HashMap Full.Name Int)
|
-> StateT (Int, Full.Name) (ReaderT (Validation m) Seq) (HashMap Full.Name Int)
|
||||||
collectCycles selectionSet = foldM forEach HashMap.empty selectionSet
|
collectCycles = foldM forEach HashMap.empty
|
||||||
forEach accumulator = \case
|
forEach accumulator = \case
|
||||||
Full.FieldSelection fieldSelection -> forField accumulator fieldSelection
|
Full.FieldSelection fieldSelection -> forField accumulator fieldSelection
|
||||||
Full.InlineFragmentSelection fragmentSelection ->
|
Full.InlineFragmentSelection fragmentSelection ->
|
||||||
|
@ -702,8 +702,7 @@ uniqueInputFieldNamesRule =
|
||||||
where
|
where
|
||||||
go (Full.Node (Full.Object fields) _) = filterFieldDuplicates fields
|
go (Full.Node (Full.Object fields) _) = filterFieldDuplicates fields
|
||||||
go _ = mempty
|
go _ = mempty
|
||||||
filterFieldDuplicates fields =
|
filterFieldDuplicates = filterDuplicates getFieldName "input field"
|
||||||
filterDuplicates getFieldName "input field" fields
|
|
||||||
getFieldName (Full.ObjectField fieldName _ location') = (fieldName, location')
|
getFieldName (Full.ObjectField fieldName _ location') = (fieldName, location')
|
||||||
constGo (Full.Node (Full.ConstObject fields) _) = filterFieldDuplicates fields
|
constGo (Full.Node (Full.ConstObject fields) _) = filterFieldDuplicates fields
|
||||||
constGo _ = mempty
|
constGo _ = mempty
|
||||||
|
@ -1331,8 +1330,8 @@ variablesInAllowedPositionRule = OperationDefinitionRule $ \case
|
||||||
-> Type.CompositeType m
|
-> Type.CompositeType m
|
||||||
-> t Full.Selection
|
-> t Full.Selection
|
||||||
-> ValidationState m (Seq Error)
|
-> ValidationState m (Seq Error)
|
||||||
visitSelectionSet variables selectionType selections =
|
visitSelectionSet variables selectionType =
|
||||||
foldM (evaluateSelection variables selectionType) mempty selections
|
foldM (evaluateSelection variables selectionType) mempty
|
||||||
evaluateFieldSelection variables selections accumulator = \case
|
evaluateFieldSelection variables selections accumulator = \case
|
||||||
Just newParentType -> do
|
Just newParentType -> do
|
||||||
let folder = evaluateSelection variables newParentType
|
let folder = evaluateSelection variables newParentType
|
||||||
|
@ -1617,4 +1616,3 @@ valuesOfCorrectTypeRule = ValueRule go constGo
|
||||||
}
|
}
|
||||||
| otherwise -> mempty
|
| otherwise -> mempty
|
||||||
_ -> checkResult
|
_ -> checkResult
|
||||||
|
|
||||||
|
|
|
@ -2,6 +2,9 @@
|
||||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||||
|
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
|
#ifdef WITH_JSON
|
||||||
{-# LANGUAGE ExplicitForAll #-}
|
{-# LANGUAGE ExplicitForAll #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
@ -39,3 +42,8 @@ shouldResolve executor query = do
|
||||||
response `shouldNotSatisfy` HashMap.member "errors"
|
response `shouldNotSatisfy` HashMap.member "errors"
|
||||||
_ -> expectationFailure
|
_ -> expectationFailure
|
||||||
"the query is expected to resolve to a value, but it resolved to an event stream"
|
"the query is expected to resolve to a value, but it resolved to an event stream"
|
||||||
|
#else
|
||||||
|
module Test.Hspec.GraphQL
|
||||||
|
(
|
||||||
|
) where
|
||||||
|
#endif
|
||||||
|
|
|
@ -7,9 +7,9 @@ module Language.GraphQL.ErrorSpec
|
||||||
( spec
|
( spec
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as Aeson
|
|
||||||
import Data.List.NonEmpty (NonEmpty (..))
|
import Data.List.NonEmpty (NonEmpty (..))
|
||||||
import Language.GraphQL.Error
|
import Language.GraphQL.Error
|
||||||
|
import qualified Language.GraphQL.Type as Type
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
( Spec
|
( Spec
|
||||||
, describe
|
, describe
|
||||||
|
@ -31,6 +31,6 @@ spec = describe "parseError" $
|
||||||
, pstateTabWidth = mkPos 1
|
, pstateTabWidth = mkPos 1
|
||||||
, pstateLinePrefix = ""
|
, pstateLinePrefix = ""
|
||||||
}
|
}
|
||||||
Response Aeson.Null actual <-
|
Response Type.Null actual <-
|
||||||
parseError (ParseErrorBundle parseErrors posState)
|
parseError (ParseErrorBundle parseErrors posState)
|
||||||
length actual `shouldBe` 1
|
length actual `shouldBe` 1
|
||||||
|
|
|
@ -7,12 +7,8 @@ module Language.GraphQL.Execute.CoerceSpec
|
||||||
( spec
|
( spec
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Aeson as Aeson ((.=))
|
|
||||||
import qualified Data.Aeson as Aeson
|
|
||||||
import qualified Data.Aeson.Types as Aeson
|
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
import qualified Data.HashMap.Strict as HashMap
|
||||||
import Data.Maybe (isNothing)
|
import Data.Maybe (isNothing)
|
||||||
import Data.Scientific (scientific)
|
|
||||||
import qualified Language.GraphQL.Execute.Coerce as Coerce
|
import qualified Language.GraphQL.Execute.Coerce as Coerce
|
||||||
import Language.GraphQL.Type
|
import Language.GraphQL.Type
|
||||||
import qualified Language.GraphQL.Type.In as In
|
import qualified Language.GraphQL.Type.In as In
|
||||||
|
@ -27,81 +23,11 @@ direction = EnumType "Direction" Nothing $ HashMap.fromList
|
||||||
, ("WEST", EnumValue Nothing)
|
, ("WEST", EnumValue Nothing)
|
||||||
]
|
]
|
||||||
|
|
||||||
singletonInputObject :: In.Type
|
|
||||||
singletonInputObject = In.NamedInputObjectType type'
|
|
||||||
where
|
|
||||||
type' = In.InputObjectType "ObjectName" Nothing inputFields
|
|
||||||
inputFields = HashMap.singleton "field" field
|
|
||||||
field = In.InputField Nothing (In.NamedScalarType string) Nothing
|
|
||||||
|
|
||||||
namedIdType :: In.Type
|
namedIdType :: In.Type
|
||||||
namedIdType = In.NamedScalarType id
|
namedIdType = In.NamedScalarType id
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec =
|
||||||
describe "VariableValue Aeson" $ do
|
|
||||||
it "coerces strings" $
|
|
||||||
let expected = Just (String "asdf")
|
|
||||||
actual = Coerce.coerceVariableValue
|
|
||||||
(In.NamedScalarType string) (Aeson.String "asdf")
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
it "coerces non-null strings" $
|
|
||||||
let expected = Just (String "asdf")
|
|
||||||
actual = Coerce.coerceVariableValue
|
|
||||||
(In.NonNullScalarType string) (Aeson.String "asdf")
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
it "coerces booleans" $
|
|
||||||
let expected = Just (Boolean True)
|
|
||||||
actual = Coerce.coerceVariableValue
|
|
||||||
(In.NamedScalarType boolean) (Aeson.Bool True)
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
it "coerces zero to an integer" $
|
|
||||||
let expected = Just (Int 0)
|
|
||||||
actual = Coerce.coerceVariableValue
|
|
||||||
(In.NamedScalarType int) (Aeson.Number 0)
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
it "rejects fractional if an integer is expected" $
|
|
||||||
let actual = Coerce.coerceVariableValue
|
|
||||||
(In.NamedScalarType int) (Aeson.Number $ scientific 14 (-1))
|
|
||||||
in actual `shouldSatisfy` isNothing
|
|
||||||
it "coerces float numbers" $
|
|
||||||
let expected = Just (Float 1.4)
|
|
||||||
actual = Coerce.coerceVariableValue
|
|
||||||
(In.NamedScalarType float) (Aeson.Number $ scientific 14 (-1))
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
it "coerces IDs" $
|
|
||||||
let expected = Just (String "1234")
|
|
||||||
json = Aeson.String "1234"
|
|
||||||
actual = Coerce.coerceVariableValue namedIdType json
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
it "coerces input objects" $
|
|
||||||
let actual = Coerce.coerceVariableValue singletonInputObject
|
|
||||||
$ Aeson.object ["field" .= ("asdf" :: Aeson.Value)]
|
|
||||||
expected = Just $ Object $ HashMap.singleton "field" "asdf"
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
it "skips the field if it is missing in the variables" $
|
|
||||||
let actual = Coerce.coerceVariableValue
|
|
||||||
singletonInputObject Aeson.emptyObject
|
|
||||||
expected = Just $ Object HashMap.empty
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
it "fails if input object value contains extra fields" $
|
|
||||||
let actual = Coerce.coerceVariableValue singletonInputObject
|
|
||||||
$ Aeson.object variableFields
|
|
||||||
variableFields =
|
|
||||||
[ "field" .= ("asdf" :: Aeson.Value)
|
|
||||||
, "extra" .= ("qwer" :: Aeson.Value)
|
|
||||||
]
|
|
||||||
in actual `shouldSatisfy` isNothing
|
|
||||||
it "preserves null" $
|
|
||||||
let actual = Coerce.coerceVariableValue namedIdType Aeson.Null
|
|
||||||
in actual `shouldBe` Just Null
|
|
||||||
it "preserves list order" $
|
|
||||||
let list = Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"]
|
|
||||||
listType = (In.ListType $ In.NamedScalarType string)
|
|
||||||
actual = Coerce.coerceVariableValue listType list
|
|
||||||
expected = Just $ List [String "asdf", String "qwer"]
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
describe "coerceInputLiteral" $ do
|
describe "coerceInputLiteral" $ do
|
||||||
it "coerces enums" $
|
it "coerces enums" $
|
||||||
let expected = Just (Enum "NORTH")
|
let expected = Just (Enum "NORTH")
|
||||||
|
|
|
@ -10,9 +10,6 @@ module Language.GraphQL.ExecuteSpec
|
||||||
|
|
||||||
import Control.Exception (Exception(..), SomeException)
|
import Control.Exception (Exception(..), SomeException)
|
||||||
import Control.Monad.Catch (throwM)
|
import Control.Monad.Catch (throwM)
|
||||||
import Data.Aeson ((.=))
|
|
||||||
import qualified Data.Aeson as Aeson
|
|
||||||
import Data.Aeson.Types (emptyObject)
|
|
||||||
import Data.Conduit
|
import Data.Conduit
|
||||||
import Data.HashMap.Strict (HashMap)
|
import Data.HashMap.Strict (HashMap)
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
import qualified Data.HashMap.Strict as HashMap
|
||||||
|
@ -189,12 +186,12 @@ schoolType = EnumType "School" Nothing $ HashMap.fromList
|
||||||
]
|
]
|
||||||
|
|
||||||
type EitherStreamOrValue = Either
|
type EitherStreamOrValue = Either
|
||||||
(ResponseEventStream (Either SomeException) Aeson.Value)
|
(ResponseEventStream (Either SomeException) Value)
|
||||||
(Response Aeson.Value)
|
(Response Value)
|
||||||
|
|
||||||
execute' :: Document -> Either SomeException EitherStreamOrValue
|
execute' :: Document -> Either SomeException EitherStreamOrValue
|
||||||
execute' =
|
execute' =
|
||||||
execute philosopherSchema Nothing (mempty :: HashMap Name Aeson.Value)
|
execute philosopherSchema Nothing (mempty :: HashMap Name Value)
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec =
|
spec =
|
||||||
|
@ -209,38 +206,37 @@ spec =
|
||||||
...cyclicFragment
|
...cyclicFragment
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
expected = Response emptyObject mempty
|
expected = Response (Object mempty) mempty
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
Right (Right actual) = either (pure . parseError) execute'
|
||||||
$ parse document "" sourceQuery
|
$ parse document "" sourceQuery
|
||||||
in actual `shouldBe` expected
|
in actual `shouldBe` expected
|
||||||
|
|
||||||
context "Query" $ do
|
context "Query" $ do
|
||||||
it "skips unknown fields" $
|
it "skips unknown fields" $
|
||||||
let data'' = Aeson.object
|
let data'' = Object
|
||||||
[ "philosopher" .= Aeson.object
|
$ HashMap.singleton "philosopher"
|
||||||
[ "firstName" .= ("Friedrich" :: String)
|
$ Object
|
||||||
]
|
$ HashMap.singleton "firstName"
|
||||||
]
|
$ String "Friedrich"
|
||||||
expected = Response data'' mempty
|
expected = Response data'' mempty
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
Right (Right actual) = either (pure . parseError) execute'
|
||||||
$ parse document "" "{ philosopher { firstName surname } }"
|
$ parse document "" "{ philosopher { firstName surname } }"
|
||||||
in actual `shouldBe` expected
|
in actual `shouldBe` expected
|
||||||
it "merges selections" $
|
it "merges selections" $
|
||||||
let data'' = Aeson.object
|
let data'' = Object
|
||||||
[ "philosopher" .= Aeson.object
|
$ HashMap.singleton "philosopher"
|
||||||
[ "firstName" .= ("Friedrich" :: String)
|
$ Object
|
||||||
, "lastName" .= ("Nietzsche" :: String)
|
$ HashMap.fromList
|
||||||
|
[ ("firstName", String "Friedrich")
|
||||||
|
, ("lastName", String "Nietzsche")
|
||||||
]
|
]
|
||||||
]
|
|
||||||
expected = Response data'' mempty
|
expected = Response data'' mempty
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
Right (Right actual) = either (pure . parseError) execute'
|
||||||
$ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
|
$ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
|
||||||
in actual `shouldBe` expected
|
in actual `shouldBe` expected
|
||||||
|
|
||||||
it "errors on invalid output enum values" $
|
it "errors on invalid output enum values" $
|
||||||
let data'' = Aeson.object
|
let data'' = Object $ HashMap.singleton "philosopher" Null
|
||||||
[ "philosopher" .= Aeson.Null
|
|
||||||
]
|
|
||||||
executionErrors = pure $ Error
|
executionErrors = pure $ Error
|
||||||
{ message =
|
{ message =
|
||||||
"Value completion error. Expected type !School, found: EXISTENTIALISM."
|
"Value completion error. Expected type !School, found: EXISTENTIALISM."
|
||||||
|
@ -253,9 +249,7 @@ spec =
|
||||||
in actual `shouldBe` expected
|
in actual `shouldBe` expected
|
||||||
|
|
||||||
it "gives location information for non-null unions" $
|
it "gives location information for non-null unions" $
|
||||||
let data'' = Aeson.object
|
let data'' = Object $ HashMap.singleton "philosopher" Null
|
||||||
[ "philosopher" .= Aeson.Null
|
|
||||||
]
|
|
||||||
executionErrors = pure $ Error
|
executionErrors = pure $ Error
|
||||||
{ message =
|
{ message =
|
||||||
"Value completion error. Expected type !Interest, found: { instrument: \"piano\" }."
|
"Value completion error. Expected type !Interest, found: { instrument: \"piano\" }."
|
||||||
|
@ -268,9 +262,7 @@ spec =
|
||||||
in actual `shouldBe` expected
|
in actual `shouldBe` expected
|
||||||
|
|
||||||
it "gives location information for invalid interfaces" $
|
it "gives location information for invalid interfaces" $
|
||||||
let data'' = Aeson.object
|
let data'' = Object $ HashMap.singleton "philosopher" Null
|
||||||
[ "philosopher" .= Aeson.Null
|
|
||||||
]
|
|
||||||
executionErrors = pure $ Error
|
executionErrors = pure $ Error
|
||||||
{ message
|
{ message
|
||||||
= "Value completion error. Expected type !Work, found:\
|
= "Value completion error. Expected type !Work, found:\
|
||||||
|
@ -284,9 +276,7 @@ spec =
|
||||||
in actual `shouldBe` expected
|
in actual `shouldBe` expected
|
||||||
|
|
||||||
it "gives location information for invalid scalar arguments" $
|
it "gives location information for invalid scalar arguments" $
|
||||||
let data'' = Aeson.object
|
let data'' = Object $ HashMap.singleton "philosopher" Null
|
||||||
[ "philosopher" .= Aeson.Null
|
|
||||||
]
|
|
||||||
executionErrors = pure $ Error
|
executionErrors = pure $ Error
|
||||||
{ message =
|
{ message =
|
||||||
"Argument \"id\" has invalid type. Expected type ID, found: True."
|
"Argument \"id\" has invalid type. Expected type ID, found: True."
|
||||||
|
@ -299,9 +289,7 @@ spec =
|
||||||
in actual `shouldBe` expected
|
in actual `shouldBe` expected
|
||||||
|
|
||||||
it "gives location information for failed result coercion" $
|
it "gives location information for failed result coercion" $
|
||||||
let data'' = Aeson.object
|
let data'' = Object $ HashMap.singleton "philosopher" Null
|
||||||
[ "philosopher" .= Aeson.Null
|
|
||||||
]
|
|
||||||
executionErrors = pure $ Error
|
executionErrors = pure $ Error
|
||||||
{ message = "Unable to coerce result to !Int."
|
{ message = "Unable to coerce result to !Int."
|
||||||
, locations = [Location 1 26]
|
, locations = [Location 1 26]
|
||||||
|
@ -313,9 +301,7 @@ spec =
|
||||||
in actual `shouldBe` expected
|
in actual `shouldBe` expected
|
||||||
|
|
||||||
it "gives location information for failed result coercion" $
|
it "gives location information for failed result coercion" $
|
||||||
let data'' = Aeson.object
|
let data'' = Object $ HashMap.singleton "genres" Null
|
||||||
[ "genres" .= Aeson.Null
|
|
||||||
]
|
|
||||||
executionErrors = pure $ Error
|
executionErrors = pure $ Error
|
||||||
{ message = "PhilosopherException"
|
{ message = "PhilosopherException"
|
||||||
, locations = [Location 1 3]
|
, locations = [Location 1 3]
|
||||||
|
@ -332,15 +318,13 @@ spec =
|
||||||
, locations = [Location 1 3]
|
, locations = [Location 1 3]
|
||||||
, path = [Segment "count"]
|
, path = [Segment "count"]
|
||||||
}
|
}
|
||||||
expected = Response Aeson.Null executionErrors
|
expected = Response Null executionErrors
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
Right (Right actual) = either (pure . parseError) execute'
|
||||||
$ parse document "" "{ count }"
|
$ parse document "" "{ count }"
|
||||||
in actual `shouldBe` expected
|
in actual `shouldBe` expected
|
||||||
|
|
||||||
it "detects nullability errors" $
|
it "detects nullability errors" $
|
||||||
let data'' = Aeson.object
|
let data'' = Object $ HashMap.singleton "philosopher" Null
|
||||||
[ "philosopher" .= Aeson.Null
|
|
||||||
]
|
|
||||||
executionErrors = pure $ Error
|
executionErrors = pure $ Error
|
||||||
{ message = "Value completion error. Expected type !String, found: null."
|
{ message = "Value completion error. Expected type !String, found: null."
|
||||||
, locations = [Location 1 26]
|
, locations = [Location 1 26]
|
||||||
|
@ -353,11 +337,11 @@ spec =
|
||||||
|
|
||||||
context "Subscription" $
|
context "Subscription" $
|
||||||
it "subscribes" $
|
it "subscribes" $
|
||||||
let data'' = Aeson.object
|
let data'' = Object
|
||||||
[ "newQuote" .= Aeson.object
|
$ HashMap.singleton "newQuote"
|
||||||
[ "quote" .= ("Naturam expelles furca, tamen usque recurret." :: String)
|
$ Object
|
||||||
]
|
$ HashMap.singleton "quote"
|
||||||
]
|
$ String "Naturam expelles furca, tamen usque recurret."
|
||||||
expected = Response data'' mempty
|
expected = Response data'' mempty
|
||||||
Right (Left stream) = either (pure . parseError) execute'
|
Right (Left stream) = either (pure . parseError) execute'
|
||||||
$ parse document "" "subscription { newQuote { quote } }"
|
$ parse document "" "subscription { newQuote { quote } }"
|
||||||
|
|
|
@ -1,92 +0,0 @@
|
||||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
|
||||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
|
||||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
|
||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
module Test.DirectiveSpec
|
|
||||||
( spec
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Data.Aeson (object, (.=))
|
|
||||||
import qualified Data.Aeson as Aeson
|
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
|
||||||
import Language.GraphQL
|
|
||||||
import Language.GraphQL.TH
|
|
||||||
import Language.GraphQL.Type
|
|
||||||
import qualified Language.GraphQL.Type.Out as Out
|
|
||||||
import Test.Hspec (Spec, describe, it)
|
|
||||||
import Test.Hspec.GraphQL
|
|
||||||
|
|
||||||
experimentalResolver :: Schema IO
|
|
||||||
experimentalResolver = schema queryType Nothing Nothing mempty
|
|
||||||
where
|
|
||||||
queryType = Out.ObjectType "Query" Nothing []
|
|
||||||
$ HashMap.singleton "experimentalField"
|
|
||||||
$ Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
|
|
||||||
$ pure $ Int 5
|
|
||||||
|
|
||||||
emptyObject :: Aeson.Object
|
|
||||||
emptyObject = HashMap.singleton "data" $ object []
|
|
||||||
|
|
||||||
spec :: Spec
|
|
||||||
spec =
|
|
||||||
describe "Directive executor" $ do
|
|
||||||
it "should be able to @skip fields" $ do
|
|
||||||
let sourceQuery = [gql|
|
|
||||||
{
|
|
||||||
experimentalField @skip(if: true)
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
|
|
||||||
actual <- graphql experimentalResolver sourceQuery
|
|
||||||
actual `shouldResolveTo` emptyObject
|
|
||||||
|
|
||||||
it "should not skip fields if @skip is false" $ do
|
|
||||||
let sourceQuery = [gql|
|
|
||||||
{
|
|
||||||
experimentalField @skip(if: false)
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
expected = HashMap.singleton "data"
|
|
||||||
$ object
|
|
||||||
[ "experimentalField" .= (5 :: Int)
|
|
||||||
]
|
|
||||||
actual <- graphql experimentalResolver sourceQuery
|
|
||||||
actual `shouldResolveTo` expected
|
|
||||||
|
|
||||||
it "should skip fields if @include is false" $ do
|
|
||||||
let sourceQuery = [gql|
|
|
||||||
{
|
|
||||||
experimentalField @include(if: false)
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
|
|
||||||
actual <- graphql experimentalResolver sourceQuery
|
|
||||||
actual `shouldResolveTo` emptyObject
|
|
||||||
|
|
||||||
it "should be able to @skip a fragment spread" $ do
|
|
||||||
let sourceQuery = [gql|
|
|
||||||
{
|
|
||||||
...experimentalFragment @skip(if: true)
|
|
||||||
}
|
|
||||||
|
|
||||||
fragment experimentalFragment on Query {
|
|
||||||
experimentalField
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
|
|
||||||
actual <- graphql experimentalResolver sourceQuery
|
|
||||||
actual `shouldResolveTo` emptyObject
|
|
||||||
|
|
||||||
it "should be able to @skip an inline fragment" $ do
|
|
||||||
let sourceQuery = [gql|
|
|
||||||
{
|
|
||||||
... on Query @skip(if: true) {
|
|
||||||
experimentalField
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
|
|
||||||
actual <- graphql experimentalResolver sourceQuery
|
|
||||||
actual `shouldResolveTo` emptyObject
|
|
|
@ -1,204 +0,0 @@
|
||||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
|
||||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
|
||||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
|
||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
module Test.FragmentSpec
|
|
||||||
( spec
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Data.Aeson ((.=))
|
|
||||||
import qualified Data.Aeson as Aeson
|
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
|
||||||
import Data.Text (Text)
|
|
||||||
import Language.GraphQL
|
|
||||||
import Language.GraphQL.Type
|
|
||||||
import qualified Language.GraphQL.Type.Out as Out
|
|
||||||
import Language.GraphQL.TH
|
|
||||||
import Test.Hspec (Spec, describe, it)
|
|
||||||
import Test.Hspec.GraphQL
|
|
||||||
|
|
||||||
size :: (Text, Value)
|
|
||||||
size = ("size", String "L")
|
|
||||||
|
|
||||||
circumference :: (Text, Value)
|
|
||||||
circumference = ("circumference", Int 60)
|
|
||||||
|
|
||||||
garment :: Text -> (Text, Value)
|
|
||||||
garment typeName =
|
|
||||||
("garment", Object $ HashMap.fromList
|
|
||||||
[ if typeName == "Hat" then circumference else size
|
|
||||||
, ("__typename", String typeName)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
|
|
||||||
inlineQuery :: Text
|
|
||||||
inlineQuery = [gql|
|
|
||||||
{
|
|
||||||
garment {
|
|
||||||
... on Hat {
|
|
||||||
circumference
|
|
||||||
}
|
|
||||||
... on Shirt {
|
|
||||||
size
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
|
|
||||||
shirtType :: Out.ObjectType IO
|
|
||||||
shirtType = Out.ObjectType "Shirt" Nothing [] $ HashMap.fromList
|
|
||||||
[ ("size", sizeFieldType)
|
|
||||||
]
|
|
||||||
|
|
||||||
hatType :: Out.ObjectType IO
|
|
||||||
hatType = Out.ObjectType "Hat" Nothing [] $ HashMap.fromList
|
|
||||||
[ ("size", sizeFieldType)
|
|
||||||
, ("circumference", circumferenceFieldType)
|
|
||||||
]
|
|
||||||
|
|
||||||
circumferenceFieldType :: Out.Resolver IO
|
|
||||||
circumferenceFieldType
|
|
||||||
= Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
|
|
||||||
$ pure $ snd circumference
|
|
||||||
|
|
||||||
sizeFieldType :: Out.Resolver IO
|
|
||||||
sizeFieldType
|
|
||||||
= Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
|
|
||||||
$ pure $ snd size
|
|
||||||
|
|
||||||
toSchema :: Text -> (Text, Value) -> Schema IO
|
|
||||||
toSchema t (_, resolve) = schema queryType Nothing Nothing mempty
|
|
||||||
where
|
|
||||||
garmentType = Out.UnionType "Garment" Nothing [hatType, shirtType]
|
|
||||||
typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty
|
|
||||||
garmentField = Out.Field Nothing (Out.NamedUnionType garmentType) mempty
|
|
||||||
queryType =
|
|
||||||
case t of
|
|
||||||
"circumference" -> hatType
|
|
||||||
"size" -> shirtType
|
|
||||||
_ -> Out.ObjectType "Query" Nothing []
|
|
||||||
$ HashMap.fromList
|
|
||||||
[ ("garment", ValueResolver garmentField (pure resolve))
|
|
||||||
, ("__typename", ValueResolver typeNameField (pure $ String "Shirt"))
|
|
||||||
]
|
|
||||||
|
|
||||||
spec :: Spec
|
|
||||||
spec = do
|
|
||||||
describe "Inline fragment executor" $ do
|
|
||||||
it "chooses the first selection if the type matches" $ do
|
|
||||||
actual <- graphql (toSchema "Hat" $ garment "Hat") inlineQuery
|
|
||||||
let expected = HashMap.singleton "data"
|
|
||||||
$ Aeson.object
|
|
||||||
[ "garment" .= Aeson.object
|
|
||||||
[ "circumference" .= (60 :: Int)
|
|
||||||
]
|
|
||||||
]
|
|
||||||
in actual `shouldResolveTo` expected
|
|
||||||
|
|
||||||
it "chooses the last selection if the type matches" $ do
|
|
||||||
actual <- graphql (toSchema "Shirt" $ garment "Shirt") inlineQuery
|
|
||||||
let expected = HashMap.singleton "data"
|
|
||||||
$ Aeson.object
|
|
||||||
[ "garment" .= Aeson.object
|
|
||||||
[ "size" .= ("L" :: Text)
|
|
||||||
]
|
|
||||||
]
|
|
||||||
in actual `shouldResolveTo` expected
|
|
||||||
|
|
||||||
it "embeds inline fragments without type" $ do
|
|
||||||
let sourceQuery = [gql|
|
|
||||||
{
|
|
||||||
circumference
|
|
||||||
... {
|
|
||||||
size
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
actual <- graphql (toSchema "circumference" circumference) sourceQuery
|
|
||||||
let expected = HashMap.singleton "data"
|
|
||||||
$ Aeson.object
|
|
||||||
[ "circumference" .= (60 :: Int)
|
|
||||||
, "size" .= ("L" :: Text)
|
|
||||||
]
|
|
||||||
in actual `shouldResolveTo` expected
|
|
||||||
|
|
||||||
it "evaluates fragments on Query" $ do
|
|
||||||
let sourceQuery = [gql|
|
|
||||||
{
|
|
||||||
... {
|
|
||||||
size
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
in graphql (toSchema "size" size) `shouldResolve` sourceQuery
|
|
||||||
|
|
||||||
describe "Fragment spread executor" $ do
|
|
||||||
it "evaluates fragment spreads" $ do
|
|
||||||
let sourceQuery = [gql|
|
|
||||||
{
|
|
||||||
...circumferenceFragment
|
|
||||||
}
|
|
||||||
|
|
||||||
fragment circumferenceFragment on Hat {
|
|
||||||
circumference
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
|
|
||||||
actual <- graphql (toSchema "circumference" circumference) sourceQuery
|
|
||||||
let expected = HashMap.singleton "data"
|
|
||||||
$ Aeson.object
|
|
||||||
[ "circumference" .= (60 :: Int)
|
|
||||||
]
|
|
||||||
in actual `shouldResolveTo` expected
|
|
||||||
|
|
||||||
it "evaluates nested fragments" $ do
|
|
||||||
let sourceQuery = [gql|
|
|
||||||
{
|
|
||||||
garment {
|
|
||||||
...circumferenceFragment
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
fragment circumferenceFragment on Hat {
|
|
||||||
...hatFragment
|
|
||||||
}
|
|
||||||
|
|
||||||
fragment hatFragment on Hat {
|
|
||||||
circumference
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
|
|
||||||
actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
|
|
||||||
let expected = HashMap.singleton "data"
|
|
||||||
$ Aeson.object
|
|
||||||
[ "garment" .= Aeson.object
|
|
||||||
[ "circumference" .= (60 :: Int)
|
|
||||||
]
|
|
||||||
]
|
|
||||||
in actual `shouldResolveTo` expected
|
|
||||||
|
|
||||||
it "considers type condition" $ do
|
|
||||||
let sourceQuery = [gql|
|
|
||||||
{
|
|
||||||
garment {
|
|
||||||
...circumferenceFragment
|
|
||||||
...sizeFragment
|
|
||||||
}
|
|
||||||
}
|
|
||||||
fragment circumferenceFragment on Hat {
|
|
||||||
circumference
|
|
||||||
}
|
|
||||||
fragment sizeFragment on Shirt {
|
|
||||||
size
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
expected = HashMap.singleton "data"
|
|
||||||
$ Aeson.object
|
|
||||||
[ "garment" .= Aeson.object
|
|
||||||
[ "circumference" .= (60 :: Int)
|
|
||||||
]
|
|
||||||
]
|
|
||||||
actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
|
|
||||||
actual `shouldResolveTo` expected
|
|
|
@ -1,72 +0,0 @@
|
||||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
|
||||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
|
||||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
|
||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
module Test.RootOperationSpec
|
|
||||||
( spec
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Data.Aeson ((.=), object)
|
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
|
||||||
import Language.GraphQL
|
|
||||||
import Test.Hspec (Spec, describe, it)
|
|
||||||
import Language.GraphQL.TH
|
|
||||||
import Language.GraphQL.Type
|
|
||||||
import qualified Language.GraphQL.Type.Out as Out
|
|
||||||
import Test.Hspec.GraphQL
|
|
||||||
|
|
||||||
hatType :: Out.ObjectType IO
|
|
||||||
hatType = Out.ObjectType "Hat" Nothing []
|
|
||||||
$ HashMap.singleton "circumference"
|
|
||||||
$ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
|
|
||||||
$ pure $ Int 60
|
|
||||||
|
|
||||||
garmentSchema :: Schema IO
|
|
||||||
garmentSchema = schema queryType (Just mutationType) Nothing mempty
|
|
||||||
where
|
|
||||||
queryType = Out.ObjectType "Query" Nothing [] hatFieldResolver
|
|
||||||
mutationType = Out.ObjectType "Mutation" Nothing [] incrementFieldResolver
|
|
||||||
garment = pure $ Object $ HashMap.fromList
|
|
||||||
[ ("circumference", Int 60)
|
|
||||||
]
|
|
||||||
incrementFieldResolver = HashMap.singleton "incrementCircumference"
|
|
||||||
$ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
|
|
||||||
$ pure $ Int 61
|
|
||||||
hatField = Out.Field Nothing (Out.NamedObjectType hatType) mempty
|
|
||||||
hatFieldResolver =
|
|
||||||
HashMap.singleton "garment" $ ValueResolver hatField garment
|
|
||||||
|
|
||||||
spec :: Spec
|
|
||||||
spec =
|
|
||||||
describe "Root operation type" $ do
|
|
||||||
it "returns objects from the root resolvers" $ do
|
|
||||||
let querySource = [gql|
|
|
||||||
{
|
|
||||||
garment {
|
|
||||||
circumference
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
expected = HashMap.singleton "data"
|
|
||||||
$ object
|
|
||||||
[ "garment" .= object
|
|
||||||
[ "circumference" .= (60 :: Int)
|
|
||||||
]
|
|
||||||
]
|
|
||||||
actual <- graphql garmentSchema querySource
|
|
||||||
actual `shouldResolveTo` expected
|
|
||||||
|
|
||||||
it "chooses Mutation" $ do
|
|
||||||
let querySource = [gql|
|
|
||||||
mutation {
|
|
||||||
incrementCircumference
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
expected = HashMap.singleton "data"
|
|
||||||
$ object
|
|
||||||
[ "incrementCircumference" .= (61 :: Int)
|
|
||||||
]
|
|
||||||
actual <- graphql garmentSchema querySource
|
|
||||||
actual `shouldResolveTo` expected
|
|
Loading…
Reference in New Issue