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 - `Error.ResolverException` is an exception that can be thrown by (field value
and event stream) resolvers to signalize an error. Other exceptions will and event stream) resolvers to signalize an error. Other exceptions will
escape. escape.
- `Test.Hspec.GraphQL` contains some test helpers.
## Changed ## Changed
- `Type.Out.Resolver`: Interface fields don't have resolvers, object fields - `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 - `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 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 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 - The constraint of the base monad was changed to `MonadCatch` (and it implies
`MonadThrow`). `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. To run the query, we call the `graphql` with the schema and the query.
> main1 :: IO () > 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 This runs the query by fetching the one field defined, returning
@ -101,7 +102,8 @@ Next we define our query.
> query2 = "{ time }" > query2 = "{ time }"
> >
> main2 :: IO () > 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 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 }" > query3 = "query timeAndHello { time hello }"
> >
> main3 :: IO () > 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 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 -- see: https://github.com/sol/hpack
-- --
-- hash: f3469205f704a81ee0f55655758cf588a9e9eb52303dadd58def32a2eb207696 -- hash: ca820b1bb2b81ffca4a3e2563bfa2be5381d80eaf4085595e07cf7db2aa3c6a9
name: graphql name: graphql
version: 0.8.0.0 version: 0.8.0.0
@ -51,6 +51,7 @@ library
Language.GraphQL.Type.In Language.GraphQL.Type.In
Language.GraphQL.Type.Out Language.GraphQL.Type.Out
Language.GraphQL.Type.Schema Language.GraphQL.Type.Schema
Test.Hspec.GraphQL
other-modules: other-modules:
Language.GraphQL.Execute.Execution Language.GraphQL.Execute.Execution
Language.GraphQL.Execute.Subscribe Language.GraphQL.Execute.Subscribe
@ -65,6 +66,7 @@ library
, conduit , conduit
, containers , containers
, exceptions , exceptions
, hspec-expectations
, megaparsec , megaparsec
, parser-combinators , parser-combinators
, scientific , scientific

2
package.yaml
View File

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

23
src/Language/GraphQL.hs
View File

@ -10,7 +10,7 @@ module Language.GraphQL
import Control.Monad.Catch (MonadCatch) import Control.Monad.Catch (MonadCatch)
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types 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 qualified Data.Sequence as Seq
import Data.Text (Text) import Data.Text (Text)
import Language.GraphQL.AST import Language.GraphQL.AST
@ -24,7 +24,7 @@ import Text.Megaparsec (parse)
graphql :: MonadCatch m graphql :: MonadCatch m
=> Schema m -- ^ Resolvers. => Schema m -- ^ Resolvers.
-> Text -- ^ Text representing a @GraphQL@ request document. -> 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 graphql schema = graphqlSubs schema mempty mempty
-- | If the text parses correctly as a @GraphQL@ query the substitution is -- | If the text parses correctly as a @GraphQL@ query the substitution is
@ -35,18 +35,15 @@ graphqlSubs :: MonadCatch m
-> Maybe Text -- ^ Operation name. -> Maybe Text -- ^ Operation name.
-> Aeson.Object -- ^ Variable substitution function. -> Aeson.Object -- ^ Variable substitution function.
-> Text -- ^ Text representing a @GraphQL@ request document. -> Text -- ^ Text representing a @GraphQL@ request document.
-> m Aeson.Value -- ^ Response. -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
graphqlSubs schema operationName variableValues document' graphqlSubs schema operationName variableValues document' =
= either parseError executeRequest (parse document "" document') case parse document "" document' of
>>= formatResponse Left errorBundle -> pure . formatResponse <$> parseError errorBundle
Right parsed -> fmap formatResponse
<$> execute schema operationName variableValues parsed
where where
executeRequest parsed formatResponse (Response data'' Seq.Empty) = HashMap.singleton "data" data''
= fromRight streamReturned formatResponse (Response data'' errors') = HashMap.fromList
<$> 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
[ ("data", data'') [ ("data", data'')
, ("errors", Aeson.toJSON $ fromError <$> errors') , ("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
import Language.GraphQL.Type import Language.GraphQL.Type
import qualified Language.GraphQL.Type.Out as Out 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) import Text.RawString.QQ (r)
experimentalResolver :: Schema IO experimentalResolver :: Schema IO
@ -26,10 +27,8 @@ experimentalResolver = Schema
$ Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty) $ Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
$ pure $ Int 5 $ pure $ Int 5
emptyObject :: Aeson.Value emptyObject :: Aeson.Object
emptyObject = object emptyObject = HashMap.singleton "data" $ object []
[ "data" .= object []
]
spec :: Spec spec :: Spec
spec = spec =
@ -42,7 +41,7 @@ spec =
|] |]
actual <- graphql experimentalResolver sourceQuery actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject actual `shouldResolveTo` emptyObject
it "should not skip fields if @skip is false" $ do it "should not skip fields if @skip is false" $ do
let sourceQuery = [r| let sourceQuery = [r|
@ -50,14 +49,12 @@ spec =
experimentalField @skip(if: false) experimentalField @skip(if: false)
} }
|] |]
expected = object expected = HashMap.singleton "data"
[ "data" .= object $ object
[ "experimentalField" .= (5 :: Int) [ "experimentalField" .= (5 :: Int)
] ]
]
actual <- graphql experimentalResolver sourceQuery actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` expected actual `shouldResolveTo` expected
it "should skip fields if @include is false" $ do it "should skip fields if @include is false" $ do
let sourceQuery = [r| let sourceQuery = [r|
@ -67,7 +64,7 @@ spec =
|] |]
actual <- graphql experimentalResolver sourceQuery actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject actual `shouldResolveTo` emptyObject
it "should be able to @skip a fragment spread" $ do it "should be able to @skip a fragment spread" $ do
let sourceQuery = [r| let sourceQuery = [r|
@ -81,7 +78,7 @@ spec =
|] |]
actual <- graphql experimentalResolver sourceQuery actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject actual `shouldResolveTo` emptyObject
it "should be able to @skip an inline fragment" $ do it "should be able to @skip an inline fragment" $ do
let sourceQuery = [r| let sourceQuery = [r|
@ -93,4 +90,4 @@ spec =
|] |]
actual <- graphql experimentalResolver sourceQuery 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 ( spec
) where ) where
import Data.Aeson (object, (.=)) import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text) import Data.Text (Text)
import Language.GraphQL import Language.GraphQL
import Language.GraphQL.Type import Language.GraphQL.Type
import qualified Language.GraphQL.Type.Out as Out import qualified Language.GraphQL.Type.Out as Out
import Test.Hspec import Test.Hspec (Spec, describe, it)
( Spec import Test.Hspec.GraphQL
, describe
, it
, shouldBe
, shouldNotSatisfy
)
import Text.RawString.QQ (r) import Text.RawString.QQ (r)
size :: (Text, Value) 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 IO
shirtType = Out.ObjectType "Shirt" Nothing [] shirtType = Out.ObjectType "Shirt" Nothing []
$ HashMap.fromList $ HashMap.fromList
@ -100,25 +91,23 @@ 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 (toSchema "Hat" $ garment "Hat") inlineQuery actual <- graphql (toSchema "Hat" $ garment "Hat") inlineQuery
let expected = object let expected = HashMap.singleton "data"
[ "data" .= object $ Aeson.object
[ "garment" .= object [ "garment" .= Aeson.object
[ "circumference" .= (60 :: Int) [ "circumference" .= (60 :: Int)
] ]
] ]
] in actual `shouldResolveTo` 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 (toSchema "Shirt" $ garment "Shirt") inlineQuery actual <- graphql (toSchema "Shirt" $ garment "Shirt") inlineQuery
let expected = object let expected = HashMap.singleton "data"
[ "data" .= object $ Aeson.object
[ "garment" .= object [ "garment" .= Aeson.object
[ "size" .= ("L" :: Text) [ "size" .= ("L" :: Text)
] ]
] ]
] in actual `shouldResolveTo` expected
in actual `shouldBe` expected
it "embeds inline fragments without type" $ do it "embeds inline fragments without type" $ do
let sourceQuery = [r|{ let sourceQuery = [r|{
@ -132,15 +121,14 @@ spec = do
resolvers = ("garment", Object $ HashMap.fromList [circumference, size]) resolvers = ("garment", Object $ HashMap.fromList [circumference, size])
actual <- graphql (toSchema "garment" resolvers) sourceQuery actual <- graphql (toSchema "garment" resolvers) sourceQuery
let expected = object let expected = HashMap.singleton "data"
[ "data" .= object $ Aeson.object
[ "garment" .= object [ "garment" .= Aeson.object
[ "circumference" .= (60 :: Int) [ "circumference" .= (60 :: Int)
, "size" .= ("L" :: Text) , "size" .= ("L" :: Text)
] ]
] ]
] in actual `shouldResolveTo` expected
in actual `shouldBe` expected
it "evaluates fragments on Query" $ do it "evaluates fragments on Query" $ do
let sourceQuery = [r|{ let sourceQuery = [r|{
@ -148,9 +136,7 @@ spec = do
size size
} }
}|] }|]
in graphql (toSchema "size" size) `shouldResolve` sourceQuery
actual <- graphql (toSchema "size" size) sourceQuery
actual `shouldNotSatisfy` hasErrors
describe "Fragment spread executor" $ do describe "Fragment spread executor" $ do
it "evaluates fragment spreads" $ do it "evaluates fragment spreads" $ do
@ -165,12 +151,11 @@ spec = do
|] |]
actual <- graphql (toSchema "circumference" circumference) sourceQuery actual <- graphql (toSchema "circumference" circumference) sourceQuery
let expected = object let expected = HashMap.singleton "data"
[ "data" .= object $ Aeson.object
[ "circumference" .= (60 :: Int) [ "circumference" .= (60 :: Int)
] ]
] in actual `shouldResolveTo` expected
in actual `shouldBe` expected
it "evaluates nested fragments" $ do it "evaluates nested fragments" $ do
let sourceQuery = [r| let sourceQuery = [r|
@ -190,19 +175,16 @@ spec = do
|] |]
actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
let expected = object let expected = HashMap.singleton "data"
[ "data" .= object $ Aeson.object
[ "garment" .= object [ "garment" .= Aeson.object
[ "circumference" .= (60 :: Int) [ "circumference" .= (60 :: Int)
] ]
] ]
] in actual `shouldResolveTo` expected
in actual `shouldBe` expected
it "rejects recursive fragments" $ do it "rejects recursive fragments" $ do
let expected = object let expected = HashMap.singleton "data" $ Aeson.object []
[ "data" .= object []
]
sourceQuery = [r| sourceQuery = [r|
{ {
...circumferenceFragment ...circumferenceFragment
@ -214,7 +196,7 @@ spec = do
|] |]
actual <- graphql (toSchema "circumference" circumference) sourceQuery actual <- graphql (toSchema "circumference" circumference) sourceQuery
actual `shouldBe` expected actual `shouldResolveTo` expected
it "considers type condition" $ do it "considers type condition" $ do
let sourceQuery = [r| let sourceQuery = [r|
@ -231,12 +213,11 @@ spec = do
size size
} }
|] |]
expected = object expected = HashMap.singleton "data"
[ "data" .= object $ Aeson.object
[ "garment" .= object [ "garment" .= Aeson.object
[ "circumference" .= (60 :: Int) [ "circumference" .= (60 :: Int)
] ]
] ]
]
actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery 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 Data.Aeson ((.=), object)
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Language.GraphQL import Language.GraphQL
import Test.Hspec (Spec, describe, it, shouldBe) import Test.Hspec (Spec, describe, it)
import Text.RawString.QQ (r) import Text.RawString.QQ (r)
import Language.GraphQL.Type import Language.GraphQL.Type
import qualified Language.GraphQL.Type.Out as Out import qualified Language.GraphQL.Type.Out as Out
import Test.Hspec.GraphQL
hatType :: Out.ObjectType IO hatType :: Out.ObjectType IO
hatType = Out.ObjectType "Hat" Nothing [] hatType = Out.ObjectType "Hat" Nothing []
@ -50,15 +51,14 @@ spec =
} }
} }
|] |]
expected = object expected = HashMap.singleton "data"
[ "data" .= object $ object
[ "garment" .= object [ "garment" .= object
[ "circumference" .= (60 :: Int) [ "circumference" .= (60 :: Int)
] ]
] ]
]
actual <- graphql schema querySource actual <- graphql schema querySource
actual `shouldBe` expected actual `shouldResolveTo` expected
it "chooses Mutation" $ do it "chooses Mutation" $ do
let querySource = [r| let querySource = [r|
@ -66,10 +66,9 @@ spec =
incrementCircumference incrementCircumference
} }
|] |]
expected = object expected = HashMap.singleton "data"
[ "data" .= object $ object
[ "incrementCircumference" .= (61 :: Int) [ "incrementCircumference" .= (61 :: Int)
] ]
]
actual <- graphql schema querySource 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 :: Text -> Aeson.Value -> Expectation
testQuery q expected = testQuery q expected =
let Right actual = graphql schema q let Right (Right actual) = graphql schema q
in actual `shouldBe` expected in Aeson.Object actual `shouldBe` expected
testQueryParams :: Aeson.Object -> Text -> Aeson.Value -> Expectation testQueryParams :: Aeson.Object -> Text -> Aeson.Value -> Expectation
testQueryParams f q expected = testQueryParams f q expected =
let Right actual = graphqlSubs schema Nothing f q let Right (Right actual) = graphqlSubs schema Nothing f q
in actual `shouldBe` expected in Aeson.Object actual `shouldBe` expected