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

Return a stream as well from graphql* functions

Browse Source
This commit is contained in:
Eugen Wissner 2020-07-19 07:36:06 +02:00
parent 09135c581a
commit b9d5b1fb1b
10 changed files with 116 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
CHANGELOG.md
View File

@ -27,6 +27,7 @@ and this project adheres to
- `Error.ResolverException` is an exception that can be thrown by (field value
and event stream) resolvers to signalize an error. Other exceptions will
escape.
- `Test.Hspec.GraphQL` contains some test helpers.
## Changed
- `Type.Out.Resolver`: Interface fields don't have resolvers, object fields
@ -46,7 +47,9 @@ and this project adheres to
- `graphqlSubs` takes an additional argument, the operation name. The type of
variable names is changed back to JSON since it is a common format and it
saves additional conversions. Custom format still can be used with the
underlying functions (in the `Execute` module).
underlying functions (in the `Execute` module). The function returns either a
a stream or the resolved value.
- `graphql` returns either a stream or the resolved value.
- The constraint of the base monad was changed to `MonadCatch` (and it implies
`MonadThrow`).

9
docs/tutorial/tutorial.lhs
View File

@ -64,7 +64,8 @@ Next we define our query.
To run the query, we call the `graphql` with the schema and the query.
> main1 :: IO ()
> main1 = graphql schema1 query1 >>= putStrLn . encode
> main1 = graphql schema1 query1
> >>= either (const $ pure ()) (putStrLn . encode)
This runs the query by fetching the one field defined, returning
@ -101,7 +102,8 @@ Next we define our query.
> query2 = "{ time }"
>
> main2 :: IO ()
> main2 = graphql schema2 query2 >>= putStrLn . encode
> main2 = graphql schema2 query2
> >>= either (const $ pure ()) (putStrLn . encode)
This runs the query, returning the current time
@ -126,7 +128,8 @@ Now that we have two resolvers, we can define a schema which uses them both.
> query3 = "query timeAndHello { time hello }"
>
> main3 :: IO ()
> main3 = graphql schema3 query3 >>= putStrLn . encode
> main3 = graphql schema3 query3
> >>= either (const $ pure ()) (putStrLn . encode)
This queries for both time and hello, returning

4
graphql.cabal
View File

@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
-- hash: f3469205f704a81ee0f55655758cf588a9e9eb52303dadd58def32a2eb207696
-- hash: ca820b1bb2b81ffca4a3e2563bfa2be5381d80eaf4085595e07cf7db2aa3c6a9
name: graphql
version: 0.8.0.0
@ -51,6 +51,7 @@ library
Language.GraphQL.Type.In
Language.GraphQL.Type.Out
Language.GraphQL.Type.Schema
Test.Hspec.GraphQL
other-modules:
Language.GraphQL.Execute.Execution
Language.GraphQL.Execute.Subscribe
@ -65,6 +66,7 @@ library
, conduit
, containers
, exceptions
, hspec-expectations
, megaparsec
, parser-combinators
, scientific

2
package.yaml
View File

@ -31,6 +31,7 @@ dependencies:
- conduit
- containers
- exceptions
- hspec-expectations
- megaparsec
- parser-combinators
- scientific
@ -58,7 +59,6 @@ tests:
dependencies:
- graphql
- hspec
- hspec-expectations
- hspec-megaparsec
- QuickCheck
- raw-strings-qq

23
src/Language/GraphQL.hs
View File

