Eugen Wissner
ae2210f659
This is experimental support. The implementation is based on conduit and is boring. There is a new resolver data constructor that should create a source event stream. The executor receives the events, pipes them through the normal execution and puts them into the response stream which is returned to the user. - Tests are missing. - The executor should check field value resolver on subscription types. - The graphql function should probably return (Either ResponseEventStream Response), but I'm not sure about this. It will make the usage more complicated if no subscriptions are involved, but with the current API implementing subscriptions is more difficult than it should be.
78 lines
2.9 KiB
Haskell
78 lines
2.9 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module Language.GraphQL.ExecuteSpec
|
|
( spec
|
|
) where
|
|
|
|
import Data.Aeson ((.=))
|
|
import qualified Data.Aeson as Aeson
|
|
import Data.Either (fromRight)
|
|
import Data.Functor.Identity (Identity(..))
|
|
import Data.HashMap.Strict (HashMap)
|
|
import qualified Data.HashMap.Strict as HashMap
|
|
import Language.GraphQL.AST (Name)
|
|
import Language.GraphQL.AST.Parser (document)
|
|
import Language.GraphQL.Error
|
|
import Language.GraphQL.Execute
|
|
import Language.GraphQL.Type as Type
|
|
import Language.GraphQL.Type.Out as Out
|
|
import Test.Hspec (Spec, describe, it, shouldBe)
|
|
import Text.Megaparsec (parse)
|
|
|
|
schema :: Schema Identity
|
|
schema = Schema {query = queryType, mutation = Nothing}
|
|
|
|
queryType :: Out.ObjectType Identity
|
|
queryType = Out.ObjectType "Query" Nothing []
|
|
$ HashMap.singleton "philosopher"
|
|
$ ValueResolver philosopherField
|
|
$ pure $ Type.Object mempty
|
|
where
|
|
philosopherField =
|
|
Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
|
|
|
|
philosopherType :: Out.ObjectType Identity
|
|
philosopherType = Out.ObjectType "Philosopher" Nothing []
|
|
$ HashMap.fromList resolvers
|
|
where
|
|
resolvers =
|
|
[ ("firstName", ValueResolver firstNameField firstNameResolver)
|
|
, ("lastName", ValueResolver lastNameField lastNameResolver)
|
|
]
|
|
firstNameField =
|
|
Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
|
firstNameResolver = pure $ Type.String "Friedrich"
|
|
lastNameField
|
|
= Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
|
lastNameResolver = pure $ Type.String "Nietzsche"
|
|
|
|
spec :: Spec
|
|
spec =
|
|
describe "execute" $ do
|
|
it "skips unknown fields" $
|
|
let data'' = Aeson.object
|
|
[ "philosopher" .= Aeson.object
|
|
[ "firstName" .= ("Friedrich" :: String)
|
|
]
|
|
]
|
|
expected = Response data'' mempty
|
|
execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
|
|
actual = fromRight (singleError "")
|
|
$ runIdentity
|
|
$ either (pure . parseError) execute'
|
|
$ parse document "" "{ philosopher { firstName surname } }"
|
|
in actual `shouldBe` expected
|
|
it "merges selections" $
|
|
let data'' = Aeson.object
|
|
[ "philosopher" .= Aeson.object
|
|
[ "firstName" .= ("Friedrich" :: String)
|
|
, "lastName" .= ("Nietzsche" :: String)
|
|
]
|
|
]
|
|
expected = Response data'' mempty
|
|
execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
|
|
actual = fromRight (singleError "")
|
|
$ runIdentity
|
|
$ either (pure . parseError) execute'
|
|
$ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
|
|
in actual `shouldBe` expected
|