Add basic output object type support
This commit is contained in:
parent
4c19c88e98
commit
a5c44f30fa
@ -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
|
||||||
|
@ -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 }"
|
||||||
|
@ -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.
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
18
src/Language/GraphQL/Type/Definition.hs
Normal file
18
src/Language/GraphQL/Type/Definition.hs
Normal 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
|
||||||
|
}
|
11
src/Language/GraphQL/Type/Schema.hs
Normal file
11
src/Language/GraphQL/Type/Schema.hs
Normal 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)
|
||||||
|
}
|
@ -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
|
||||||
|
@ -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)
|
|
||||||
|
@ -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
62
tests/Test/RootOperationSpec.hs
Normal 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
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user