@ -10,7 +10,7 @@ module Language.GraphQL
import Control.Monad.Catch (MonadCatch)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.Either (fromRight)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Sequence as Seq
import Data.Text (Text)
import Language.GraphQL.AST
@ -24,7 +24,7 @@ import Text.Megaparsec (parse)
graphql :: MonadCatch m
=> Schema m -- ^ Resolvers.
-> Text -- ^ Text representing a @GraphQL@ request document.
-> m Aeson.Value -- ^ Response.
-> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
graphql schema = graphqlSubs schema mempty mempty
-- | If the text parses correctly as a @GraphQL@ query the substitution is
@ -35,18 +35,15 @@ graphqlSubs :: MonadCatch m
-> Maybe Text -- ^ Operation name.
-> Aeson.Object -- ^ Variable substitution function.
-> Text -- ^ Text representing a @GraphQL@ request document.
-> m Aeson.Value -- ^ Response.
graphqlSubs schema operationName variableValues document'
= either parseError executeRequest (parse document "" document')
>>= formatResponse
where
executeRequest parsed
= fromRight streamReturned
-> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
graphqlSubs schema operationName variableValues document' =
case parse document "" document' of
Left errorBundle -> pure . formatResponse <$> parseError errorBundle
Right parsed -> fmap formatResponse
<$> execute schema operationName variableValues parsed
streamReturned = singleError "This service does not support subscriptions."
formatResponse (Response data'' Seq.Empty) =
pure $ Aeson.object [("data", data'')]
formatResponse (Response data'' errors') = pure $ Aeson.object
where
formatResponse (Response data'' Seq.Empty) = HashMap.singleton "data" data''
formatResponse (Response data'' errors') = HashMap.fromList
[ ("data", data'')
, ("errors", Aeson.toJSON $ fromError <$> errors')
]

40
src/Test/Hspec/GraphQL.hs Normal file
View File

@ -0,0 +1,40 @@
{- 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 ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Test helpers.
module Test.Hspec.GraphQL
( shouldResolve
, shouldResolveTo
) where
import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import Language.GraphQL.Error
import Test.Hspec.Expectations (Expectation, expectationFailure, shouldBe, shouldNotSatisfy)
-- | Asserts that a query resolves to some value.
shouldResolveTo
:: Either (ResponseEventStream IO Aeson.Value) Aeson.Object
-> Aeson.Object
-> Expectation
shouldResolveTo (Right actual) expected = actual `shouldBe` expected
shouldResolveTo _ _ = expectationFailure
"the query is expected to resolve to a value, but it resolved to an event stream"
-- | Asserts that the response doesn't contain any errors.
shouldResolve
:: (Text -> IO (Either (ResponseEventStream IO Aeson.Value) Aeson.Object))
-> Text
-> Expectation
shouldResolve executor query = do
actual <- executor query
case actual of
Right response ->
response `shouldNotSatisfy` HashMap.member "errors"
_ -> expectationFailure
"the query is expected to resolve to a value, but it resolved to an event stream"

25
tests/Test/DirectiveSpec.hs
View File

@ -14,7 +14,8 @@ import qualified Data.HashMap.Strict as HashMap
import Language.GraphQL
import Language.GraphQL.Type
import qualified Language.GraphQL.Type.Out as Out
import Test.Hspec (Spec, describe, it, shouldBe)
import Test.Hspec (Spec, describe, it)
import Test.Hspec.GraphQL
import Text.RawString.QQ (r)
experimentalResolver :: Schema IO
@ -26,10 +27,8 @@ experimentalResolver = Schema
$ Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
$ pure $ Int 5
emptyObject :: Aeson.Value
emptyObject = object
[ "data" .= object []
]
emptyObject :: Aeson.Object
emptyObject = HashMap.singleton "data" $ object []
spec :: Spec
spec =
@ -42,7 +41,7 @@ spec =
|]
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
actual `shouldResolveTo` emptyObject
it "should not skip fields if @skip is false" $ do
let sourceQuery = [r|
@ -50,14 +49,12 @@ spec =
experimentalField @skip(if: false)
}
|]
expected = object
[ "data" .= object
expected = HashMap.singleton "data"
$ object
[ "experimentalField" .= (5 :: Int)
]
]
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` expected
actual `shouldResolveTo` expected
it "should skip fields if @include is false" $ do
let sourceQuery = [r|
@ -67,7 +64,7 @@ spec =
|]
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
actual `shouldResolveTo` emptyObject
it "should be able to @skip a fragment spread" $ do
let sourceQuery = [r|
@ -81,7 +78,7 @@ spec =
|]
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
actual `shouldResolveTo` emptyObject
it "should be able to @skip an inline fragment" $ do
let sourceQuery = [r|
@ -93,4 +90,4 @@ spec =
|]
actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
actual `shouldResolveTo` emptyObject

77
tests/Test/FragmentSpec.hs
View File

@ -8,20 +8,15 @@ module Test.FragmentSpec
( spec
) where
import Data.Aeson (object, (.=))
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 Test.Hspec
( Spec
, describe
, it
, shouldBe
, shouldNotSatisfy
)
import Test.Hspec (Spec, describe, it)
import Test.Hspec.GraphQL
import Text.RawString.QQ (r)
size :: (Text, Value)
@ -50,10 +45,6 @@ inlineQuery = [r|{
}
}|]
hasErrors :: Aeson.Value -> Bool
hasErrors (Aeson.Object object') = HashMap.member "errors" object'
hasErrors _ = True
shirtType :: Out.ObjectType IO
shirtType = Out.ObjectType "Shirt" Nothing []
$ HashMap.fromList
@ -100,25 +91,23 @@ 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 = object
[ "data" .= object
[ "garment" .= object
let expected = HashMap.singleton "data"
$ Aeson.object
[ "garment" .= Aeson.object
[ "circumference" .= (60 :: Int)
]
]
]
in actual `shouldBe` expected
in actual `shouldResolveTo` expected
it "chooses the last selection if the type matches" $ do
actual <- graphql (toSchema "Shirt" $ garment "Shirt") inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
let expected = HashMap.singleton "data"
$ Aeson.object
[ "garment" .= Aeson.object
[ "size" .= ("L" :: Text)
]
]
]
in actual `shouldBe` expected
in actual `shouldResolveTo` expected
it "embeds inline fragments without type" $ do
let sourceQuery = [r|{
@ -132,15 +121,14 @@ spec = do
resolvers = ("garment", Object $ HashMap.fromList [circumference, size])
actual <- graphql (toSchema "garment" resolvers) sourceQuery
let expected = object
[ "data" .= object
[ "garment" .= object
let expected = HashMap.singleton "data"
$ Aeson.object
[ "garment" .= Aeson.object
[ "circumference" .= (60 :: Int)
, "size" .= ("L" :: Text)
]
]
]
in actual `shouldBe` expected
in actual `shouldResolveTo` expected
it "evaluates fragments on Query" $ do
let sourceQuery = [r|{
@ -148,9 +136,7 @@ spec = do
size
}
}|]
actual <- graphql (toSchema "size" size) sourceQuery
actual `shouldNotSatisfy` hasErrors
in graphql (toSchema "size" size) `shouldResolve` sourceQuery
describe "Fragment spread executor" $ do
it "evaluates fragment spreads" $ do
@ -165,12 +151,11 @@ spec = do
|]
actual <- graphql (toSchema "circumference" circumference) sourceQuery
let expected = object
[ "data" .= object
let expected = HashMap.singleton "data"
$ Aeson.object
[ "circumference" .= (60 :: Int)
]
]
in actual `shouldBe` expected
in actual `shouldResolveTo` expected
it "evaluates nested fragments" $ do
let sourceQuery = [r|
@ -190,19 +175,16 @@ spec = do
|]
actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
let expected = object
[ "data" .= object
[ "garment" .= object
let expected = HashMap.singleton "data"
$ Aeson.object
[ "garment" .= Aeson.object
[ "circumference" .= (60 :: Int)
]
]
]
in actual `shouldBe` expected
in actual `shouldResolveTo` expected
it "rejects recursive fragments" $ do
let expected = object
[ "data" .= object []
]
let expected = HashMap.singleton "data" $ Aeson.object []
sourceQuery = [r|
{
...circumferenceFragment
@ -214,7 +196,7 @@ spec = do
|]
actual <- graphql (toSchema "circumference" circumference) sourceQuery
actual `shouldBe` expected
actual `shouldResolveTo` expected
it "considers type condition" $ do
let sourceQuery = [r|
@ -231,12 +213,11 @@ spec = do
size
}
|]
expected = object
[ "data" .= object
[ "garment" .= object
expected = HashMap.singleton "data"
$ Aeson.object
[ "garment" .= Aeson.object
[ "circumference" .= (60 :: Int)
]
]
]
actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
actual `shouldBe` expected
actual `shouldResolveTo` expected

17
tests/Test/RootOperationSpec.hs
View File

@ -11,10 +11,11 @@ module Test.RootOperationSpec
import Data.Aeson ((.=), object)
import qualified Data.HashMap.Strict as HashMap
import Language.GraphQL
import Test.Hspec (Spec, describe, it, shouldBe)
import Test.Hspec (Spec, describe, it)
import Text.RawString.QQ (r)
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 []
@ -50,15 +51,14 @@ spec =
}
}
|]
expected = object
[ "data" .= object
expected = HashMap.singleton "data"
$ object
[ "garment" .= object
[ "circumference" .= (60 :: Int)
]
]
]
actual <- graphql schema querySource
actual `shouldBe` expected
actual `shouldResolveTo` expected
it "chooses Mutation" $ do
let querySource = [r|
@ -66,10 +66,9 @@ spec =
incrementCircumference
}
|]
expected = object
[ "data" .= object
expected = HashMap.singleton "data"
$ object
[ "incrementCircumference" .= (61 :: Int)
]
]
actual <- graphql schema querySource
actual `shouldBe` expected
actual `shouldResolveTo` expected

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

@ -357,10 +357,10 @@ spec = describe "Star Wars Query Tests" $ do
testQuery :: Text -> Aeson.Value -> Expectation
testQuery q expected =
let Right actual = graphql schema q
in actual `shouldBe` expected
let Right (Right actual) = graphql schema q
in Aeson.Object actual `shouldBe` expected
testQueryParams :: Aeson.Object -> Text -> Aeson.Value -> Expectation
testQueryParams f q expected =
let Right actual = graphqlSubs schema Nothing f q
in actual `shouldBe` expected
let Right (Right actual) = graphqlSubs schema Nothing f q
in Aeson.Object actual `shouldBe` expected