Skip to content

Commit 1c6cac8

Browse files
authored
Merge pull request #85 from jml/fix-81
Resolve field name before checking field arguments. Closes #81.
2 parents 45350a2 + 8fd7e87 commit 1c6cac8

File tree

3 files changed

+52
-42
lines changed

3 files changed

+52
-42
lines changed

src/GraphQL/Resolver.hs

Lines changed: 47 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,7 @@ data ResolverError
6767
-- | There was a problem in the schema. Server-side problem.
6868
= SchemaError NameError
6969
-- | Couldn't find the requested field in the object. A client-side problem.
70-
| FieldNotFoundError (Field Value)
70+
| FieldNotFoundError Name
7171
-- | No value provided for name, and no default specified. Client-side problem.
7272
| ValueMissing Name
7373
-- | Could not translate value into Haskell. Probably a client-side problem.
@@ -85,7 +85,7 @@ instance GraphQLError ResolverError where
8585
formatError (SchemaError e) =
8686
"Schema error: " <> formatError e
8787
formatError (FieldNotFoundError field) =
88-
"Could not find value for field: " <> show field
88+
"Field not supported by the API: " <> show field
8989
formatError (ValueMissing name) =
9090
"No value provided for " <> show name <> ", and no default specified."
9191
formatError (InvalidValue name text) =
@@ -227,63 +227,76 @@ instance forall m ksN enum. (Applicative m, API.GraphQLEnum enum) => HasGraph m
227227
-- Maybe we can use advanced fallbacks like these:
228228
-- https://wiki.haskell.org/GHC/AdvancedOverlap
229229

230-
-- | Internal data type to capture a field's name + what to execute if
231-
-- the name matches the query. Note that the name is *not* in monad m,
232-
-- but the value is. This is necessary so we can skip execution if the
233-
-- name doesn't match.
234-
data NamedValueResolver m = NamedValueResolver Name (m (Result Value))
235230

236231
-- Iterate through handlers (zipped together with their type
237232
-- definition) and execute handler if the name matches.
233+
234+
-- TODO: A parametrized `Result` is really not a good way to handle
235+
-- the "result" for resolveField, but not sure what to use either. I
236+
-- liked the tuple we had before more because it didn't imply any
237+
-- other structure or meaning. Maybe we can jsut create a new datatype.
238238
type ResolveFieldResult = Result (Maybe GValue.ObjectField)
239239

