@@ -67,7 +67,7 @@ data ResolverError
67
67
-- | There was a problem in the schema. Server-side problem.
68
68
= SchemaError NameError
69
69
-- | Couldn't find the requested field in the object. A client-side problem.
70
- | FieldNotFoundError ( Field Value )
70
+ | FieldNotFoundError Name
71
71
-- | No value provided for name, and no default specified. Client-side problem.
72
72
| ValueMissing Name
73
73
-- | Could not translate value into Haskell. Probably a client-side problem.
@@ -85,7 +85,7 @@ instance GraphQLError ResolverError where
85
85
formatError (SchemaError e) =
86
86
" Schema error: " <> formatError e
87
87
formatError (FieldNotFoundError field) =
88
- " Could not find value for field : " <> show field
88
+ " Field not supported by the API : " <> show field
89
89
formatError (ValueMissing name) =
90
90
" No value provided for " <> show name <> " , and no default specified."
91
91
formatError (InvalidValue name text) =
@@ -227,63 +227,76 @@ instance forall m ksN enum. (Applicative m, API.GraphQLEnum enum) => HasGraph m
227
227
-- Maybe we can use advanced fallbacks like these:
228
228
-- https://wiki.haskell.org/GHC/AdvancedOverlap
229
229
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 ))
235
230
236
231
-- Iterate through handlers (zipped together with their type
237
232
-- 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.
238
238
type ResolveFieldResult = Result (Maybe GValue. ObjectField )
239
239
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
242
254
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'
247
259
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)))
253
268
| otherwise = nextHandler
254
269
queryFieldName = getName field
255
270
256
271
-- We're using our usual trick of rewriting a type in a closed type
257
272
-- family to emulate a closed typeclass. The following are the
258
273
-- universe of "allowed" class instances for field types:
259
274
data JustHandler a
260
- data EnumField a b
261
- data PlainField a b
275
+ data EnumArgument a b
276
+ data PlainArgument a b
262
277
263
278
-- injective helps with errors sometimes
264
279
type family FieldResolverDispatchType (a :: Type ) = (r :: Type ) | r -> a where
265
280
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 )
268
283
269
284
-- | Derive the handler type from the Field/Argument type in a closed
270
285
-- type family: We don't want anyone else to extend this ever.
271
286
type family FieldHandler (m :: Type -> Type ) (a :: Type ) = (r :: Type ) where
272
287
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
275
290
276
291
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 ) )
278
293
279
294
instance forall ksG t m .
280
295
( KnownSymbol ksG , HasGraph m t , HasAnnotatedType t , Monad m
281
296
) => BuildFieldResolver m (JustHandler (API. Field ksG t )) where
282
297
buildFieldResolver handler field = do
283
298
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
287
300
288
301
instance forall ksH t f m .
289
302
( KnownSymbol ksH
@@ -292,7 +305,7 @@ instance forall ksH t f m.
292
305
, Defaultable t
293
306
, HasAnnotatedInputType t
294
307
, Monad m
295
- ) => BuildFieldResolver m (PlainField (API. Argument ksH t ) f ) where
308
+ ) => BuildFieldResolver m (PlainArgument (API. Argument ksH t ) f ) where
296
309
buildFieldResolver handler field = do
297
310
argument <- first SchemaError (API. getArgumentDefinition @ (API. Argument ksH t ))
298
311
let argName = getName argument
@@ -308,7 +321,7 @@ instance forall ksK t f m name.
308
321
, Defaultable t
309
322
, API. GraphQLEnum t
310
323
, 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
312
325
buildFieldResolver handler field = do
313
326
argName <- first SchemaError (nameFromSymbol @ ksK )
314
327
value <- case lookupArgument field argName of
@@ -356,6 +369,7 @@ instance forall f fs m dispatchType.
356
369
( BuildFieldResolver m dispatchType
357
370
, dispatchType ~ FieldResolverDispatchType f
358
371
, RunFields m fs
372
+ , KnownSymbol (FieldName dispatchType )
359
373
, Monad m
360
374
) => RunFields m (f :<> fs ) where
361
375
runFields (handler :<> nextHandlers) selection =
@@ -372,17 +386,18 @@ instance forall ksM t m dispatchType.
372
386
runFields handler field =
373
387
resolveField @ dispatchType @ m handler nextHandler field
374
388
where
375
- nextHandler = pure (Result [FieldNotFoundError field] Nothing )
389
+ nextHandler = pure (Result [FieldNotFoundError (getName field) ] Nothing )
376
390
377
391
instance forall m a b dispatchType .
378
392
( BuildFieldResolver m dispatchType
379
393
, dispatchType ~ FieldResolverDispatchType (a :> b )
394
+ , KnownSymbol (FieldName dispatchType )
380
395
, Monad m
381
396
) => RunFields m (a :> b ) where
382
397
runFields handler field =
383
398
resolveField @ dispatchType @ m handler nextHandler field
384
399
where
385
- nextHandler = pure (Result [FieldNotFoundError field] Nothing )
400
+ nextHandler = pure (Result [FieldNotFoundError (getName field) ] Nothing )
386
401
387
402
instance forall typeName interfaces fields m .
388
403
( RunFields m (RunFieldsType m fields )
0 commit comments