OSS/graphql
1
1
Fork 1
Code Issues 4 Pull Requests Actions Releases 22 Wiki Activity

Add basic output object type support

Browse Source
This commit is contained in:
Eugen Wissner
2020-05-14 09:17:14 +02:00
parent 4c19c88e98
commit a5c44f30fa
13 changed files with 231 additions and 151 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
tests/Test/DirectiveSpec.hs
View File

@ -5,18 +5,22 @@ module Test.DirectiveSpec
) where
import Data.Aeson (Value(..), object, (.=))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import Language.GraphQL
import qualified Language.GraphQL.Schema as Schema
import Language.GraphQL.Type.Definition
import Language.GraphQL.Type.Schema (Schema(..))
import Test.Hspec (Spec, describe, it, shouldBe)
import Text.RawString.QQ (r)
experimentalResolver :: HashMap Text (NonEmpty (Schema.Resolver IO))
experimentalResolver = HashMap.singleton "Query"
$ Schema.scalar "experimentalField" (pure (5 :: Int)) :| []
experimentalResolver :: Schema IO
experimentalResolver = Schema { query = queryType, mutation = Nothing }
where
queryType = ObjectType "Query"
$ HashMap.singleton "experimentalField"
$ Schema.ValueResolver
$ pure
$ Number 5
emptyObject :: Value
emptyObject = object
@ -27,17 +31,17 @@ spec :: Spec
spec =
describe "Directive executor" $ do
it "should be able to @skip fields" $ do
let query = [r|
let sourceQuery = [r|
{
experimentalField @skip(if: true)
}
|]
actual <- graphql experimentalResolver query
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
it "should not skip fields if @skip is false" $ do
let query = [r|
let sourceQuery = [r|
{
experimentalField @skip(if: false)
}
@ -48,21 +52,21 @@ spec =
]
]
actual <- graphql experimentalResolver query
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` expected
it "should skip fields if @include is false" $ do
let query = [r|
let sourceQuery = [r|
{
experimentalField @include(if: false)
}
|]
actual <- graphql experimentalResolver query
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
it "should be able to @skip a fragment spread" $ do
let query = [r|
let sourceQuery = [r|
{
...experimentalFragment @skip(if: true)
}
@ -72,11 +76,11 @@ spec =
}
|]
actual <- graphql experimentalResolver query
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
it "should be able to @skip an inline fragment" $ do
let query = [r|
let sourceQuery = [r|
{
... on ExperimentalType @skip(if: true) {
experimentalField
@ -84,5 +88,5 @@ spec =
}
|]
actual <- graphql experimentalResolver query
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject

76
tests/Test/FragmentSpec.hs
View File

@ -10,13 +10,16 @@ import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import Language.GraphQL
import qualified Language.GraphQL.Schema as Schema
import Test.Hspec ( Spec
, describe
, it
, shouldBe
, shouldSatisfy
, shouldNotSatisfy
)
import Test.Hspec
( Spec
, describe
, it
, shouldBe
, shouldSatisfy
, shouldNotSatisfy
)
import Language.GraphQL.Type.Definition
import Language.GraphQL.Type.Schema
import Text.RawString.QQ (r)
size :: Schema.Resolver IO
@ -47,11 +50,18 @@ hasErrors :: Value -> Bool
hasErrors (Object object') = HashMap.member "errors" object'
hasErrors _ = True
toSchema :: Schema.Resolver IO -> Schema IO
toSchema resolver = Schema { query = queryType, mutation = Nothing }
where
queryType = ObjectType "Query"
$ Schema.resolversToMap
$ resolver :| []
spec :: Spec
spec = do
describe "Inline fragment executor" $ do
it "chooses the first selection if the type matches" $ do
actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) inlineQuery
actual <- graphql (toSchema $ garment "Hat") inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@ -62,7 +72,7 @@ spec = do
in actual `shouldBe` expected
it "chooses the last selection if the type matches" $ do
actual <- graphql (HashMap.singleton "Query" $ garment "Shirt" :| []) inlineQuery
actual <- graphql (toSchema $ garment "Shirt") inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@ -73,7 +83,7 @@ spec = do
in actual `shouldBe` expected
it "embeds inline fragments without type" $ do
let query = [r|{
let sourceQuery = [r|{
garment {
circumference
... {
@ -83,7 +93,7 @@ spec = do
}|]
resolvers = Schema.object "garment" $ return [circumference, size]
actual <- graphql (HashMap.singleton "Query" $ resolvers :| []) query
actual <- graphql (toSchema resolvers) sourceQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@ -95,18 +105,18 @@ spec = do
in actual `shouldBe` expected
it "evaluates fragments on Query" $ do
let query = [r|{
let sourceQuery = [r|{
... {
size
}
}|]
actual <- graphql (HashMap.singleton "Query" $ size :| []) query
actual <- graphql (toSchema size) sourceQuery
actual `shouldNotSatisfy` hasErrors
describe "Fragment spread executor" $ do
it "evaluates fragment spreads" $ do
let query = [r|
let sourceQuery = [r|
{
...circumferenceFragment
}
@ -116,7 +126,7 @@ spec = do
}
|]
actual <- graphql (HashMap.singleton "Query" $ circumference :| []) query
actual <- graphql (toSchema circumference) sourceQuery
let expected = object
[ "data" .= object
[ "circumference" .= (60 :: Int)
@ -125,7 +135,7 @@ spec = do
in actual `shouldBe` expected
it "evaluates nested fragments" $ do
let query = [r|
let sourceQuery = [r|
{
garment {
...circumferenceFragment
@ -141,7 +151,7 @@ spec = do
}
|]
actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) query
actual <- graphql (toSchema $ garment "Hat") sourceQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@ -152,7 +162,7 @@ spec = do
in actual `shouldBe` expected
it "rejects recursive fragments" $ do
let query = [r|
let sourceQuery = [r|
{
...circumferenceFragment
}
@ -162,11 +172,11 @@ spec = do
}
|]
actual <- graphql (HashMap.singleton "Query" $ circumference :| []) query
actual <- graphql (toSchema circumference) sourceQuery
actual `shouldSatisfy` hasErrors
it "considers type condition" $ do
let query = [r|
let sourceQuery = [r|
{
garment {
...circumferenceFragment
@ -187,29 +197,5 @@ spec = do
]
]
]
actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) query
actual <- graphql (toSchema $ garment "Hat") sourceQuery
actual `shouldBe` expected
it "test1" $ do
let query = [r|
{
garment {
circumference
}
}
|]
expected = object
[ "data" .= object
[ "garment" .= object
[ "circumference" .= (60 :: Int)
]
]
]
actual <- graphql schema query
actual `shouldBe` expected
where
schema = HashMap.singleton "Query" $ garment' :| []
garment' = Schema.object "garment" $ return
[ circumference'
]
circumference' = Schema.scalar "circumference" $ pure (60 :: Int)

40
tests/Test/QuerySpec.hs
View File

@ -1,40 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.QuerySpec
( spec
) where
import Data.Aeson ((.=), object)
import qualified Data.HashMap.Strict as HashMap
import Data.List.NonEmpty (NonEmpty(..))
import Language.GraphQL
import qualified Language.GraphQL.Schema as Schema
import Test.Hspec (Spec, describe, it, shouldBe)
import Text.RawString.QQ (r)
spec :: Spec
spec =
describe "Query executor" $
it "returns objects from the root resolvers" $ do
let query = [r|
{
garment {
circumference
}
}
|]
expected = object
[ "data" .= object
[ "garment" .= object
[ "circumference" .= (60 :: Int)
]
]
]
actual <- graphql schema query
actual `shouldBe` expected
where
schema = HashMap.singleton "Query" $ garment' :| []
garment' = Schema.object "garment" $ return
[ circumference'
]
circumference' = Schema.scalar "circumference" $ pure (60 :: Int)

62
tests/Test/RootOperationSpec.hs Normal file
View File

@ -0,0 +1,62 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.RootOperationSpec
( spec
) where
import Data.Aeson ((.=), object)
import Data.List.NonEmpty (NonEmpty(..))
import Language.GraphQL
import qualified Language.GraphQL.Schema as Schema
import Test.Hspec (Spec, describe, it, shouldBe)
import Text.RawString.QQ (r)
import Language.GraphQL.Type.Definition
import Language.GraphQL.Type.Schema
schema :: Schema IO
schema = Schema
(ObjectType "Query" queryResolvers)
(Just $ ObjectType "Mutation" mutationResolvers)
where
queryResolvers = Schema.resolversToMap $ garment :| []
mutationResolvers = Schema.resolversToMap $ increment :| []
garment = Schema.object "garment" $ pure
[ Schema.scalar "circumference" $ pure (60 :: Int)
]
increment = Schema.scalar "incrementCircumference"
$ pure (61 :: Int)
spec :: Spec
spec =
describe "Root operation type" $ do
it "returns objects from the root resolvers" $ do
let querySource = [r|
{
garment {
circumference
}
}
|]
expected = object
[ "data" .= object
[ "garment" .= object
[ "circumference" .= (60 :: Int)
]
]
]
actual <- graphql schema querySource
actual `shouldBe` expected
it "chooses Mutation" $ do
let querySource = [r|
mutation {
incrementCircumference
}
|]
expected = object
[ "data" .= object
[ "incrementCircumference" .= (61 :: Int)
]
]
actual <- graphql schema querySource
actual `shouldBe` expected

8
tests/Test/StarWars/Data.hs
View File

@ -11,7 +11,7 @@ module Test.StarWars.Data
, getHuman
, id_
, homePlanet
, name
, name_
, secretBackstory
, typeName
) where
@ -55,9 +55,9 @@ id_ :: Character -> ID
id_ (Left x) = _id_ . _droidChar $ x
id_ (Right x) = _id_ . _humanChar $ x
name :: Character -> Text
name (Left x) = _name . _droidChar $ x
name (Right x) = _name . _humanChar $ x
name_ :: Character -> Text
name_ (Left x) = _name . _droidChar $ x
name_ (Right x) = _name . _humanChar $ x
friends :: Character -> [ID]
friends (Left x) = _friends . _droidChar $ x

15
tests/Test/StarWars/Schema.hs
View File

@ -10,20 +10,23 @@ module Test.StarWars.Schema
import Control.Monad.Trans.Except (throwE)
import Control.Monad.Trans.Class (lift)
import Data.Functor.Identity (Identity)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified Language.GraphQL.Schema as Schema
import Language.GraphQL.Trans
import Language.GraphQL.Type.Definition
import qualified Language.GraphQL.Type as Type
import Language.GraphQL.Type.Schema
import Test.StarWars.Data
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
schema :: HashMap Text (NonEmpty (Schema.Resolver Identity))
schema = HashMap.singleton "Query" $ hero :| [human, droid]
schema :: Schema Identity
schema = Schema { query = queryType, mutation = Nothing }
where
queryType = ObjectType "Query"
$ Schema.resolversToMap
$ hero :| [human, droid]
hero :: Schema.Resolver Identity
hero = Schema.object "hero" $ do
@ -55,7 +58,7 @@ droid = Schema.object "droid" $ do
character :: Character -> ActionT Identity [Schema.Resolver Identity]
character char = return
[ Schema.scalar "id" $ return $ id_ char
, Schema.scalar "name" $ return $ name char
, Schema.scalar "name" $ return $ name_ char
, Schema.wrappedObject "friends"
$ traverse character $ Type.List $ Type.Named <$> getFriends char
, Schema.wrappedScalar "appearsIn" $ return . Type.List