240-
resolveField :: forall resolverType (m :: Type -> Type). (BuildFieldResolver m resolverType, Monad m)
241-
=> FieldHandler m resolverType -> m ResolveFieldResult -> Field Value -> m ResolveFieldResult
240+
-- Extract field name from an argument type. TODO: ideally we'd run
241+
-- this directly on the "a :> b" argument structure, but that requires
242+
-- passing in the plain argument structure type into resolveField or
243+
-- resolving "name" in the buildFieldResolver. Both options duplicate
244+
-- code somwehere else.
245+
type family FieldName (a :: Type) = (r :: Symbol) where
246+
FieldName (JustHandler (API.Field name t)) = name
247+
FieldName (PlainArgument a f) = FieldName f
248+
FieldName (EnumArgument a f) = FieldName f
249+
FieldName x = TypeError ('Text "Unexpected branch in FieldName type family. Please file a bug!" ':<>: 'ShowType x)
250+
251+
resolveField :: forall dispatchType (m :: Type -> Type).
252+
(BuildFieldResolver m dispatchType, Monad m, KnownSymbol (FieldName dispatchType))
253+
=> FieldHandler m dispatchType -> m ResolveFieldResult -> Field Value -> m ResolveFieldResult
242254
resolveField handler nextHandler field =
243-
case buildFieldResolver @m @resolverType handler field of
244-
-- TODO the fact that this doesn't fit together nicely makes me think that ObjectField is not a good idea)
245-
Left err -> pure (Result [err] (Just (GValue.ObjectField queryFieldName GValue.ValueNull)))
246-
Right (NamedValueResolver name' resolver) -> runResolver name' resolver
255+
-- check name before
256+
case nameFromSymbol @(FieldName dispatchType) of
257+
Left err -> pure (Result [SchemaError err] (Just (GValue.ObjectField queryFieldName GValue.ValueNull)))
258+
Right name' -> runResolver name'
247259
where
248-
runResolver :: Name -> m (Result Value) -> m ResolveFieldResult
249-
runResolver name' resolver
250-
| queryFieldName == name' = do
251-
Result errs value <- resolver
252-
pure (Result errs (Just (GValue.ObjectField queryFieldName value)))
260+
runResolver :: Name -> m ResolveFieldResult
261+
runResolver name'
262+
| queryFieldName == name' =
263+
case buildFieldResolver @m @dispatchType handler field of
264+
Left err -> pure (Result [err] (Just (GValue.ObjectField queryFieldName GValue.ValueNull)))
265+
Right resolver -> do
266+
Result errs value <- resolver
267+
pure (Result errs (Just (GValue.ObjectField queryFieldName value)))
253268
| otherwise = nextHandler
254269
queryFieldName = getName field
255270

256271
-- We're using our usual trick of rewriting a type in a closed type
257272
-- family to emulate a closed typeclass. The following are the
258273
-- universe of "allowed" class instances for field types:
259274
data JustHandler a
260-
data EnumField a b
261-
data PlainField a b
275+
data EnumArgument a b
276+
data PlainArgument a b
262277

263278
-- injective helps with errors sometimes
264279
type family FieldResolverDispatchType (a :: Type) = (r :: Type) | r -> a where
265280
FieldResolverDispatchType (API.Field ksA t) = JustHandler (API.Field ksA t)
266-
FieldResolverDispatchType (API.Argument ksB (API.Enum name t) :> f) = EnumField (API.Argument ksB (API.Enum name t)) (FieldResolverDispatchType f)
267-
FieldResolverDispatchType (API.Argument ksC t :> f) = PlainField (API.Argument ksC t) (FieldResolverDispatchType f)
281+
FieldResolverDispatchType (API.Argument ksB (API.Enum name t) :> f) = EnumArgument (API.Argument ksB (API.Enum name t)) (FieldResolverDispatchType f)
282+
FieldResolverDispatchType (API.Argument ksC t :> f) = PlainArgument (API.Argument ksC t) (FieldResolverDispatchType f)
268283

269284
-- | Derive the handler type from the Field/Argument type in a closed
270285
-- type family: We don't want anyone else to extend this ever.
271286
type family FieldHandler (m :: Type -> Type) (a :: Type) = (r :: Type) where
272287
FieldHandler m (JustHandler (API.Field ksD t)) = Handler m t
273-
FieldHandler m (PlainField (API.Argument ksE t) f) = t -> FieldHandler m f
274-
FieldHandler m (EnumField (API.Argument ksF (API.Enum name t)) f) = t -> FieldHandler m f
288+
FieldHandler m (PlainArgument (API.Argument ksE t) f) = t -> FieldHandler m f
289+
FieldHandler m (EnumArgument (API.Argument ksF (API.Enum name t)) f) = t -> FieldHandler m f
275290

276291
class BuildFieldResolver m fieldResolverType where
277-
buildFieldResolver :: FieldHandler m fieldResolverType -> Field Value -> Either ResolverError (NamedValueResolver m)
292+
buildFieldResolver :: FieldHandler m fieldResolverType -> Field Value -> Either ResolverError (m (Result Value))
278293

279294
instance forall ksG t m.
280295
( KnownSymbol ksG, HasGraph m t, HasAnnotatedType t, Monad m
281296
) => BuildFieldResolver m (JustHandler (API.Field ksG t)) where
282297
buildFieldResolver handler field = do
283298
let resolver = buildResolver @m @t handler (getFieldSelectionSet field)
284-
field' <- first SchemaError (API.getFieldDefinition @(API.Field ksG t))
285-
let name = getName field'
286-
Right (NamedValueResolver name resolver)
299+
pure resolver
287300

288301
instance forall ksH t f m.
289302
( KnownSymbol ksH
@@ -292,7 +305,7 @@ instance forall ksH t f m.
292305
, Defaultable t
293306
, HasAnnotatedInputType t
294307
, Monad m
295-
) => BuildFieldResolver m (PlainField (API.Argument ksH t) f) where
308+
) => BuildFieldResolver m (PlainArgument (API.Argument ksH t) f) where
296309
buildFieldResolver handler field = do
297310
argument <- first SchemaError (API.getArgumentDefinition @(API.Argument ksH t))
298311
let argName = getName argument
@@ -308,7 +321,7 @@ instance forall ksK t f m name.
308321
, Defaultable t
309322
, API.GraphQLEnum t
310323
, Monad m
311-
) => BuildFieldResolver m (EnumField (API.Argument ksK (API.Enum name t)) f) where
324+
) => BuildFieldResolver m (EnumArgument (API.Argument ksK (API.Enum name t)) f) where
312325
buildFieldResolver handler field = do
313326
argName <- first SchemaError (nameFromSymbol @ksK)
314327
value <- case lookupArgument field argName of
@@ -356,6 +369,7 @@ instance forall f fs m dispatchType.
356369
( BuildFieldResolver m dispatchType
357370
, dispatchType ~ FieldResolverDispatchType f
358371
, RunFields m fs
372+
, KnownSymbol (FieldName dispatchType)
359373
, Monad m
360374
) => RunFields m (f :<> fs) where
361375
runFields (handler :<> nextHandlers) selection =
@@ -372,17 +386,18 @@ instance forall ksM t m dispatchType.
372386
runFields handler field =
373387
resolveField @dispatchType @m handler nextHandler field
374388
where
375-
nextHandler = pure (Result [FieldNotFoundError field] Nothing)
389+
nextHandler = pure (Result [FieldNotFoundError (getName field)] Nothing)
376390

