Add basic output object type support

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

View File

@ -13,6 +13,12 @@ and this project adheres to
execution. `FieldResolver` is executed in `ActionT` and the current `Field` is execution. `FieldResolver` is executed in `ActionT` and the current `Field` is
passed in the reader and not as an explicit argument. passed in the reader and not as an explicit argument.
### Added
- `Type.Definition` and `Type.Schema` modules. Both contain the first types (but
not all yet) to describe a schema. Public functions that execute queries
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.
## [0.7.0.0] - 2020-05-11 ## [0.7.0.0] - 2020-05-11
### Fixed ### Fixed
- Result of null encoding - Result of null encoding

View File

@ -17,14 +17,14 @@ Since this file is a literate haskell file, we start by importing some dependenc
> import Control.Monad.IO.Class (liftIO) > import Control.Monad.IO.Class (liftIO)
> import Data.Aeson (encode) > import Data.Aeson (encode)
> import Data.ByteString.Lazy.Char8 (putStrLn) > import Data.ByteString.Lazy.Char8 (putStrLn)
> import Data.HashMap.Strict (HashMap)
> import qualified Data.HashMap.Strict as HashMap
> import Data.List.NonEmpty (NonEmpty(..)) > import Data.List.NonEmpty (NonEmpty(..))
> import Data.Text (Text) > import Data.Text (Text)
> import Data.Time (getCurrentTime) > import Data.Time (getCurrentTime)
> >
> import Language.GraphQL > import Language.GraphQL
> import qualified Language.GraphQL.Schema as Schema > import qualified Language.GraphQL.Schema as Schema
> import Language.GraphQL.Type.Definition
> import Language.GraphQL.Type.Schema
> >
> import Prelude hiding (putStrLn) > import Prelude hiding (putStrLn)
@ -35,8 +35,11 @@ example from [graphql.js](https://github.com/graphql/graphql-js).
First we build a GraphQL schema. First we build a GraphQL schema.
> schema1 :: HashMap Text (NonEmpty (Schema.Resolver IO)) > schema1 :: Schema IO
> schema1 = HashMap.singleton "Query" $ hello :| [] > schema1 = Schema queryType Nothing
>
> queryType :: ObjectType IO
> queryType = ObjectType "Query" $ Schema.resolversToMap $ hello :| []
> >
> hello :: Schema.Resolver IO > hello :: Schema.Resolver IO
> hello = Schema.scalar "hello" (return ("it's me" :: Text)) > hello = Schema.scalar "hello" (return ("it's me" :: Text))
@ -65,8 +68,11 @@ returning
For this example, we're going to be using time. For this example, we're going to be using time.
> schema2 :: HashMap Text (NonEmpty (Schema.Resolver IO)) > schema2 :: Schema IO
> schema2 = HashMap.singleton "Query" $ time :| [] > schema2 = Schema queryType2 Nothing
>
> queryType2 :: ObjectType IO
> queryType2 = ObjectType "Query" $ Schema.resolversToMap $ time :| []
> >
> time :: Schema.Resolver IO > time :: Schema.Resolver IO
> time = Schema.scalar "time" $ do > time = Schema.scalar "time" $ do
@ -124,8 +130,11 @@ This will fail
Now that we have two resolvers, we can define a schema which uses them both. Now that we have two resolvers, we can define a schema which uses them both.
> schema3 :: HashMap Text (NonEmpty (Schema.Resolver IO)) > schema3 :: Schema IO
> schema3 = HashMap.singleton "Query" $ hello :| [time] > schema3 = Schema queryType3 Nothing
>
> queryType3 :: ObjectType IO
> queryType3 = ObjectType "Query" $ Schema.resolversToMap $ hello :| [time]
> >
> query3 :: Text > query3 :: Text
> query3 = "query timeAndHello { time hello }" > query3 = "query timeAndHello { time hello }"

View File

@ -5,19 +5,18 @@ module Language.GraphQL
) where ) where
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import Data.List.NonEmpty (NonEmpty)
import Data.HashMap.Strict (HashMap)
import Data.Text (Text) import Data.Text (Text)
import Language.GraphQL.Error import Language.GraphQL.Error
import Language.GraphQL.Execute import Language.GraphQL.Execute
import Language.GraphQL.AST.Parser import Language.GraphQL.AST.Parser
import qualified Language.GraphQL.Schema as Schema import qualified Language.GraphQL.Schema as Schema
import Language.GraphQL.Type.Schema
import Text.Megaparsec (parse) import Text.Megaparsec (parse)
-- | If the text parses correctly as a @GraphQL@ query the query is -- | If the text parses correctly as a @GraphQL@ query the query is
-- executed using the given 'Schema.Resolver's. -- executed using the given 'Schema.Resolver's.
graphql :: Monad m graphql :: Monad m
=> HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers. => Schema m -- ^ Resolvers.
-> Text -- ^ Text representing a @GraphQL@ request document. -> Text -- ^ Text representing a @GraphQL@ request document.
-> m Aeson.Value -- ^ Response. -> m Aeson.Value -- ^ Response.
graphql = flip graphqlSubs mempty graphql = flip graphqlSubs mempty
@ -26,7 +25,7 @@ graphql = flip graphqlSubs mempty
-- applied to the query and the query is then executed using to the given -- applied to the query and the query is then executed using to the given
-- 'Schema.Resolver's. -- 'Schema.Resolver's.
graphqlSubs :: Monad m graphqlSubs :: Monad m
=> HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers. => Schema m -- ^ Resolvers.
-> Schema.Subs -- ^ Variable substitution function. -> Schema.Subs -- ^ Variable substitution function.
-> Text -- ^ Text representing a @GraphQL@ request document. -> Text -- ^ Text representing a @GraphQL@ request document.
-> m Aeson.Value -- ^ Response. -> m Aeson.Value -- ^ Response.

