Check point
This commit is contained in:
parent
7cd4821718
commit
eb90a4091c
17
CHANGELOG.md
17
CHANGELOG.md
@ -10,27 +10,32 @@ and this project adheres to
|
||||
### Fixed
|
||||
- The parser rejects variables when parsing defaultValue (DefaultValue). The
|
||||
specification defines default values as `Value` with `const` parameter and
|
||||
constant cannot be variables. `AST.Document.ConstValue` was added,
|
||||
constants cannot be variables. `AST.Document.ConstValue` was added,
|
||||
`AST.Document.ObjectField` was modified.
|
||||
- AST transformation should never fail.
|
||||
* Missing variable are assumed to be null.
|
||||
* Invalid (recusrive or non-existing) fragments should be skipped.
|
||||
|
||||
### Changed
|
||||
- `Resolver` is now `Resolver Name FieldResolver` where `FieldResolver` can
|
||||
contain a JSON value or another resolver, which is invoked during the
|
||||
execution. `FieldResolver` is executed in `ActionT` and the current `Field` is
|
||||
passed in the reader and not as an explicit argument.
|
||||
- `Schema.Resolver` cannot return arbitrary JSON anymore, but only
|
||||
`Type.Out.Value`.
|
||||
- `Schema.object` takes an array of field resolvers (name, value pairs) and
|
||||
returns a resolver (just the function). There is no need in special functions
|
||||
to construct field resolvers anymore, they can be constructed with just
|
||||
`Resolver "fieldName" $ pure $ object [...]`.
|
||||
- `Execute.Transform.operation` has the prior responsibility of
|
||||
`Execute.Transform.document`, but transforms only the chosen operation and not
|
||||
the whole document. `Execute.Transform.document` translates
|
||||
`AST.Document.Document` into `Execute.Transform.Document`.
|
||||
- `AST.Core.Value` was moved into `Type.In`. Input values are used only in the
|
||||
execution and type system, it is not a part of the parsing tree.
|
||||
|
||||
### Added
|
||||
- `Type.Definition` contains input and the most output types.
|
||||
- `Type.Schema` describes a schema. Both public functions that execute queries
|
||||
accept a `Schema` now instead of a `HashMap`. The execution fails if the root
|
||||
operation doesn't match the root Query type in the schema.
|
||||
- `Type.In` and `Type.Out`.
|
||||
- `Execute.Coerce` defines a typeclass responsible for input, variable value
|
||||
coercion. It decouples us a bit from JSON since any format can be used to pass
|
||||
query variables. Execution functions accept (`HashMap Name a`) instead of
|
||||
@ -45,6 +50,8 @@ and this project adheres to
|
||||
converted to JSON and JSON is not suitable as an internal representation for
|
||||
GraphQL. E.g. GraphQL distinguishes between Floats and Integersa and we need
|
||||
a way to represent objects as a "Field Name -> Resolver" map.
|
||||
- `Schema.wrappedObject`. `Schema.object` creates now wrapped objects.
|
||||
- `Type` module. Superseded by `Type.Out`.
|
||||
|
||||
## [0.7.0.0] - 2020-05-11
|
||||
### Fixed
|
||||
|
||||
@ -9,15 +9,13 @@ module Language.GraphQL.AST.Core
|
||||
, Operation(..)
|
||||
, Selection(..)
|
||||
, TypeCondition
|
||||
, Value(..)
|
||||
) where
|
||||
|
||||
import Data.Int (Int32)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Data.Sequence (Seq)
|
||||
import Data.String (IsString(..))
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST (Alias, Name, TypeCondition)
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
|
||||
-- | GraphQL has 3 operation types: queries, mutations and subscribtions.
|
||||
--
|
||||
@ -33,7 +31,7 @@ data Field
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Argument list.
|
||||
newtype Arguments = Arguments (HashMap Name Value)
|
||||
newtype Arguments = Arguments (HashMap Name In.Value)
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Semigroup Arguments where
|
||||
@ -56,18 +54,3 @@ data Selection
|
||||
= SelectionFragment Fragment
|
||||
| SelectionField Field
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Represents accordingly typed GraphQL values.
|
||||
data Value
|
||||
= Int Int32
|
||||
| Float Double -- ^ GraphQL Float is double precision
|
||||
| String Text
|
||||
| Boolean Bool
|
||||
| Null
|
||||
| Enum Name
|
||||
| List [Value]
|
||||
| Object (HashMap Name Value)
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance IsString Value where
|
||||
fromString = String . fromString
|
||||
|
||||
@ -15,7 +15,8 @@ import qualified Data.Text.Lazy as Text.Lazy
|
||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
|
||||
import Data.Scientific (toBoundedInteger, toRealFloat)
|
||||
import Language.GraphQL.AST.Core
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import Language.GraphQL.Schema
|
||||
import Language.GraphQL.Type.Definition
|
||||
|
||||
@ -46,26 +47,26 @@ class VariableValue a where
|
||||
coerceVariableValue
|
||||
:: InputType -- ^ Expected type (variable type given in the query).
|
||||
-> a -- ^ Variable value being coerced.
|
||||
-> Maybe Value -- ^ Coerced value on success, 'Nothing' otherwise.
|
||||
-> Maybe In.Value -- ^ Coerced value on success, 'Nothing' otherwise.
|
||||
|
||||
instance VariableValue Aeson.Value where
|
||||
coerceVariableValue _ Aeson.Null = Just Null
|
||||
coerceVariableValue _ Aeson.Null = Just In.Null
|
||||
coerceVariableValue (ScalarInputTypeDefinition scalarType) value
|
||||
| (Aeson.String stringValue) <- value = Just $ String stringValue
|
||||
| (Aeson.Bool booleanValue) <- value = Just $ Boolean booleanValue
|
||||
| (Aeson.String stringValue) <- value = Just $ In.String stringValue
|
||||
| (Aeson.Bool booleanValue) <- value = Just $ In.Boolean booleanValue
|
||||
| (Aeson.Number numberValue) <- value
|
||||
, (ScalarType "Float" _) <- scalarType =
|
||||
Just $ Float $ toRealFloat numberValue
|
||||
Just $ In.Float $ toRealFloat numberValue
|
||||
| (Aeson.Number numberValue) <- value = -- ID or Int
|
||||
Int <$> toBoundedInteger numberValue
|
||||
In.Int <$> toBoundedInteger numberValue
|
||||
coerceVariableValue (EnumInputTypeDefinition _) (Aeson.String stringValue) =
|
||||
Just $ Enum stringValue
|
||||
Just $ In.Enum stringValue
|
||||
coerceVariableValue (ObjectInputTypeDefinition objectType) value
|
||||
| (Aeson.Object objectValue) <- value = do
|
||||
let (InputObjectType _ _ inputFields) = objectType
|
||||
(newObjectValue, resultMap) <- foldWithKey objectValue inputFields
|
||||
if HashMap.null newObjectValue
|
||||
then Just $ Object resultMap
|
||||
then Just $ In.Object resultMap
|
||||
else Nothing
|
||||
where
|
||||
foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues
|
||||
@ -81,7 +82,7 @@ instance VariableValue Aeson.Value where
|
||||
pure (newObjectValue, insert coerced)
|
||||
Nothing -> Just (objectValue, resultMap)
|
||||
coerceVariableValue (ListInputTypeDefinition listType) value
|
||||
| (Aeson.Array arrayValue) <- value = List
|
||||
| (Aeson.Array arrayValue) <- value = In.List
|
||||
<$> foldr foldVector (Just []) arrayValue
|
||||
| otherwise = coerceVariableValue listType value
|
||||
where
|
||||
@ -95,7 +96,7 @@ instance VariableValue Aeson.Value where
|
||||
-- corresponding types.
|
||||
coerceInputLiterals
|
||||
:: HashMap Name InputType
|
||||
-> HashMap Name Value
|
||||
-> HashMap Name In.Value
|
||||
-> Maybe Subs
|
||||
coerceInputLiterals variableTypes variableValues =
|
||||
foldWithKey operator variableTypes
|
||||
@ -105,34 +106,34 @@ coerceInputLiterals variableTypes variableValues =
|
||||
<$> (lookupVariable variableName >>= coerceInputLiteral variableType)
|
||||
<*> resultMap
|
||||
coerceInputLiteral (ScalarInputType type') value
|
||||
| (String stringValue) <- value
|
||||
, (ScalarType "String" _) <- type' = Just $ String stringValue
|
||||
| (Boolean booleanValue) <- value
|
||||
, (ScalarType "Boolean" _) <- type' = Just $ Boolean booleanValue
|
||||
| (Int intValue) <- value
|
||||
, (ScalarType "Int" _) <- type' = Just $ Int intValue
|
||||
| (Float floatValue) <- value
|
||||
, (ScalarType "Float" _) <- type' = Just $ Float floatValue
|
||||
| (Int intValue) <- value
|
||||
| (In.String stringValue) <- value
|
||||
, (ScalarType "String" _) <- type' = Just $ In.String stringValue
|
||||
| (In.Boolean booleanValue) <- value
|
||||
, (ScalarType "Boolean" _) <- type' = Just $ In.Boolean booleanValue
|
||||
| (In.Int intValue) <- value
|
||||
, (ScalarType "Int" _) <- type' = Just $ In.Int intValue
|
||||
| (In.Float floatValue) <- value
|
||||
, (ScalarType "Float" _) <- type' = Just $ In.Float floatValue
|
||||
| (In.Int intValue) <- value
|
||||
, (ScalarType "Float" _) <- type' =
|
||||
Just $ Float $ fromIntegral intValue
|
||||
| (String stringValue) <- value
|
||||
, (ScalarType "ID" _) <- type' = Just $ String stringValue
|
||||
| (Int intValue) <- value
|
||||
Just $ In.Float $ fromIntegral intValue
|
||||
| (In.String stringValue) <- value
|
||||
, (ScalarType "ID" _) <- type' = Just $ In.String stringValue
|
||||
| (In.Int intValue) <- value
|
||||
, (ScalarType "ID" _) <- type' = Just $ decimal intValue
|
||||
coerceInputLiteral (EnumInputType type') (Enum enumValue)
|
||||
| member enumValue type' = Just $ Enum enumValue
|
||||
coerceInputLiteral (ObjectInputType type') (Object _) =
|
||||
coerceInputLiteral (EnumInputType type') (In.Enum enumValue)
|
||||
| member enumValue type' = Just $ In.Enum enumValue
|
||||
coerceInputLiteral (ObjectInputType type') (In.Object _) =
|
||||
let (InputObjectType _ _ inputFields) = type'
|
||||
in Object <$> foldWithKey matchFieldValues inputFields
|
||||
in In.Object <$> foldWithKey matchFieldValues inputFields
|
||||
coerceInputLiteral _ _ = Nothing
|
||||
member value (EnumType _ _ members) = Set.member value members
|
||||
matchFieldValues fieldName (InputField _ type' defaultValue) resultMap =
|
||||
case lookupVariable fieldName of
|
||||
Just Null
|
||||
Just In.Null
|
||||
| isNonNullInputType type' -> Nothing
|
||||
| otherwise ->
|
||||
HashMap.insert fieldName Null <$> resultMap
|
||||
HashMap.insert fieldName In.Null <$> resultMap
|
||||
Just variableValue -> HashMap.insert fieldName
|
||||
<$> coerceInputLiteral type' variableValue
|
||||
<*> resultMap
|
||||
@ -144,7 +145,7 @@ coerceInputLiterals variableTypes variableValues =
|
||||
| otherwise -> resultMap
|
||||
lookupVariable = flip HashMap.lookup variableValues
|
||||
foldWithKey f = HashMap.foldrWithKey f (Just HashMap.empty)
|
||||
decimal = String
|
||||
decimal = In.String
|
||||
. Text.Lazy.toStrict
|
||||
. Text.Builder.toLazyText
|
||||
. Text.Builder.decimal
|
||||
|
||||
@ -32,6 +32,7 @@ import Language.GraphQL.Execute.Coerce
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
import qualified Language.GraphQL.Type.Definition as Definition
|
||||
import qualified Language.GraphQL.Type.Directive as Directive
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import Language.GraphQL.Type.Schema
|
||||
|
||||
-- | Associates a fragment name with a list of 'Core.Field's.
|
||||
@ -136,23 +137,23 @@ coerceVariableValues schema operationDefinition variableValues' =
|
||||
<*> coercedValues
|
||||
choose Nothing defaultValue variableType
|
||||
| Just _ <- defaultValue = defaultValue
|
||||
| not (isNonNullInputType variableType) = Just Core.Null
|
||||
| not (isNonNullInputType variableType) = Just In.Null
|
||||
choose (Just value') _ variableType
|
||||
| Just coercedValue <- coerceVariableValue variableType value'
|
||||
, not (isNonNullInputType variableType) || coercedValue /= Core.Null =
|
||||
, not (isNonNullInputType variableType) || coercedValue /= In.Null =
|
||||
Just coercedValue
|
||||
choose _ _ _ = Nothing
|
||||
|
||||
constValue :: Full.ConstValue -> Core.Value
|
||||
constValue (Full.ConstInt i) = Core.Int i
|
||||
constValue (Full.ConstFloat f) = Core.Float f
|
||||
constValue (Full.ConstString x) = Core.String x
|
||||
constValue (Full.ConstBoolean b) = Core.Boolean b
|
||||
constValue Full.ConstNull = Core.Null
|
||||
constValue (Full.ConstEnum e) = Core.Enum e
|
||||
constValue (Full.ConstList l) = Core.List $ constValue <$> l
|
||||
constValue :: Full.ConstValue -> In.Value
|
||||
constValue (Full.ConstInt i) = In.Int i
|
||||
constValue (Full.ConstFloat f) = In.Float f
|
||||
constValue (Full.ConstString x) = In.String x
|
||||
constValue (Full.ConstBoolean b) = In.Boolean b
|
||||
constValue Full.ConstNull = In.Null
|
||||
constValue (Full.ConstEnum e) = In.Enum e
|
||||
constValue (Full.ConstList l) = In.List $ constValue <$> l
|
||||
constValue (Full.ConstObject o) =
|
||||
Core.Object $ HashMap.fromList $ constObjectField <$> o
|
||||
In.Object $ HashMap.fromList $ constObjectField <$> o
|
||||
where
|
||||
constObjectField (Full.ObjectField key value') = (key, constValue value')
|
||||
|
||||
@ -294,19 +295,19 @@ arguments = fmap Core.Arguments . foldM go HashMap.empty
|
||||
substitutedValue <- value value'
|
||||
return $ HashMap.insert name substitutedValue arguments'
|
||||
|
||||
value :: Full.Value -> TransformT Core.Value
|
||||
value :: Full.Value -> TransformT In.Value
|
||||
value (Full.Variable name) =
|
||||
gets $ fromMaybe Core.Null . HashMap.lookup name . variableValues
|
||||
value (Full.Int i) = pure $ Core.Int i
|
||||
value (Full.Float f) = pure $ Core.Float f
|
||||
value (Full.String x) = pure $ Core.String x
|
||||
value (Full.Boolean b) = pure $ Core.Boolean b
|
||||
value Full.Null = pure Core.Null
|
||||
value (Full.Enum e) = pure $ Core.Enum e
|
||||
gets $ fromMaybe In.Null . HashMap.lookup name . variableValues
|
||||
value (Full.Int i) = pure $ In.Int i
|
||||
value (Full.Float f) = pure $ In.Float f
|
||||
value (Full.String x) = pure $ In.String x
|
||||
value (Full.Boolean b) = pure $ In.Boolean b
|
||||
value Full.Null = pure In.Null
|
||||
value (Full.Enum e) = pure $ In.Enum e
|
||||
value (Full.List l) =
|
||||
Core.List <$> traverse value l
|
||||
In.List <$> traverse value l
|
||||
value (Full.Object o) =
|
||||
Core.Object . HashMap.fromList <$> traverse objectField o
|
||||
In.Object . HashMap.fromList <$> traverse objectField o
|
||||
|
||||
objectField :: Full.ObjectField Full.Value -> TransformT (Core.Name, Core.Value)
|
||||
objectField :: Full.ObjectField Full.Value -> TransformT (Core.Name, In.Value)
|
||||
objectField (Full.ObjectField name value') = (name,) <$> value value'
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | This module provides a representation of a @GraphQL@ Schema in addition to
|
||||
@ -8,10 +9,6 @@ module Language.GraphQL.Schema
|
||||
, object
|
||||
, resolve
|
||||
, resolversToMap
|
||||
, wrappedObject
|
||||
-- * AST Reexports
|
||||
, Field
|
||||
, Value(..)
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
@ -28,38 +25,35 @@ 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
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
|
||||
-- | 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 (Definition.FieldResolver m)
|
||||
--
|
||||
-- Resolving a field can result in a leaf value or an object, which is
|
||||
-- represented as a list of nested resolvers, used to resolve the fields of that
|
||||
-- object.
|
||||
data Resolver m = Resolver Name (ActionT m (Out.Value m))
|
||||
|
||||
-- | Converts resolvers to a map.
|
||||
resolversToMap :: (Foldable f, Functor f)
|
||||
=> f (Resolver m)
|
||||
-> HashMap Text (Definition.FieldResolver m)
|
||||
=> forall m
|
||||
. f (Resolver m)
|
||||
-> HashMap Text (ActionT m (Out.Value m))
|
||||
resolversToMap = HashMap.fromList . toList . fmap toKV
|
||||
where
|
||||
toKV (Resolver name r) = (name, r)
|
||||
|
||||
-- | Contains variables for the query. The key of the map is a variable name,
|
||||
-- and the value is the variable value.
|
||||
type Subs = HashMap Name Value
|
||||
type Subs = HashMap Name In.Value
|
||||
|
||||
-- | Like 'object' but can be null or a list of objects.
|
||||
wrappedObject :: Monad m
|
||||
=> Name
|
||||
-> ActionT m (Type.Wrapping (Definition.FieldResolver m))
|
||||
-> Resolver m
|
||||
wrappedObject name = Resolver name . Definition.NestingResolver
|
||||
|
||||
-- | Create a new 'Resolver' with the given 'Name' from the given 'Resolver's.
|
||||
object :: Monad m
|
||||
=> [Resolver m]
|
||||
-> Type.Wrapping (Definition.FieldResolver m)
|
||||
object = Type.O . resolversToMap
|
||||
-- | Create a new 'Resolver' with the given 'Name' from the given
|
||||
-- Resolver's.
|
||||
object :: Monad m => [Resolver m] -> Out.Value m
|
||||
object = Out.Object . resolversToMap
|
||||
|
||||
resolveFieldValue :: Monad m => Field -> ActionT m a -> m (Either Text a)
|
||||
resolveFieldValue field@(Field _ _ args _) =
|
||||
@ -69,26 +63,25 @@ resolveFieldValue field@(Field _ _ args _) =
|
||||
|
||||
withField :: Monad m
|
||||
=> Field
|
||||
-> Definition.FieldResolver m
|
||||
-> ActionT m (Out.Value 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 (Definition.NestingResolver resolver) = do
|
||||
withField field resolver = do
|
||||
answer <- lift $ resolveFieldValue field resolver
|
||||
case answer of
|
||||
Right result -> HashMap.singleton (aliasOrName field) <$> toJSON field result
|
||||
Right result -> HashMap.singleton (aliasOrName field)
|
||||
<$> toJSON field result
|
||||
Left errorMessage -> errmsg field errorMessage
|
||||
|
||||
toJSON :: Monad m => Field -> Type.Wrapping (Definition.FieldResolver m) -> CollectErrsT m Aeson.Value
|
||||
toJSON _ Type.Null = pure Aeson.Null
|
||||
toJSON _ (Type.I i) = pure $ Aeson.toJSON i
|
||||
toJSON _ (Type.B i) = pure $ Aeson.toJSON i
|
||||
toJSON _ (Type.F i) = pure $ Aeson.toJSON i
|
||||
toJSON _ (Type.E i) = pure $ Aeson.toJSON i
|
||||
toJSON _ (Type.S i) = pure $ Aeson.toJSON i
|
||||
toJSON field (Type.List list) = Aeson.toJSON <$> traverse (toJSON field) list
|
||||
toJSON (Field _ _ _ seqSelection) (Type.O map') = map' `resolve` seqSelection
|
||||
toJSON :: Monad m => Field -> Out.Value m -> CollectErrsT m Aeson.Value
|
||||
toJSON _ Out.Null = pure Aeson.Null
|
||||
toJSON _ (Out.Int integer) = pure $ Aeson.toJSON integer
|
||||
toJSON _ (Out.Boolean boolean) = pure $ Aeson.Bool boolean
|
||||
toJSON _ (Out.Float float) = pure $ Aeson.toJSON float
|
||||
toJSON _ (Out.Enum enum) = pure $ Aeson.String enum
|
||||
toJSON _ (Out.String string) = pure $ Aeson.String string
|
||||
toJSON field (Out.List list) = Aeson.toJSON <$> traverse (toJSON field) list
|
||||
toJSON (Field _ _ _ seqSelection) (Out.Object map') =
|
||||
map' `resolve` seqSelection
|
||||
|
||||
errmsg :: Monad m => Field -> Text -> CollectErrsT m (HashMap Text Aeson.Value)
|
||||
errmsg field errorMessage = do
|
||||
@ -99,7 +92,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 (Definition.FieldResolver m)
|
||||
=> HashMap Text (ActionT m (Out.Value m))
|
||||
-> Seq Selection
|
||||
-> CollectErrsT m Aeson.Value
|
||||
resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers
|
||||
@ -109,17 +102,11 @@ 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 (Definition.ValueResolver resolver) <- lookupResolver "__typename" = do
|
||||
let fakeField = Field Nothing "__typename" mempty mempty
|
||||
that <- lift $ resolveFieldValue fakeField resolver
|
||||
if Right (Aeson.String typeCondition) == that
|
||||
then fmap fold . traverse tryResolvers $ selections'
|
||||
else pure mempty
|
||||
| Just (Definition.NestingResolver resolver) <- lookupResolver "__typename" = do
|
||||
| Just resolver <- lookupResolver "__typename" = do
|
||||
let fakeField = Field Nothing "__typename" mempty mempty
|
||||
that <- lift $ resolveFieldValue fakeField resolver
|
||||
case that of
|
||||
Right (Type.S typeCondition')
|
||||
Right (Out.String typeCondition')
|
||||
| typeCondition' == typeCondition ->
|
||||
fmap fold . traverse tryResolvers $ selections'
|
||||
_ -> pure mempty
|
||||
|
||||
@ -15,6 +15,7 @@ import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST.Core
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import Prelude hiding (lookup)
|
||||
|
||||
-- | Resolution context holds resolver arguments.
|
||||
@ -55,11 +56,11 @@ instance Monad m => MonadPlus (ActionT m) where
|
||||
mplus = (<|>)
|
||||
|
||||
-- | Retrieves an argument by its name. If the argument with this name couldn't
|
||||
-- be found, returns 'Value.Null' (i.e. the argument is assumed to
|
||||
-- be found, returns 'In.Null' (i.e. the argument is assumed to
|
||||
-- be optional then).
|
||||
argument :: Monad m => Name -> ActionT m Value
|
||||
argument :: Monad m => Name -> ActionT m In.Value
|
||||
argument argumentName = do
|
||||
argumentValue <- ActionT $ lift $ asks $ lookup . arguments
|
||||
pure $ fromMaybe Null argumentValue
|
||||
pure $ fromMaybe In.Null argumentValue
|
||||
where
|
||||
lookup (Arguments argumentMap) = HashMap.lookup argumentName argumentMap
|
||||
|
||||
@ -1,63 +0,0 @@
|
||||
-- | Definitions for @GraphQL@ input types.
|
||||
module Language.GraphQL.Type
|
||||
( Wrapping(..)
|
||||
) where
|
||||
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
|
||||
-- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
|
||||
-- type can wrap other wrapping or named types. Wrapping types are lists and
|
||||
-- Non-Null types (named types are nullable by default).
|
||||
--
|
||||
-- This 'Wrapping' type doesn\'t reflect this distinction exactly but it is
|
||||
-- used in the resolvers to take into account that the returned value can be
|
||||
-- nullable or an (arbitrary nested) list.
|
||||
data Wrapping a
|
||||
= List [Wrapping a] -- ^ Arbitrary nested list
|
||||
-- | Named a -- ^ Named type without further wrapping
|
||||
| Null -- ^ Null
|
||||
| O (HashMap Name a)
|
||||
| I Int
|
||||
| B Bool
|
||||
| F Float
|
||||
| E Text
|
||||
| S Text
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Functor Wrapping where
|
||||
fmap f (List list) = List $ fmap (fmap f) list
|
||||
fmap f (O map') = O $ f <$> map'
|
||||
fmap _ Null = Null
|
||||
fmap _ (I i) = I i
|
||||
fmap _ (B i) = B i
|
||||
fmap _ (F i) = F i
|
||||
fmap _ (E i) = E i
|
||||
fmap _ (S i) = S i
|
||||
|
||||
{-instance Foldable Wrapping where
|
||||
foldr f acc (List list) = foldr (flip $ foldr f) acc list
|
||||
foldr f acc (O map') = foldr f acc map'
|
||||
foldr _ acc _ = acc -}
|
||||
|
||||
{-instance Traversable Wrapping where
|
||||
traverse f (List list) = List <$> traverse (traverse f) list
|
||||
traverse f (Named named) = Named <$> f named
|
||||
traverse _ Null = pure Null
|
||||
traverse f (O map') = O <$> traverse f map'-}
|
||||
|
||||
{-instance Applicative Wrapping where
|
||||
pure = Named
|
||||
Null <*> _ = Null
|
||||
_ <*> Null = Null
|
||||
(Named f) <*> (Named x) = Named $ f x
|
||||
(List fs) <*> (List xs) = List $ (<*>) <$> fs <*> xs
|
||||
(Named f) <*> list = f <$> list
|
||||
(List fs) <*> named = List $ (<*> named) <$> fs
|
||||
|
||||
instance Monad Wrapping where
|
||||
return = pure
|
||||
Null >>= _ = Null
|
||||
(Named x) >>= f = f x
|
||||
(List xs) >>= f = List $ fmap (>>= f) xs-}
|
||||
@ -8,7 +8,6 @@ module Language.GraphQL.Type.Definition
|
||||
( Argument(..)
|
||||
, EnumType(..)
|
||||
, Field(..)
|
||||
, FieldResolver(..)
|
||||
, InputField(..)
|
||||
, InputObjectType(..)
|
||||
, InputType(..)
|
||||
@ -31,13 +30,13 @@ module Language.GraphQL.Type.Definition
|
||||
, string
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Data.Set (Set)
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST.Core (Name, Value)
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
import Language.GraphQL.Trans
|
||||
import qualified Language.GraphQL.Type as Type
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Prelude hiding (id)
|
||||
|
||||
-- | Object type definition.
|
||||
@ -51,17 +50,10 @@ data Field m = Field
|
||||
(Maybe Text) -- ^ Description.
|
||||
(OutputType m) -- ^ Field type.
|
||||
(HashMap Name Argument) -- ^ Arguments.
|
||||
(FieldResolver m) -- ^ Resolver.
|
||||
|
||||
-- | Resolving a field can result in a leaf value or an object, which is
|
||||
-- represented as a list of nested resolvers, used to resolve the fields of that
|
||||
-- object.
|
||||
data FieldResolver m
|
||||
= ValueResolver (ActionT m Aeson.Value)
|
||||
| NestingResolver (ActionT m (Type.Wrapping (FieldResolver m)))
|
||||
(ActionT m (Out.Value m)) -- ^ Resolver.
|
||||
|
||||
-- | Field argument definition.
|
||||
data Argument = Argument (Maybe Text) InputType (Maybe Value)
|
||||
data Argument = Argument (Maybe Text) InputType (Maybe In.Value)
|
||||
|
||||
-- | Scalar type definition.
|
||||
--
|
||||
@ -77,7 +69,7 @@ data ScalarType = ScalarType Name (Maybe Text)
|
||||
data EnumType = EnumType Name (Maybe Text) (Set Text)
|
||||
|
||||
-- | Single field of an 'InputObjectType'.
|
||||
data InputField = InputField (Maybe Text) InputType (Maybe Value)
|
||||
data InputField = InputField (Maybe Text) InputType (Maybe In.Value)
|
||||
|
||||
-- | Input object type definition.
|
||||
--
|
||||
|
||||
@ -6,6 +6,7 @@ module Language.GraphQL.Type.Directive
|
||||
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Language.GraphQL.AST.Core
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
|
||||
-- | Directive processing status.
|
||||
data Status
|
||||
@ -36,7 +37,7 @@ skip = handle skip'
|
||||
where
|
||||
skip' directive'@(Directive "skip" (Arguments arguments)) =
|
||||
case HashMap.lookup "if" arguments of
|
||||
(Just (Boolean True)) -> Skip
|
||||
(Just (In.Boolean True)) -> Skip
|
||||
_ -> Include directive'
|
||||
skip' directive' = Continue directive'
|
||||
|
||||
@ -45,6 +46,6 @@ include = handle include'
|
||||
where
|
||||
include' directive'@(Directive "include" (Arguments arguments)) =
|
||||
case HashMap.lookup "if" arguments of
|
||||
(Just (Boolean True)) -> Include directive'
|
||||
(Just (In.Boolean True)) -> Include directive'
|
||||
_ -> Skip
|
||||
include' directive' = Continue directive'
|
||||
|
||||
26
src/Language/GraphQL/Type/In.hs
Normal file
26
src/Language/GraphQL/Type/In.hs
Normal file
@ -0,0 +1,26 @@
|
||||
-- | This module is intended to be imported qualified, to avoid name clashes
|
||||
-- with 'Language.GraphQL.Type.Out'.
|
||||
module Language.GraphQL.Type.In
|
||||
( Value(..)
|
||||
) where
|
||||
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Data.Int (Int32)
|
||||
import Data.String (IsString(..))
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
|
||||
-- | Represents accordingly typed GraphQL values.
|
||||
data Value
|
||||
= Int Int32
|
||||
| Float Double -- ^ GraphQL Float is double precision
|
||||
| String Text
|
||||
| Boolean Bool
|
||||
| Null
|
||||
| Enum Name
|
||||
| List [Value]
|
||||
| Object (HashMap Name Value)
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance IsString Value where
|
||||
fromString = String . fromString
|
||||
58
src/Language/GraphQL/Type/Out.hs
Normal file
58
src/Language/GraphQL/Type/Out.hs
Normal file
@ -0,0 +1,58 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | This module is intended to be imported qualified, to avoid name clashes
|
||||
-- with 'Language.GraphQL.Type.In'.
|
||||
module Language.GraphQL.Type.Out
|
||||
( Value(..)
|
||||
) where
|
||||
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Int (Int32)
|
||||
import Data.String (IsString(..))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
import Language.GraphQL.Trans
|
||||
|
||||
-- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
|
||||
-- type can wrap other wrapping or named types. Wrapping types are lists and
|
||||
-- Non-Null types (named types are nullable by default).
|
||||
--
|
||||
-- This 'Value' type doesn\'t reflect this distinction exactly but it is used
|
||||
-- in the resolvers to take into account that the returned value can be nullable
|
||||
-- or an (arbitrary nested) list.
|
||||
data Value m
|
||||
= Int Int32
|
||||
| Float Double
|
||||
| String Text
|
||||
| Boolean Bool
|
||||
| Null
|
||||
| Enum Name
|
||||
| List [Value m] -- ^ Arbitrary nested list.
|
||||
| Object (HashMap Name (ActionT m (Value m)))
|
||||
|
||||
instance IsString (Value m) where
|
||||
fromString = String . fromString
|
||||
|
||||
instance Show (Value m) where
|
||||
show (Int integer) = "Int " ++ show integer
|
||||
show (Float float) = "Float " ++ show float
|
||||
show (String text) = Text.unpack $ "String " <> text
|
||||
show (Boolean True) = "Boolean True"
|
||||
show (Boolean False) = "Boolean False"
|
||||
show Null = "Null"
|
||||
show (Enum enum) = Text.unpack $ "Enum " <> enum
|
||||
show (List list) = show list
|
||||
show (Object object) = Text.unpack
|
||||
$ "Object [" <> Text.intercalate ", " (HashMap.keys object) <> "]"
|
||||
|
||||
instance Eq (Value m) where
|
||||
(Int this) == (Int that) = this == that
|
||||
(Float this) == (Float that) = this == that
|
||||
(String this) == (String that) = this == that
|
||||
(Boolean this) == (Boolean that) = this == that
|
||||
(Enum this) == (Enum that) = this == that
|
||||
(List this) == (List that) = this == that
|
||||
(Object this) == (Object that) = HashMap.keys this == HashMap.keys that
|
||||
_ == _ = False
|
||||
@ -15,6 +15,7 @@ import Language.GraphQL.AST.Core
|
||||
import Language.GraphQL.Execute.Coerce
|
||||
import Language.GraphQL.Schema
|
||||
import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import Prelude hiding (id)
|
||||
import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
|
||||
|
||||
@ -22,12 +23,12 @@ direction :: EnumType
|
||||
direction = EnumType "Direction" Nothing
|
||||
$ Set.fromList ["NORTH", "EAST", "SOUTH", "WEST"]
|
||||
|
||||
coerceInputLiteral :: InputType -> Value -> Maybe Subs
|
||||
coerceInputLiteral :: InputType -> In.Value -> Maybe Subs
|
||||
coerceInputLiteral input value = coerceInputLiterals
|
||||
(HashMap.singleton "variableName" input)
|
||||
(HashMap.singleton "variableName" value)
|
||||
|
||||
lookupActual :: Maybe (HashMap Name Value) -> Maybe Value
|
||||
lookupActual :: Maybe (HashMap Name In.Value) -> Maybe In.Value
|
||||
lookupActual = (HashMap.lookup "variableName" =<<)
|
||||
|
||||
singletonInputObject :: InputType
|
||||
@ -41,22 +42,22 @@ spec :: Spec
|
||||
spec = do
|
||||
describe "ToGraphQL Aeson" $ do
|
||||
it "coerces strings" $
|
||||
let expected = Just (String "asdf")
|
||||
let expected = Just (In.String "asdf")
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType string) (Aeson.String "asdf")
|
||||
in actual `shouldBe` expected
|
||||
it "coerces non-null strings" $
|
||||
let expected = Just (String "asdf")
|
||||
let expected = Just (In.String "asdf")
|
||||
actual = coerceVariableValue
|
||||
(NonNullScalarInputType string) (Aeson.String "asdf")
|
||||
in actual `shouldBe` expected
|
||||
it "coerces booleans" $
|
||||
let expected = Just (Boolean True)
|
||||
let expected = Just (In.Boolean True)
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType boolean) (Aeson.Bool True)
|
||||
in actual `shouldBe` expected
|
||||
it "coerces zero to an integer" $
|
||||
let expected = Just (Int 0)
|
||||
let expected = Just (In.Int 0)
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType int) (Aeson.Number 0)
|
||||
in actual `shouldBe` expected
|
||||
@ -65,24 +66,24 @@ spec = do
|
||||
(ScalarInputType int) (Aeson.Number $ scientific 14 (-1))
|
||||
in actual `shouldSatisfy` isNothing
|
||||
it "coerces float numbers" $
|
||||
let expected = Just (Float 1.4)
|
||||
let expected = Just (In.Float 1.4)
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType float) (Aeson.Number $ scientific 14 (-1))
|
||||
in actual `shouldBe` expected
|
||||
it "coerces IDs" $
|
||||
let expected = Just (String "1234")
|
||||
let expected = Just (In.String "1234")
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType id) (Aeson.String "1234")
|
||||
in actual `shouldBe` expected
|
||||
it "coerces input objects" $
|
||||
let actual = coerceVariableValue singletonInputObject
|
||||
$ Aeson.object ["field" .= ("asdf" :: Aeson.Value)]
|
||||
expected = Just $ Object $ HashMap.singleton "field" "asdf"
|
||||
expected = Just $ In.Object $ HashMap.singleton "field" "asdf"
|
||||
in actual `shouldBe` expected
|
||||
it "skips the field if it is missing in the variables" $
|
||||
let actual = coerceVariableValue
|
||||
singletonInputObject Aeson.emptyObject
|
||||
expected = Just $ Object HashMap.empty
|
||||
expected = Just $ In.Object HashMap.empty
|
||||
in actual `shouldBe` expected
|
||||
it "fails if input object value contains extra fields" $
|
||||
let actual = coerceVariableValue singletonInputObject
|
||||
@ -94,25 +95,25 @@ spec = do
|
||||
in actual `shouldSatisfy` isNothing
|
||||
it "preserves null" $
|
||||
let actual = coerceVariableValue (ScalarInputType id) Aeson.Null
|
||||
in actual `shouldBe` Just Null
|
||||
in actual `shouldBe` Just In.Null
|
||||
it "preserves list order" $
|
||||
let list = Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"]
|
||||
listType = (ListInputType $ ScalarInputType string)
|
||||
actual = coerceVariableValue listType list
|
||||
expected = Just $ List [String "asdf", String "qwer"]
|
||||
expected = Just $ In.List [In.String "asdf", In.String "qwer"]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
describe "coerceInputLiterals" $ do
|
||||
it "coerces enums" $
|
||||
let expected = Just (Enum "NORTH")
|
||||
let expected = Just (In.Enum "NORTH")
|
||||
actual = coerceInputLiteral
|
||||
(EnumInputType direction) (Enum "NORTH")
|
||||
(EnumInputType direction) (In.Enum "NORTH")
|
||||
in lookupActual actual `shouldBe` expected
|
||||
it "fails with non-existing enum value" $
|
||||
let actual = coerceInputLiteral
|
||||
(EnumInputType direction) (Enum "NORTH_EAST")
|
||||
(EnumInputType direction) (In.Enum "NORTH_EAST")
|
||||
in actual `shouldSatisfy` isNothing
|
||||
it "coerces integers to IDs" $
|
||||
let expected = Just (String "1234")
|
||||
actual = coerceInputLiteral (ScalarInputType id) (Int 1234)
|
||||
let expected = Just (In.String "1234")
|
||||
actual = coerceInputLiteral (ScalarInputType id) (In.Int 1234)
|
||||
in lookupActual actual `shouldBe` expected
|
||||
|
||||
@ -10,16 +10,15 @@ import qualified Data.Sequence as Sequence
|
||||
import Language.GraphQL.AST.Core
|
||||
import Language.GraphQL.Error
|
||||
import Language.GraphQL.Schema
|
||||
import qualified Language.GraphQL.Type as Type
|
||||
import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "resolve" $
|
||||
it "ignores invalid __typename" $ do
|
||||
let resolver = NestingResolver $ pure $ object
|
||||
[ wrappedObject "field" $ pure $ Type.S "T"
|
||||
let resolver = pure $ object
|
||||
[ Resolver "field" $ pure $ Out.String "T"
|
||||
]
|
||||
schema = HashMap.singleton "__typename" resolver
|
||||
fields = Sequence.singleton
|
||||
|
||||
15
tests/Language/GraphQL/Type/OutSpec.hs
Normal file
15
tests/Language/GraphQL/Type/OutSpec.hs
Normal file
@ -0,0 +1,15 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Language.GraphQL.Type.OutSpec
|
||||
( spec
|
||||
) where
|
||||
|
||||
import Data.Functor.Identity (Identity)
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "Value" $
|
||||
it "supports overloaded strings" $
|
||||
let string = "Goldstaub abblasen." :: (Out.Value Identity)
|
||||
in string `shouldBe` Out.String "Goldstaub abblasen."
|
||||
@ -8,6 +8,7 @@ import Data.Aeson (Value(..), object, (.=))
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Language.GraphQL
|
||||
import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Language.GraphQL.Type.Schema (Schema(..))
|
||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||
import Text.RawString.QQ (r)
|
||||
@ -15,7 +16,7 @@ import Text.RawString.QQ (r)
|
||||
experimentalResolver :: Schema IO
|
||||
experimentalResolver = Schema { query = queryType, mutation = Nothing }
|
||||
where
|
||||
resolver = ValueResolver $ pure $ Number 5
|
||||
resolver = pure $ Out.Int 5
|
||||
queryType = ObjectType "Query" Nothing
|
||||
$ HashMap.singleton "experimentalField"
|
||||
$ Field Nothing (ScalarOutputType int) mempty resolver
|
||||
|
||||
@ -9,7 +9,9 @@ import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
import qualified Language.GraphQL.Type as Type
|
||||
import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Language.GraphQL.Type.Schema
|
||||
import Test.Hspec
|
||||
( Spec
|
||||
, describe
|
||||
@ -17,21 +19,19 @@ import Test.Hspec
|
||||
, shouldBe
|
||||
, shouldNotSatisfy
|
||||
)
|
||||
import Language.GraphQL.Type.Definition
|
||||
import Language.GraphQL.Type.Schema
|
||||
import Text.RawString.QQ (r)
|
||||
|
||||
size :: Schema.Resolver IO
|
||||
size = Schema.wrappedObject "size" $ pure $ Type.S "L"
|
||||
size = Schema.Resolver "size" $ pure $ Out.String "L"
|
||||
|
||||
circumference :: Schema.Resolver IO
|
||||
circumference = Schema.wrappedObject "circumference" $ pure $ Type.I 60
|
||||
circumference = Schema.Resolver "circumference" $ pure $ Out.Int 60
|
||||
|
||||
garment :: Text -> Schema.Resolver IO
|
||||
garment typeName = Schema.wrappedObject "garment"
|
||||
garment typeName = Schema.Resolver "garment"
|
||||
$ pure $ Schema.object
|
||||
[ if typeName == "Hat" then circumference else size
|
||||
, Schema.wrappedObject "__typename" $ pure $ Type.S typeName
|
||||
, Schema.Resolver "__typename" $ pure $ Out.String typeName
|
||||
]
|
||||
|
||||
inlineQuery :: Text
|
||||
@ -107,7 +107,7 @@ spec = do
|
||||
}
|
||||
}
|
||||
}|]
|
||||
resolvers = Schema.wrappedObject "garment"
|
||||
resolvers = Schema.Resolver "garment"
|
||||
$ pure $ Schema.object [circumference, size]
|
||||
|
||||
actual <- graphql (toSchema resolvers) sourceQuery
|
||||
|
||||
@ -11,8 +11,8 @@ import qualified Language.GraphQL.Schema as Schema
|
||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||
import Text.RawString.QQ (r)
|
||||
import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Language.GraphQL.Type.Schema
|
||||
import qualified Language.GraphQL.Type as Type
|
||||
|
||||
hatType :: ObjectType IO
|
||||
hatType = ObjectType "Hat" Nothing
|
||||
@ -20,20 +20,19 @@ hatType = ObjectType "Hat" Nothing
|
||||
$ Field Nothing (ScalarOutputType int) mempty resolve
|
||||
where
|
||||
(Schema.Resolver resolverName resolve) =
|
||||
Schema.wrappedObject "circumference" $ pure $ Type.I 60
|
||||
Schema.Resolver "circumference" $ pure $ Out.Int 60
|
||||
|
||||
schema :: Schema IO
|
||||
schema = Schema
|
||||
(ObjectType "Query" Nothing hatField)
|
||||
(Just $ ObjectType "Mutation" Nothing incrementField)
|
||||
where
|
||||
garment = NestingResolver
|
||||
$ pure $ Schema.object
|
||||
[ Schema.wrappedObject "circumference" $ pure $ Type.I 60
|
||||
garment = pure $ Schema.object
|
||||
[ Schema.Resolver "circumference" $ pure $ Out.Int 60
|
||||
]
|
||||
incrementField = HashMap.singleton "incrementCircumference"
|
||||
$ Field Nothing (ScalarOutputType int) mempty
|
||||
$ NestingResolver $ pure $ Type.I 61
|
||||
$ pure $ Out.Int 61
|
||||
hatField = HashMap.singleton "garment"
|
||||
$ Field Nothing (ObjectOutputType hatType) mempty garment
|
||||
|
||||
|
||||
@ -15,7 +15,8 @@ import Data.Maybe (catMaybes)
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
import Language.GraphQL.Trans
|
||||
import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type as Type
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Language.GraphQL.Type.Schema
|
||||
import Test.StarWars.Data
|
||||
|
||||
@ -30,45 +31,45 @@ schema = Schema { query = queryType, mutation = Nothing }
|
||||
, ("droid", Field Nothing (ScalarOutputType string) mempty droid)
|
||||
]
|
||||
|
||||
hero :: FieldResolver Identity
|
||||
hero = NestingResolver $ do
|
||||
hero :: ActionT Identity (Out.Value Identity)
|
||||
hero = do
|
||||
episode <- argument "episode"
|
||||
pure $ character $ case episode of
|
||||
Schema.Enum "NEWHOPE" -> getHero 4
|
||||
Schema.Enum "EMPIRE" -> getHero 5
|
||||
Schema.Enum "JEDI" -> getHero 6
|
||||
In.Enum "NEWHOPE" -> getHero 4
|
||||
In.Enum "EMPIRE" -> getHero 5
|
||||
In.Enum "JEDI" -> getHero 6
|
||||
_ -> artoo
|
||||
|
||||
human :: FieldResolver Identity
|
||||
human = NestingResolver $ do
|
||||
human :: ActionT Identity (Out.Value Identity)
|
||||
human = do
|
||||
id' <- argument "id"
|
||||
case id' of
|
||||
Schema.String i -> do
|
||||
In.String i -> do
|
||||
humanCharacter <- lift $ return $ getHuman i >>= Just
|
||||
case humanCharacter of
|
||||
Nothing -> pure Type.Null
|
||||
Nothing -> pure Out.Null
|
||||
Just e -> pure $ character e
|
||||
_ -> ActionT $ throwE "Invalid arguments."
|
||||
|
||||
droid :: FieldResolver Identity
|
||||
droid = NestingResolver $ do
|
||||
droid :: ActionT Identity (Out.Value Identity)
|
||||
droid = do
|
||||
id' <- argument "id"
|
||||
case id' of
|
||||
Schema.String i -> getDroid i >>= pure . character
|
||||
In.String i -> getDroid i >>= pure . character
|
||||
_ -> ActionT $ throwE "Invalid arguments."
|
||||
|
||||
character :: Character -> Type.Wrapping (FieldResolver Identity)
|
||||
character :: Character -> Out.Value Identity
|
||||
character char = Schema.object
|
||||
[ Schema.wrappedObject "id" $ pure $ Type.S $ id_ char
|
||||
, Schema.wrappedObject "name" $ pure $ Type.S $ name_ char
|
||||
, Schema.wrappedObject "friends"
|
||||
$ pure
|
||||
$ Type.List
|
||||
$ fmap character
|
||||
$ getFriends char
|
||||
, Schema.wrappedObject "appearsIn" $ pure
|
||||
$ Type.List $ Type.E <$> catMaybes (getEpisode <$> appearsIn char)
|
||||
, Schema.wrappedObject "secretBackstory" $ Type.S <$> secretBackstory char
|
||||
, Schema.wrappedObject "homePlanet" $ pure $ Type.S $ either mempty homePlanet char
|
||||
, Schema.wrappedObject "__typename" $ pure $ Type.S $ typeName char
|
||||
[ Schema.Resolver "id" $ pure $ Out.String $ id_ char
|
||||
, Schema.Resolver "name" $ pure $ Out.String $ name_ char
|
||||
, Schema.Resolver "friends"
|
||||
$ pure $ Out.List $ fmap character $ getFriends char
|
||||
, Schema.Resolver "appearsIn" $ pure
|
||||
$ Out.List $ Out.Enum <$> catMaybes (getEpisode <$> appearsIn char)
|
||||
, Schema.Resolver "secretBackstory" $ Out.String
|
||||
<$> secretBackstory char
|
||||
, Schema.Resolver "homePlanet" $ pure $ Out.String
|
||||
$ either mempty homePlanet char
|
||||
, Schema.Resolver "__typename" $ pure $ Out.String
|
||||
$ typeName char
|
||||
]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user