summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDanny Navarro <j@dannynavarro.net>2017-03-03 20:39:03 -0300
committerDanny Navarro <j@dannynavarro.net>2017-03-03 17:02:19 -0300
commit2b5648efda40e28ae652ff6c27ac012edda0472e (patch)
tree664db4121ff56b516a87d6dd00df06951d971efa
parentfb071210cfd163bf8ee97448b7976ab4bdf1ed50 (diff)
downloadgraphql-2b5648efda40e28ae652ff6c27ac012edda0472e.tar.gz
When argument is not found return null
The relevant test was restored too.
-rw-r--r--Data/GraphQL/Schema.hs9
-rw-r--r--tests/Test/StarWars/QueryTests.hs31
2 files changed, 19 insertions, 21 deletions
diff --git a/Data/GraphQL/Schema.hs b/Data/GraphQL/Schema.hs
index 2646bac..e451981 100644
--- a/Data/GraphQL/Schema.hs
+++ b/Data/GraphQL/Schema.hs
@@ -24,7 +24,7 @@ module Data.GraphQL.Schema
, Value(..)
) where
-import Control.Applicative (Alternative(empty))
+import Control.Applicative (Alternative(empty), (<|>))
import Data.Foldable (fold)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromMaybe)
@@ -66,6 +66,7 @@ objectA
=> Name -> (Arguments -> Resolvers f) -> Resolver f
objectA name f fld@(Field _ _ args flds) = withField name (resolve (f args) flds) fld
+
-- | Create a named 'Resolver' from a list of 'Resolver's.
object' :: (Alternative f, Monad f) => Text -> f [Resolver f] -> Resolver f
object' name resolvs = objectA' name $ \case
@@ -136,9 +137,11 @@ enumA _ _ _ = empty
withField
:: (Alternative f, Aeson.ToJSON a)
=> Name -> f a -> Field -> f (HashMap Text Aeson.Value)
-withField name f (Field alias name' _ _) =
+withField name v (Field alias name' _ _) =
if name == name'
- then fmap (HashMap.singleton aliasOrName . Aeson.toJSON) f
+ then fmap (HashMap.singleton aliasOrName . Aeson.toJSON) v
+ -- TODO: Report error when Non-Nullable type for field argument.
+ <|> pure (HashMap.singleton aliasOrName Aeson.Null)
else empty
where
aliasOrName = fromMaybe name alias
diff --git a/tests/Test/StarWars/QueryTests.hs b/tests/Test/StarWars/QueryTests.hs
index c47b38a..3dd6075 100644
--- a/tests/Test/StarWars/QueryTests.hs
+++ b/tests/Test/StarWars/QueryTests.hs
@@ -140,24 +140,19 @@ test = testGroup "Star Wars Query Tests"
$ object [ "data" .= object [
"human" .= object [hanName]
]]
- -- TODO: Enable after Error handling restoration
- -- , testCase "Invalid ID" . testQueryParams
- -- (\v -> if v == "id"
- -- then Just "Not a valid ID"
- -- else Nothing)
- -- [r| query humanQuery($id: String!) {
- -- human(id: $id) {
- -- name
- -- }
- -- }
- -- |] $ object ["data" .= object ["human" .= object ["name" .= Aeson.Null]],
- -- "errors" .= Aeson.toJSON [object ["message" .= ("field name not resolved." :: Text)]]]
- -- TODO: This test is directly ported from `graphql-js`, however do we want
- -- to mimic the same behavior? Is this part of the spec? Once proper
- -- exceptions are implemented this test might no longer be meaningful.
- -- If the same behavior needs to be replicated, should it be implemented
- -- when defining the `Schema` or when executing?
- -- $ object [ "data" .= object ["human" .= Aeson.Null] ]
+ , testCase "Invalid ID" . testQueryParams
+ (\v -> if v == "id"
+ then Just "Not a valid ID"
+ else Nothing)
+ [r| query humanQuery($id: String!) {
+ human(id: $id) {
+ name
+ }
+ }
+ -- The GraphQL spec specifies that an error should be reported when the
+ -- type of the argument is Non-Nullable. However the equivalent test in
+ -- `graphql-js` doesn't check for any errors.
+ |] $ object ["data" .= object ["human" .= Aeson.Null]]
, testCase "Luke aliased" . testQuery
[r| query FetchLukeAliased {
luke: human(id: "1000") {