View File

@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
-- | This module provides functions to execute a @GraphQL@ request. -- | This module provides functions to execute a @GraphQL@ request.
module Language.GraphQL.Execute module Language.GraphQL.Execute
@ -7,10 +8,8 @@ module Language.GraphQL.Execute
) where ) where
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import Data.Foldable (find)
import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import Language.GraphQL.AST.Document import Language.GraphQL.AST.Document
@ -18,6 +17,18 @@ import qualified Language.GraphQL.AST.Core as AST.Core
import qualified Language.GraphQL.Execute.Transform as Transform import qualified Language.GraphQL.Execute.Transform as Transform
import Language.GraphQL.Error import Language.GraphQL.Error
import qualified Language.GraphQL.Schema as Schema import qualified Language.GraphQL.Schema as Schema
import Language.GraphQL.Type.Definition
import Language.GraphQL.Type.Schema
-- | Query error types.
data QueryError
= OperationNotFound Text
| OperationNameRequired
queryError :: QueryError -> Text
queryError (OperationNotFound operationName) = Text.unwords
["Operation", operationName, "couldn't be found in the document."]
queryError OperationNameRequired = "Missing operation name."
-- | 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. -- to the resulting fields.
@ -25,7 +36,7 @@ import qualified Language.GraphQL.Schema as Schema
-- Returns the result of the query against the schema wrapped in a /data/ -- Returns the result of the query against the schema wrapped in a /data/
-- field, or errors wrapped in an /errors/ field. -- field, or errors wrapped in an /errors/ field.
execute :: Monad m execute :: Monad m
=> HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers. => Schema m -- ^ Resolvers.
-> Schema.Subs -- ^ Variable substitution function. -> Schema.Subs -- ^ Variable substitution function.
-> Document -- @GraphQL@ document. -> Document -- @GraphQL@ document.
-> m Aeson.Value -> m Aeson.Value
@ -42,45 +53,55 @@ execute schema subs doc =
-- Returns the result of the query against the schema wrapped in a /data/ -- Returns the result of the query against the schema wrapped in a /data/
-- field, or errors wrapped in an /errors/ field. -- field, or errors wrapped in an /errors/ field.
executeWithName :: Monad m executeWithName :: Monad m
=> HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers => Schema m -- ^ Resolvers
-> Text -- ^ Operation name. -> Text -- ^ Operation name.
-> Schema.Subs -- ^ Variable substitution function. -> Schema.Subs -- ^ Variable substitution function.
-> Document -- ^ @GraphQL@ Document. -> Document -- ^ @GraphQL@ Document.
-> m Aeson.Value -> m Aeson.Value
executeWithName schema name subs doc = executeWithName schema operationName subs doc =
maybe transformError (document schema $ Just name) maybe transformError (document schema $ Just operationName)
$ Transform.document subs doc $ Transform.document subs doc
where where
transformError = return $ singleError "Schema transformation error." transformError = return $ singleError "Schema transformation error."
getOperation
:: Maybe Text
-> AST.Core.Document
-> Either QueryError AST.Core.Operation
getOperation Nothing (operation' :| []) = pure operation'
getOperation Nothing _ = Left OperationNameRequired
getOperation (Just operationName) document'
| Just operation' <- find matchingName document' = pure operation'
| otherwise = Left $ OperationNotFound operationName
where
matchingName (AST.Core.Query (Just name') _) = operationName == name'
matchingName (AST.Core.Mutation (Just name') _) = operationName == name'
matchingName _ = False
document :: Monad m document :: Monad m
=> HashMap Text (NonEmpty (Schema.Resolver m)) => Schema m
-> Maybe Text -> Maybe Text
-> AST.Core.Document -> AST.Core.Document
-> m Aeson.Value -> m Aeson.Value
document schema Nothing (op :| []) = operation schema op document schema operationName document' =
document schema (Just name) operations = case NonEmpty.dropWhile matchingName operations of case getOperation operationName document' of
[] -> return $ singleError Left error' -> pure $ singleError $ queryError error'
$ Text.unwords ["Operation", name, "couldn't be found in the document."] Right operation' -> operation schema operation'
(op:_) -> operation schema op
where
matchingName (AST.Core.Query (Just name') _) = name == name'
matchingName (AST.Core.Mutation (Just name') _) = name == name'
matchingName _ = False
document _ _ _ = return $ singleError "Missing operation name."
operation :: Monad m operation :: Monad m
=> HashMap Text (NonEmpty (Schema.Resolver m)) => Schema m
-> AST.Core.Operation -> AST.Core.Operation
-> m Aeson.Value -> m Aeson.Value
operation schema = schemaOperation operation = schemaOperation
where where
runResolver fields = runCollectErrs resolve queryFields = runCollectErrs
. flip Schema.resolve fields . flip Schema.resolve queryFields
. Schema.resolversToMap . fields
resolve fields queryType = maybe lookupError (runResolver fields)
$ HashMap.lookup queryType schema
lookupError = pure lookupError = pure
$ singleError "Root operation type couldn't be found in the schema." $ singleError "Root operation type couldn't be found in the schema."
schemaOperation (AST.Core.Query _ fields) = resolve fields "Query" schemaOperation Schema {query} (AST.Core.Query _ fields') =
schemaOperation (AST.Core.Mutation _ fields) = resolve fields "Mutation" resolve fields' query
schemaOperation Schema {mutation = Just mutation} (AST.Core.Mutation _ fields') =
resolve fields' mutation
schemaOperation Schema {mutation = Nothing} (AST.Core.Mutation _ _) =
lookupError

View File

@ -3,7 +3,8 @@
-- | This module provides a representation of a @GraphQL@ Schema in addition to -- | This module provides a representation of a @GraphQL@ Schema in addition to
-- functions for defining and manipulating schemas. -- functions for defining and manipulating schemas.
module Language.GraphQL.Schema module Language.GraphQL.Schema
( Resolver(..) ( FieldResolver(..)
, Resolver(..)
, Subs , Subs
, object , object
, resolve , resolve

View File

@ -0,0 +1,18 @@
module Language.GraphQL.Type.Definition
( ObjectType(..)
) where
import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
import Language.GraphQL.Schema
type Fields m = HashMap Text (FieldResolver m)
-- | Object Type Definition.
--
-- Almost all of the GraphQL types you define will be object types. Object
-- types have a name, but most importantly describe their fields.
data ObjectType m = ObjectType
{ name :: Text
, fields :: Fields m
}

View File

@ -0,0 +1,11 @@
module Language.GraphQL.Type.Schema
( Schema(..)
) where
import Language.GraphQL.Type.Definition
-- | Schema Definition
data Schema m = Schema
{ query :: ObjectType m
, mutation :: Maybe (ObjectType m)
}

View File

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

View File

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

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)

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

View File

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

View File

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