diff options
Diffstat (limited to 'src/Language/GraphQL/Schema.hs')
| -rw-r--r-- | src/Language/GraphQL/Schema.hs | 33 |
1 files changed, 16 insertions, 17 deletions
diff --git a/src/Language/GraphQL/Schema.hs b/src/Language/GraphQL/Schema.hs index e76b42e..752ce29 100644 --- a/src/Language/GraphQL/Schema.hs +++ b/src/Language/GraphQL/Schema.hs @@ -3,8 +3,7 @@ -- | This module provides a representation of a @GraphQL@ Schema in addition to -- functions for defining and manipulating schemas. module Language.GraphQL.Schema - ( FieldResolver(..) - , Resolver(..) + ( Resolver(..) , Subs , object , resolve @@ -31,21 +30,18 @@ import qualified Data.Text as T import Language.GraphQL.AST.Core import Language.GraphQL.Error import Language.GraphQL.Trans +import qualified Language.GraphQL.Type.Definition as Definition import qualified Language.GraphQL.Type as Type -- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error -- information (if an error has occurred). @m@ is an arbitrary monad, usually -- 'IO'. -data Resolver m = Resolver Name (FieldResolver m) - -data FieldResolver m - = ValueResolver (ActionT m Aeson.Value) - | NestingResolver (ActionT m (Type.Wrapping (HashMap Name (FieldResolver m)))) +data Resolver m = Resolver Name (Definition.FieldResolver m) -- | Converts resolvers to a map. resolversToMap :: (Foldable f, Functor f) => f (Resolver m) - -> HashMap Text (FieldResolver m) + -> HashMap Text (Definition.FieldResolver m) resolversToMap = HashMap.fromList . toList . fmap toKV where toKV (Resolver name r) = (name, r) @@ -57,7 +53,7 @@ type Subs = HashMap Name Value -- | Create a new 'Resolver' with the given 'Name' from the given 'Resolver's. object :: Monad m => Name -> ActionT m [Resolver m] -> Resolver m object name = Resolver name - . NestingResolver + . Definition.NestingResolver . fmap (Type.Named . resolversToMap) -- | Like 'object' but can be null or a list of objects. @@ -66,19 +62,19 @@ wrappedObject :: Monad m -> ActionT m (Type.Wrapping [Resolver m]) -> Resolver m wrappedObject name = Resolver name - . NestingResolver + . Definition.NestingResolver . (fmap . fmap) resolversToMap -- | A scalar represents a primitive value, like a string or an integer. scalar :: (Monad m, Aeson.ToJSON a) => Name -> ActionT m a -> Resolver m -scalar name = Resolver name . ValueResolver . fmap Aeson.toJSON +scalar name = Resolver name . Definition.ValueResolver . fmap Aeson.toJSON -- | Like 'scalar' but can be null or a list of scalars. wrappedScalar :: (Monad m, Aeson.ToJSON a) => Name -> ActionT m (Type.Wrapping a) -> Resolver m -wrappedScalar name = Resolver name . ValueResolver . fmap Aeson.toJSON +wrappedScalar name = Resolver name . Definition.ValueResolver . fmap Aeson.toJSON resolveFieldValue :: Monad m => Field -> ActionT m a -> m (Either Text a) resolveFieldValue field@(Field _ _ args _) = @@ -91,11 +87,14 @@ convert Type.Null = Aeson.Null convert (Type.Named value) = value convert (Type.List value) = Aeson.toJSON value -withField :: Monad m => Field -> FieldResolver m -> CollectErrsT m Aeson.Object -withField field (ValueResolver resolver) = do +withField :: Monad m + => Field + -> Definition.FieldResolver m + -> CollectErrsT m Aeson.Object +withField field (Definition.ValueResolver resolver) = do answer <- lift $ resolveFieldValue field resolver either (errmsg field) (pure . HashMap.singleton (aliasOrName field)) answer -withField field@(Field _ _ _ seqSelection) (NestingResolver resolver) = do +withField field@(Field _ _ _ seqSelection) (Definition.NestingResolver resolver) = do answer <- lift $ resolveFieldValue field resolver case answer of Right result -> do @@ -112,7 +111,7 @@ errmsg field errorMessage = do -- 'Resolver' to each 'Field'. Resolves into a value containing the -- resolved 'Field', or a null value and error information. resolve :: Monad m - => HashMap Text (FieldResolver m) + => HashMap Text (Definition.FieldResolver m) -> Seq Selection -> CollectErrsT m Aeson.Value resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers @@ -122,7 +121,7 @@ resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers | (Just resolver) <- lookupResolver name = withField fld resolver | otherwise = errmsg fld $ T.unwords ["field", name, "not resolved."] tryResolvers (SelectionFragment (Fragment typeCondition selections')) - | Just (ValueResolver resolver) <- lookupResolver "__typename" = do + | Just (Definition.ValueResolver resolver) <- lookupResolver "__typename" = do let fakeField = Field Nothing "__typename" mempty mempty that <- lift $ resolveFieldValue fakeField resolver if Right (Aeson.String typeCondition) == that |