377391
instance forall m a b dispatchType.
378392
( BuildFieldResolver m dispatchType
379393
, dispatchType ~ FieldResolverDispatchType (a :> b)
394+
, KnownSymbol (FieldName dispatchType)
380395
, Monad m
381396
) => RunFields m (a :> b) where
382397
runFields handler field =
383398
resolveField @dispatchType @m handler nextHandler field
384399
where
385-
nextHandler = pure (Result [FieldNotFoundError field] Nothing)
400+
nextHandler = pure (Result [FieldNotFoundError (getName field)] Nothing)
386401

387402
instance forall typeName interfaces fields m.
388403
( RunFields m (RunFieldsType m fields)

tests/EndToEndTests.hs

Lines changed: 4 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ module EndToEndTests (tests) where
88

99
import Protolude
1010

11-
import Data.Aeson (Value(Null), toJSON, object, (.=))
11+
import Data.Aeson (toJSON, object, (.=))
1212
import GraphQL (interpretAnonymousQuery)
1313
import GraphQL.API (Object, Field)
1414
import GraphQL.Resolver ((:<>)(..), Handler)
@@ -145,12 +145,9 @@ tests = testSpec "End-to-end tests" $ do
145145
[ "data" .= object
146146
[ "dog" .= object
147147
[ "name" .= ("Mortgage" :: Text)
148-
, "owner" .= Null
149-
]
150-
]
151-
, "errors" .=
152-
[ object
153-
[ "message" .= ("No value provided for Name {unName = \"dogCommand\"}, and no default specified." :: Text)
148+
, "owner" .= object
149+
[ "name" .= ("jml" :: Text)
150+
]
154151
]
155152
]
156153
]

tests/ResolverTests.hs

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -46,9 +46,7 @@ tests = testSpec "TypeAPI" $ do
4646
encode object `shouldBe` "{\"t\":12}"
4747
it "complains about missing field" $ do
4848
Right (PartialSuccess _ errs) <- runExceptT (interpretAnonymousQuery @T tHandler "{ not_a_field }")
49-
-- TODO: jml thinks this is a really bad error message. Real problem is
50-
-- that `not_a_field` was provided.
51-
errs `shouldBe` singleError (ValueMissing (unsafeMakeName "x"))
49+
errs `shouldBe` singleError (FieldNotFoundError (unsafeMakeName "not_a_field"))
5250
it "complains about missing argument" $ do
5351
Right (PartialSuccess _ errs) <- runExceptT (interpretAnonymousQuery @T tHandler "{ t }")
5452
errs `shouldBe` singleError (ValueMissing (unsafeMakeName "x"))

0 commit comments

Comments
 (0)