forked from OSS/graphql
parent
e8c54810f8
commit
882276a845
@ -61,7 +61,7 @@ Next we define our query.
|
||||
To run the query, we call the `graphql` with the schema and the query.
|
||||
|
||||
> main1 :: IO ()
|
||||
> main1 = putStrLn =<< encode <$> graphql schema1 query1
|
||||
> main1 = graphql schema1 query1 >>= putStrLn . encode
|
||||
|
||||
This runs the query by fetching the one field defined,
|
||||
returning
|
||||
@ -99,7 +99,7 @@ Next we define our query.
|
||||
> query2 = "{ time }"
|
||||
>
|
||||
> main2 :: IO ()
|
||||
> main2 = putStrLn =<< encode <$> graphql schema2 query2
|
||||
> main2 = graphql schema2 query2 >>= putStrLn . encode
|
||||
|
||||
This runs the query, returning the current time
|
||||
|
||||
@ -154,7 +154,7 @@ Now that we have two resolvers, we can define a schema which uses them both.
|
||||
> query3 = "query timeAndHello { time hello }"
|
||||
>
|
||||
> main3 :: IO ()
|
||||
> main3 = putStrLn =<< encode <$> graphql schema3 query3
|
||||
> main3 = graphql schema3 query3 >>= putStrLn . encode
|
||||
|
||||
This queries for both time and hello, returning
|
||||
|
||||
|
||||
@ -14,7 +14,7 @@ import Language.GraphQL.Execute.Coerce
|
||||
import Language.GraphQL.Execute.Execution
|
||||
import qualified Language.GraphQL.Execute.Transform as Transform
|
||||
import Language.GraphQL.Error
|
||||
import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type.Definition as Definition
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Language.GraphQL.Type.Schema
|
||||
|
||||
@ -68,4 +68,4 @@ executeOperation :: Monad m
|
||||
-> Seq (Transform.Selection m)
|
||||
-> m Aeson.Value
|
||||
executeOperation types' objectType fields =
|
||||
runCollectErrs types' $ executeSelectionSet Null objectType fields
|
||||
runCollectErrs types' $ executeSelectionSet Definition.Null objectType fields
|
||||
|
||||
@ -3,21 +3,28 @@
|
||||
|
||||
-- | Types and functions used for input and result coercion.
|
||||
module Language.GraphQL.Execute.Coerce
|
||||
( VariableValue(..)
|
||||
( Output(..)
|
||||
, Serialize(..)
|
||||
, VariableValue(..)
|
||||
, coerceInputLiteral
|
||||
, matchFieldValues
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Int (Int32)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Map.Strict (Map)
|
||||
import Data.String (IsString(..))
|
||||
import Data.Text (Text)
|
||||
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 (Name)
|
||||
import qualified Language.GraphQL.Type as Type
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
|
||||
-- | Since variables are passed separately from the query, in an independent
|
||||
-- format, they should be first coerced to the internal representation used by
|
||||
@ -46,26 +53,26 @@ class VariableValue a where
|
||||
coerceVariableValue
|
||||
:: In.Type -- ^ Expected type (variable type given in the query).
|
||||
-> a -- ^ Variable value being coerced.
|
||||
-> Maybe Value -- ^ Coerced value on success, 'Nothing' otherwise.
|
||||
-> Maybe Type.Value -- ^ Coerced value on success, 'Nothing' otherwise.
|
||||
|
||||
instance VariableValue Aeson.Value where
|
||||
coerceVariableValue _ Aeson.Null = Just Null
|
||||
coerceVariableValue _ Aeson.Null = Just Type.Null
|
||||
coerceVariableValue (In.ScalarBaseType scalarType) value
|
||||
| (Aeson.String stringValue) <- value = Just $ String stringValue
|
||||
| (Aeson.Bool booleanValue) <- value = Just $ Boolean booleanValue
|
||||
| (Aeson.String stringValue) <- value = Just $ Type.String stringValue
|
||||
| (Aeson.Bool booleanValue) <- value = Just $ Type.Boolean booleanValue
|
||||
| (Aeson.Number numberValue) <- value
|
||||
, (ScalarType "Float" _) <- scalarType =
|
||||
Just $ Float $ toRealFloat numberValue
|
||||
, (Type.ScalarType "Float" _) <- scalarType =
|
||||
Just $ Type.Float $ toRealFloat numberValue
|
||||
| (Aeson.Number numberValue) <- value = -- ID or Int
|
||||
Int <$> toBoundedInteger numberValue
|
||||
Type.Int <$> toBoundedInteger numberValue
|
||||
coerceVariableValue (In.EnumBaseType _) (Aeson.String stringValue) =
|
||||
Just $ Enum stringValue
|
||||
Just $ Type.Enum stringValue
|
||||
coerceVariableValue (In.InputObjectBaseType objectType) value
|
||||
| (Aeson.Object objectValue) <- value = do
|
||||
let (In.InputObjectType _ _ inputFields) = objectType
|
||||
(newObjectValue, resultMap) <- foldWithKey objectValue inputFields
|
||||
if HashMap.null newObjectValue
|
||||
then Just $ Object resultMap
|
||||
then Just $ Type.Object resultMap
|
||||
else Nothing
|
||||
where
|
||||
foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues'
|
||||
@ -81,8 +88,8 @@ instance VariableValue Aeson.Value where
|
||||
pure (newObjectValue, insert coerced)
|
||||
Nothing -> Just (objectValue, resultMap)
|
||||
coerceVariableValue (In.ListBaseType listType) value
|
||||
| (Aeson.Array arrayValue) <- value = List
|
||||
<$> foldr foldVector (Just []) arrayValue
|
||||
| (Aeson.Array arrayValue) <- value =
|
||||
Type.List <$> foldr foldVector (Just []) arrayValue
|
||||
| otherwise = coerceVariableValue listType value
|
||||
where
|
||||
foldVector _ Nothing = Nothing
|
||||
@ -97,13 +104,13 @@ instance VariableValue Aeson.Value where
|
||||
-- result map. Otherwise it fails with 'Nothing' if the Input Type is a
|
||||
-- Non-Nullable type, or returns the unchanged, original map.
|
||||
matchFieldValues :: forall a
|
||||
. (In.Type -> a -> Maybe Value)
|
||||
. (In.Type -> a -> Maybe Type.Value)
|
||||
-> HashMap Name a
|
||||
-> Name
|
||||
-> In.Type
|
||||
-> Maybe Value
|
||||
-> Maybe (HashMap Name Value)
|
||||
-> Maybe (HashMap Name Value)
|
||||
-> Maybe Type.Value
|
||||
-> Maybe (HashMap Name Type.Value)
|
||||
-> Maybe (HashMap Name Type.Value)
|
||||
matchFieldValues coerce values' fieldName type' defaultValue resultMap =
|
||||
case HashMap.lookup fieldName values' of
|
||||
Just variableValue -> coerceRuntimeValue $ coerce type' variableValue
|
||||
@ -114,44 +121,99 @@ matchFieldValues coerce values' fieldName type' defaultValue resultMap =
|
||||
, In.isNonNullType type' -> Nothing
|
||||
| otherwise -> resultMap
|
||||
where
|
||||
coerceRuntimeValue (Just Null)
|
||||
coerceRuntimeValue (Just Type.Null)
|
||||
| In.isNonNullType type' = Nothing
|
||||
coerceRuntimeValue coercedValue =
|
||||
HashMap.insert fieldName <$> coercedValue <*> resultMap
|
||||
|
||||
-- | Coerces operation arguments according to the input coercion rules for the
|
||||
-- corresponding types.
|
||||
coerceInputLiteral :: In.Type -> Value -> Maybe Value
|
||||
coerceInputLiteral :: In.Type -> Type.Value -> Maybe Type.Value
|
||||
coerceInputLiteral (In.ScalarBaseType 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
|
||||
, (ScalarType "Float" _) <- type' =
|
||||
Just $ Float $ fromIntegral intValue
|
||||
| (String stringValue) <- value
|
||||
, (ScalarType "ID" _) <- type' = Just $ String stringValue
|
||||
| (Int intValue) <- value
|
||||
, (ScalarType "ID" _) <- type' = Just $ decimal intValue
|
||||
| (Type.String stringValue) <- value
|
||||
, (Type.ScalarType "String" _) <- type' = Just $ Type.String stringValue
|
||||
| (Type.Boolean booleanValue) <- value
|
||||
, (Type.ScalarType "Boolean" _) <- type' = Just $ Type.Boolean booleanValue
|
||||
| (Type.Int intValue) <- value
|
||||
, (Type.ScalarType "Int" _) <- type' = Just $ Type.Int intValue
|
||||
| (Type.Float floatValue) <- value
|
||||
, (Type.ScalarType "Float" _) <- type' = Just $ Type.Float floatValue
|
||||
| (Type.Int intValue) <- value
|
||||
, (Type.ScalarType "Float" _) <- type' =
|
||||
Just $ Type.Float $ fromIntegral intValue
|
||||
| (Type.String stringValue) <- value
|
||||
, (Type.ScalarType "ID" _) <- type' = Just $ Type.String stringValue
|
||||
| (Type.Int intValue) <- value
|
||||
, (Type.ScalarType "ID" _) <- type' = Just $ decimal intValue
|
||||
where
|
||||
decimal = String
|
||||
decimal = Type.String
|
||||
. Text.Lazy.toStrict
|
||||
. Text.Builder.toLazyText
|
||||
. Text.Builder.decimal
|
||||
coerceInputLiteral (In.EnumBaseType type') (Enum enumValue)
|
||||
| member enumValue type' = Just $ Enum enumValue
|
||||
coerceInputLiteral (In.EnumBaseType type') (Type.Enum enumValue)
|
||||
| member enumValue type' = Just $ Type.Enum enumValue
|
||||
where
|
||||
member value (EnumType _ _ members) = HashMap.member value members
|
||||
coerceInputLiteral (In.InputObjectBaseType type') (Object values) =
|
||||
member value (Type.EnumType _ _ members) = HashMap.member value members
|
||||
coerceInputLiteral (In.InputObjectBaseType type') (Type.Object values) =
|
||||
let (In.InputObjectType _ _ inputFields) = type'
|
||||
in Object
|
||||
in Type.Object
|
||||
<$> HashMap.foldrWithKey (matchFieldValues' values) (Just HashMap.empty) inputFields
|
||||
where
|
||||
matchFieldValues' values' fieldName (In.InputField _ inputFieldType defaultValue) =
|
||||
matchFieldValues coerceInputLiteral values' fieldName inputFieldType defaultValue
|
||||
coerceInputLiteral _ _ = Nothing
|
||||
|
||||
-- | 'Serialize' describes how a @GraphQL@ value should be serialized.
|
||||
class Serialize a where
|
||||
-- | Serializes a @GraphQL@ value according to the given serialization
|
||||
-- format.
|
||||
--
|
||||
-- Type infomration is given as a hint, e.g. if you need to know what type
|
||||
-- is being serialized to serialize it properly. Don't do any validation for
|
||||
-- @GraphQL@ built-in types here.
|
||||
--
|
||||
-- If the value cannot be serialized without losing information, return
|
||||
-- 'Nothing' — it will cause a field error.
|
||||
serialize :: forall m
|
||||
. Out.Type m -- ^ Expected output type.
|
||||
-> Output a -- ^ The value to be serialized.
|
||||
-> Maybe a -- ^ Serialized value on success or 'Nothing'.
|
||||
-- | __null__ representation in the given serialization format.
|
||||
null :: a
|
||||
|
||||
-- | Intermediate type used to serialize a @GraphQL@ value.
|
||||
--
|
||||
-- The serialization is done during the execution, and 'Output' contains
|
||||
-- already serialized data (in 'List' and 'Object') as well as the new layer
|
||||
-- that has to be serialized in the current step. So 'Output' is parameterized
|
||||
-- by the serialization format.
|
||||
data Output a
|
||||
= Int Int32
|
||||
| Float Double
|
||||
| String Text
|
||||
| Boolean Bool
|
||||
| Enum Name
|
||||
| List [a]
|
||||
| Object (Map Name a)
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance forall a. IsString (Output a) where
|
||||
fromString = String . fromString
|
||||
|
||||
instance Serialize Aeson.Value where
|
||||
serialize (Out.ScalarBaseType scalarType) value
|
||||
| Type.ScalarType "Int" _ <- scalarType
|
||||
, Int int <- value = Just $ Aeson.toJSON int
|
||||
| Type.ScalarType "Float" _ <- scalarType
|
||||
, Float float <- value = Just $ Aeson.toJSON float
|
||||
| Type.ScalarType "String" _ <- scalarType
|
||||
, String string <- value = Just $ Aeson.String string
|
||||
| Type.ScalarType "ID" _ <- scalarType
|
||||
, String string <- value = Just $ Aeson.String string
|
||||
| Type.ScalarType "Boolean" _ <- scalarType
|
||||
, Boolean boolean <- value = Just $ Aeson.Bool boolean
|
||||
serialize _ (Enum enum) = Just $ Aeson.String enum
|
||||
serialize _ (List list) = Just $ Aeson.toJSON list
|
||||
serialize _ (Object object) = Just $ Aeson.toJSON object
|
||||
serialize _ _ = Nothing
|
||||
null = Aeson.Null
|
||||
|
||||
@ -1,11 +1,11 @@
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module Language.GraphQL.Execute.Execution
|
||||
( executeSelectionSet
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Control.Monad.Trans.Except (runExceptT)
|
||||
import Control.Monad.Trans.Reader (runReaderT)
|
||||
@ -22,16 +22,17 @@ import Language.GraphQL.AST (Name)
|
||||
import Language.GraphQL.AST.Core
|
||||
import Language.GraphQL.Error
|
||||
import Language.GraphQL.Execute.Coerce
|
||||
import Language.GraphQL.Execute.Transform
|
||||
import qualified Language.GraphQL.Execute.Transform as Transform
|
||||
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
|
||||
import Language.GraphQL.Type.Schema
|
||||
import Prelude hiding (null)
|
||||
|
||||
resolveFieldValue :: Monad m
|
||||
=> Definition.Value
|
||||
-> Definition.Subs
|
||||
=> Type.Value
|
||||
-> Type.Subs
|
||||
-> ActionT m a
|
||||
-> m (Either Text a)
|
||||
resolveFieldValue result args =
|
||||
@ -41,29 +42,29 @@ resolveFieldValue result args =
|
||||
|
||||
collectFields :: Monad m
|
||||
=> Out.ObjectType m
|
||||
-> Seq (Selection m)
|
||||
-> Map Name (NonEmpty (Field m))
|
||||
-> Seq (Transform.Selection m)
|
||||
-> Map Name (NonEmpty (Transform.Field m))
|
||||
collectFields objectType = foldl forEach Map.empty
|
||||
where
|
||||
forEach groupedFields (SelectionField field) =
|
||||
forEach groupedFields (Transform.SelectionField field) =
|
||||
let responseKey = aliasOrName field
|
||||
in Map.insertWith (<>) responseKey (field :| []) groupedFields
|
||||
forEach groupedFields (SelectionFragment selectionFragment)
|
||||
| Fragment fragmentType fragmentSelectionSet <- selectionFragment
|
||||
forEach groupedFields (Transform.SelectionFragment selectionFragment)
|
||||
| Transform.Fragment fragmentType fragmentSelectionSet <- selectionFragment
|
||||
, doesFragmentTypeApply fragmentType objectType =
|
||||
let fragmentGroupedFieldSet = collectFields objectType fragmentSelectionSet
|
||||
in Map.unionWith (<>) groupedFields fragmentGroupedFieldSet
|
||||
| otherwise = groupedFields
|
||||
|
||||
aliasOrName :: forall m. Field m -> Name
|
||||
aliasOrName (Field alias name _ _) = fromMaybe name alias
|
||||
aliasOrName :: forall m. Transform.Field m -> Name
|
||||
aliasOrName (Transform.Field alias name _ _) = fromMaybe name alias
|
||||
|
||||
resolveAbstractType :: Monad m
|
||||
=> AbstractType m
|
||||
-> HashMap Name Definition.Value
|
||||
-> Type.Subs
|
||||
-> CollectErrsT m (Maybe (Out.ObjectType m))
|
||||
resolveAbstractType abstractType values'
|
||||
| Just (Definition.String typeName) <- HashMap.lookup "__typename" values' = do
|
||||
| Just (Type.String typeName) <- HashMap.lookup "__typename" values' = do
|
||||
types' <- gets types
|
||||
case HashMap.lookup typeName types' of
|
||||
Just (ObjectType objectType) ->
|
||||
@ -97,14 +98,14 @@ instanceOf objectType (AbstractUnionType unionType) =
|
||||
where
|
||||
go unionMemberType acc = acc || objectType == unionMemberType
|
||||
|
||||
executeField :: Monad m
|
||||
executeField :: (Monad m, Serialize a)
|
||||
=> Out.Resolver m
|
||||
-> Definition.Value
|
||||
-> NonEmpty (Field m)
|
||||
-> CollectErrsT m Aeson.Value
|
||||
-> Type.Value
|
||||
-> NonEmpty (Transform.Field m)
|
||||
-> CollectErrsT m a
|
||||
executeField (Out.Resolver fieldDefinition resolver) prev fields = do
|
||||
let Out.Field _ fieldType argumentDefinitions = fieldDefinition
|
||||
let (Field _ _ arguments' _ :| []) = fields
|
||||
let (Transform.Field _ _ arguments' _ :| []) = fields
|
||||
case coerceArgumentValues argumentDefinitions arguments' of
|
||||
Nothing -> errmsg "Argument coercing failed."
|
||||
Just argumentValues -> do
|
||||
@ -113,61 +114,80 @@ executeField (Out.Resolver fieldDefinition resolver) prev fields = do
|
||||
Right result -> completeValue fieldType fields result
|
||||
Left errorMessage -> errmsg errorMessage
|
||||
|
||||
completeValue :: Monad m
|
||||
completeValue :: (Monad m, Serialize a)
|
||||
=> Out.Type m
|
||||
-> NonEmpty (Field m)
|
||||
-> Definition.Value
|
||||
-> CollectErrsT m Aeson.Value
|
||||
completeValue _ _ Definition.Null = pure Aeson.Null
|
||||
completeValue _ _ (Definition.Int integer) = pure $ Aeson.toJSON integer
|
||||
completeValue _ _ (Definition.Boolean boolean') = pure $ Aeson.Bool boolean'
|
||||
completeValue _ _ (Definition.Float float') = pure $ Aeson.toJSON float'
|
||||
completeValue _ _ (Definition.Enum enum) = pure $ Aeson.String enum
|
||||
completeValue _ _ (Definition.String string') = pure $ Aeson.String string'
|
||||
completeValue (Out.ListBaseType listType) fields (Definition.List list) =
|
||||
Aeson.toJSON <$> traverse (completeValue listType fields) list
|
||||
-> NonEmpty (Transform.Field m)
|
||||
-> Type.Value
|
||||
-> CollectErrsT m a
|
||||
completeValue (Out.isNonNullType -> False) _ Type.Null = pure null
|
||||
completeValue outputType@(Out.ListBaseType listType) fields (Type.List list)
|
||||
= traverse (completeValue listType fields) list
|
||||
>>= coerceResult outputType . List
|
||||
completeValue outputType@(Out.ScalarBaseType _) _ (Type.Int int) =
|
||||
coerceResult outputType $ Int int
|
||||
completeValue outputType@(Out.ScalarBaseType _) _ (Type.Boolean boolean) =
|
||||
coerceResult outputType $ Boolean boolean
|
||||
completeValue outputType@(Out.ScalarBaseType _) _ (Type.Float float) =
|
||||
coerceResult outputType $ Float float
|
||||
completeValue outputType@(Out.ScalarBaseType _) _ (Type.String string) =
|
||||
coerceResult outputType $ String string
|
||||
completeValue outputType@(Out.EnumBaseType enumType) _ (Type.Enum enum) =
|
||||
let Type.EnumType _ _ enumMembers = enumType
|
||||
in if HashMap.member enum enumMembers
|
||||
then coerceResult outputType $ Enum enum
|
||||
else errmsg "Value completion failed."
|
||||
completeValue (Out.ObjectBaseType objectType) fields result =
|
||||
executeSelectionSet result objectType $ mergeSelectionSets fields
|
||||
completeValue (Out.InterfaceBaseType interfaceType) fields result
|
||||
| Definition.Object objectMap <- result = do
|
||||
abstractType <- resolveAbstractType (AbstractInterfaceType interfaceType) objectMap
|
||||
case abstractType of
|
||||
| Type.Object objectMap <- result = do
|
||||
let abstractType = AbstractInterfaceType interfaceType
|
||||
concreteType <- resolveAbstractType abstractType objectMap
|
||||
case concreteType of
|
||||
Just objectType -> executeSelectionSet result objectType
|
||||
$ mergeSelectionSets fields
|
||||
Nothing -> errmsg "Value completion failed."
|
||||
completeValue (Out.UnionBaseType unionType) fields result
|
||||
| Definition.Object objectMap <- result = do
|
||||
abstractType <- resolveAbstractType (AbstractUnionType unionType) objectMap
|
||||
case abstractType of
|
||||
| Type.Object objectMap <- result = do
|
||||
let abstractType = AbstractUnionType unionType
|
||||
concreteType <- resolveAbstractType abstractType objectMap
|
||||
case concreteType of
|
||||
Just objectType -> executeSelectionSet result objectType
|
||||
$ mergeSelectionSets fields
|
||||
Nothing -> errmsg "Value completion failed."
|
||||
completeValue _ _ _ = errmsg "Value completion failed."
|
||||
|
||||
mergeSelectionSets :: Monad m => NonEmpty (Field m) -> Seq (Selection m)
|
||||
mergeSelectionSets fields = foldr forEach mempty fields
|
||||
mergeSelectionSets :: Monad m => NonEmpty (Transform.Field m) -> Seq (Transform.Selection m)
|
||||
mergeSelectionSets = foldr forEach mempty
|
||||
where
|
||||
forEach (Field _ _ _ fieldSelectionSet) selectionSet =
|
||||
forEach (Transform.Field _ _ _ fieldSelectionSet) selectionSet =
|
||||
selectionSet <> fieldSelectionSet
|
||||
|
||||
errmsg :: Monad m => Text -> CollectErrsT m Aeson.Value
|
||||
errmsg errorMessage = addErrMsg errorMessage >> pure Aeson.Null
|
||||
errmsg :: (Monad m, Serialize a) => Text -> CollectErrsT m a
|
||||
errmsg errorMessage = addErrMsg errorMessage >> pure null
|
||||
|
||||
-- | Takes an 'Out.ObjectType' and a list of 'Selection's and applies each field
|
||||
-- to each 'Selection'. Resolves into a value containing the resolved
|
||||
-- 'Selection', or a null value and error information.
|
||||
executeSelectionSet :: Monad m
|
||||
=> Definition.Value
|
||||
coerceResult :: (Monad m, Serialize a)
|
||||
=> Out.Type m
|
||||
-> Output a
|
||||
-> CollectErrsT m a
|
||||
coerceResult outputType result
|
||||
| Just serialized <- serialize outputType result = pure serialized
|
||||
| otherwise = errmsg "Result coercion failed."
|
||||
|
||||
-- | Takes an 'Out.ObjectType' and a list of 'Transform.Selection's and applies
|
||||
-- each field to each 'Transform.Selection'. Resolves into a value containing
|
||||
-- the resolved 'Transform.Selection', or a null value and error information.
|
||||
executeSelectionSet :: (Monad m, Serialize a)
|
||||
=> Type.Value
|
||||
-> Out.ObjectType m
|
||||
-> Seq (Selection m)
|
||||
-> CollectErrsT m Aeson.Value
|
||||
-> Seq (Transform.Selection m)
|
||||
-> CollectErrsT m a
|
||||
executeSelectionSet result objectType@(Out.ObjectType _ _ _ resolvers) selectionSet = do
|
||||
let fields = collectFields objectType selectionSet
|
||||
resolvedValues <- Map.traverseMaybeWithKey forEach fields
|
||||
pure $ Aeson.toJSON resolvedValues
|
||||
coerceResult (Out.NonNullObjectType objectType) $ Object resolvedValues
|
||||
where
|
||||
forEach _ fields@(field :| _) =
|
||||
let Field _ name _ _ = field
|
||||
let Transform.Field _ name _ _ = field
|
||||
in traverse (tryResolver fields) $ lookupResolver name
|
||||
lookupResolver = flip HashMap.lookup resolvers
|
||||
tryResolver fields resolver =
|
||||
@ -175,35 +195,35 @@ executeSelectionSet result objectType@(Out.ObjectType _ _ _ resolvers) selection
|
||||
|
||||
coerceArgumentValues
|
||||
:: HashMap Name In.Argument
|
||||
-> HashMap Name Input
|
||||
-> Maybe Definition.Subs
|
||||
-> HashMap Name Transform.Input
|
||||
-> Maybe Type.Subs
|
||||
coerceArgumentValues argumentDefinitions argumentValues =
|
||||
HashMap.foldrWithKey forEach (pure mempty) argumentDefinitions
|
||||
where
|
||||
forEach variableName (In.Argument _ variableType defaultValue) =
|
||||
matchFieldValues coerceArgumentValue argumentValues variableName variableType defaultValue
|
||||
coerceArgumentValue inputType (Int integer) =
|
||||
coerceInputLiteral inputType (Definition.Int integer)
|
||||
coerceArgumentValue inputType (Boolean boolean) =
|
||||
coerceInputLiteral inputType (Definition.Boolean boolean)
|
||||
coerceArgumentValue inputType (String string) =
|
||||
coerceInputLiteral inputType (Definition.String string)
|
||||
coerceArgumentValue inputType (Float float) =
|
||||
coerceInputLiteral inputType (Definition.Float float)
|
||||
coerceArgumentValue inputType (Enum enum) =
|
||||
coerceInputLiteral inputType (Definition.Enum enum)
|
||||
coerceArgumentValue inputType Null
|
||||
coerceArgumentValue inputType (Transform.Int integer) =
|
||||
coerceInputLiteral inputType (Type.Int integer)
|
||||
coerceArgumentValue inputType (Transform.Boolean boolean) =
|
||||
coerceInputLiteral inputType (Type.Boolean boolean)
|
||||
coerceArgumentValue inputType (Transform.String string) =
|
||||
coerceInputLiteral inputType (Type.String string)
|
||||
coerceArgumentValue inputType (Transform.Float float) =
|
||||
coerceInputLiteral inputType (Type.Float float)
|
||||
coerceArgumentValue inputType (Transform.Enum enum) =
|
||||
coerceInputLiteral inputType (Type.Enum enum)
|
||||
coerceArgumentValue inputType Transform.Null
|
||||
| In.isNonNullType inputType = Nothing
|
||||
| otherwise = coerceInputLiteral inputType Definition.Null
|
||||
coerceArgumentValue (In.ListBaseType inputType) (List list) =
|
||||
| otherwise = coerceInputLiteral inputType Type.Null
|
||||
coerceArgumentValue (In.ListBaseType inputType) (Transform.List list) =
|
||||
let coerceItem = coerceInputLiteral inputType
|
||||
in Definition.List <$> traverse coerceItem list
|
||||
coerceArgumentValue (In.InputObjectBaseType inputType) (Object object)
|
||||
in Type.List <$> traverse coerceItem list
|
||||
coerceArgumentValue (In.InputObjectBaseType inputType) (Transform.Object object)
|
||||
| In.InputObjectType _ _ inputFields <- inputType =
|
||||
let go = forEachField object
|
||||
resultMap = HashMap.foldrWithKey go (pure mempty) inputFields
|
||||
in Definition.Object <$> resultMap
|
||||
coerceArgumentValue _ (Variable variable) = pure variable
|
||||
in Type.Object <$> resultMap
|
||||
coerceArgumentValue _ (Transform.Variable variable) = pure variable
|
||||
coerceArgumentValue _ _ = Nothing
|
||||
forEachField object variableName (In.InputField _ variableType defaultValue) =
|
||||
matchFieldValues coerceArgumentValue object variableName variableType defaultValue
|
||||
|
||||
@ -45,10 +45,10 @@ import qualified Data.Text as Text
|
||||
import qualified Language.GraphQL.AST as Full
|
||||
import Language.GraphQL.AST (Name)
|
||||
import Language.GraphQL.AST.Core
|
||||
import Language.GraphQL.Execute.Coerce
|
||||
import qualified Language.GraphQL.Execute.Coerce as Coerce
|
||||
import Language.GraphQL.Type.Directive (Directive(..))
|
||||
import qualified Language.GraphQL.Type.Directive as Directive
|
||||
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
|
||||
import Language.GraphQL.Type.Schema
|
||||
@ -57,7 +57,7 @@ import Language.GraphQL.Type.Schema
|
||||
data Replacement m = Replacement
|
||||
{ fragments :: HashMap Full.Name (Fragment m)
|
||||
, fragmentDefinitions :: FragmentDefinitions
|
||||
, variableValues :: Definition.Subs
|
||||
, variableValues :: Type.Subs
|
||||
, types :: HashMap Full.Name (Type m)
|
||||
}
|
||||
|
||||
@ -110,9 +110,9 @@ data Input
|
||||
| Boolean Bool
|
||||
| Null
|
||||
| Enum Name
|
||||
| List [Definition.Value]
|
||||
| List [Type.Value]
|
||||
| Object (HashMap Name Input)
|
||||
| Variable Definition.Value
|
||||
| Variable Type.Value
|
||||
deriving (Eq, Show)
|
||||
|
||||
queryError :: QueryError -> Text
|
||||
@ -168,12 +168,12 @@ lookupInputType (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types
|
||||
= In.NonNullListType
|
||||
<$> lookupInputType nonNull types
|
||||
|
||||
coerceVariableValues :: VariableValue a
|
||||
coerceVariableValues :: Coerce.VariableValue a
|
||||
=> forall m
|
||||
. HashMap Full.Name (Type m)
|
||||
-> OperationDefinition
|
||||
-> HashMap.HashMap Full.Name a
|
||||
-> Either QueryError Definition.Subs
|
||||
-> Either QueryError Type.Subs
|
||||
coerceVariableValues types operationDefinition variableValues =
|
||||
let OperationDefinition _ _ variableDefinitions _ _ = operationDefinition
|
||||
in maybe (Left CoercionError) Right
|
||||
@ -185,27 +185,33 @@ coerceVariableValues types operationDefinition variableValues =
|
||||
let defaultValue' = constValue <$> defaultValue
|
||||
variableType <- lookupInputType variableTypeName types
|
||||
|
||||
matchFieldValues coerceVariableValue' variableValues variableName variableType defaultValue' coercedValues
|
||||
Coerce.matchFieldValues
|
||||
coerceVariableValue'
|
||||
variableValues
|
||||
variableName
|
||||
variableType
|
||||
defaultValue'
|
||||
coercedValues
|
||||
coerceVariableValue' variableType value'
|
||||
= coerceVariableValue variableType value'
|
||||
>>= coerceInputLiteral variableType
|
||||
= Coerce.coerceVariableValue variableType value'
|
||||
>>= Coerce.coerceInputLiteral variableType
|
||||
|
||||
constValue :: Full.ConstValue -> Definition.Value
|
||||
constValue (Full.ConstInt i) = Definition.Int i
|
||||
constValue (Full.ConstFloat f) = Definition.Float f
|
||||
constValue (Full.ConstString x) = Definition.String x
|
||||
constValue (Full.ConstBoolean b) = Definition.Boolean b
|
||||
constValue Full.ConstNull = Definition.Null
|
||||
constValue (Full.ConstEnum e) = Definition.Enum e
|
||||
constValue (Full.ConstList l) = Definition.List $ constValue <$> l
|
||||
constValue :: Full.ConstValue -> Type.Value
|
||||
constValue (Full.ConstInt i) = Type.Int i
|
||||
constValue (Full.ConstFloat f) = Type.Float f
|
||||
constValue (Full.ConstString x) = Type.String x
|
||||
constValue (Full.ConstBoolean b) = Type.Boolean b
|
||||
constValue Full.ConstNull = Type.Null
|
||||
constValue (Full.ConstEnum e) = Type.Enum e
|
||||
constValue (Full.ConstList l) = Type.List $ constValue <$> l
|
||||
constValue (Full.ConstObject o) =
|
||||
Definition.Object $ HashMap.fromList $ constObjectField <$> o
|
||||
Type.Object $ HashMap.fromList $ constObjectField <$> o
|
||||
where
|
||||
constObjectField (Full.ObjectField key value') = (key, constValue value')
|
||||
|
||||
-- | Rewrites the original syntax tree into an intermediate representation used
|
||||
-- for query execution.
|
||||
document :: VariableValue a
|
||||
document :: Coerce.VariableValue a
|
||||
=> forall m
|
||||
. Schema m
|
||||
-> Maybe Full.Name
|
||||
@ -386,30 +392,30 @@ fragmentDefinition (Full.FragmentDefinition name type' _ selections) = do
|
||||
let newFragments = HashMap.insert name newValue fragments
|
||||
in replacement{ fragments = newFragments }
|
||||
|
||||
value :: forall m. Full.Value -> State (Replacement m) Definition.Value
|
||||
value :: forall m. Full.Value -> State (Replacement m) Type.Value
|
||||
value (Full.Variable name) =
|
||||
gets (fromMaybe Definition.Null . HashMap.lookup name . variableValues)
|
||||
value (Full.Int i) = pure $ Definition.Int i
|
||||
value (Full.Float f) = pure $ Definition.Float f
|
||||
value (Full.String x) = pure $ Definition.String x
|
||||
value (Full.Boolean b) = pure $ Definition.Boolean b
|
||||
value Full.Null = pure Definition.Null
|
||||
value (Full.Enum e) = pure $ Definition.Enum e
|
||||
value (Full.List l) = Definition.List <$> traverse value l
|
||||
value (Full.Object o) =
|
||||
Definition.Object . HashMap.fromList <$> traverse objectField o
|
||||
gets (fromMaybe Type.Null . HashMap.lookup name . variableValues)
|
||||
value (Full.Int int) = pure $ Type.Int int
|
||||
value (Full.Float float) = pure $ Type.Float float
|
||||
value (Full.String string) = pure $ Type.String string
|
||||
value (Full.Boolean boolean) = pure $ Type.Boolean boolean
|
||||
value Full.Null = pure Type.Null
|
||||
value (Full.Enum enum) = pure $ Type.Enum enum
|
||||
value (Full.List list) = Type.List <$> traverse value list
|
||||
value (Full.Object object) =
|
||||
Type.Object . HashMap.fromList <$> traverse objectField object
|
||||
where
|
||||
objectField (Full.ObjectField name value') = (name,) <$> value value'
|
||||
|
||||
input :: forall m. Full.Value -> State (Replacement m) (Maybe Input)
|
||||
input (Full.Variable name) =
|
||||
gets (fmap Variable . HashMap.lookup name . variableValues)
|
||||
input (Full.Int i) = pure $ pure $ Int i
|
||||
input (Full.Float f) = pure $ pure $ Float f
|
||||
input (Full.String x) = pure $ pure $ String x
|
||||
input (Full.Boolean b) = pure $ pure $ Boolean b
|
||||
input (Full.Int int) = pure $ pure $ Int int
|
||||
input (Full.Float float) = pure $ pure $ Float float
|
||||
input (Full.String string) = pure $ pure $ String string
|
||||
input (Full.Boolean boolean) = pure $ pure $ Boolean boolean
|
||||
input Full.Null = pure $ pure Null
|
||||
input (Full.Enum e) = pure $ pure $ Enum e
|
||||
input (Full.Enum enum) = pure $ pure $ Enum enum
|
||||
input (Full.List list) = pure . List <$> traverse value list
|
||||
input (Full.Object object) = do
|
||||
objectFields <- foldM objectField HashMap.empty object
|
||||
|
||||
@ -9,7 +9,7 @@ import qualified Data.Aeson.Types as Aeson
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Maybe (isNothing)
|
||||
import Data.Scientific (scientific)
|
||||
import Language.GraphQL.Execute.Coerce
|
||||
import qualified Language.GraphQL.Execute.Coerce as Coerce
|
||||
import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import Prelude hiding (id)
|
||||
@ -30,55 +30,58 @@ singletonInputObject = In.NamedInputObjectType type'
|
||||
inputFields = HashMap.singleton "field" field
|
||||
field = In.InputField Nothing (In.NamedScalarType string) Nothing
|
||||
|
||||
namedIdType :: In.Type
|
||||
namedIdType = In.NamedScalarType id
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "VariableValue Aeson" $ do
|
||||
it "coerces strings" $
|
||||
let expected = Just (String "asdf")
|
||||
actual = coerceVariableValue
|
||||
actual = Coerce.coerceVariableValue
|
||||
(In.NamedScalarType string) (Aeson.String "asdf")
|
||||
in actual `shouldBe` expected
|
||||
it "coerces non-null strings" $
|
||||
let expected = Just (String "asdf")
|
||||
actual = coerceVariableValue
|
||||
actual = Coerce.coerceVariableValue
|
||||
(In.NonNullScalarType string) (Aeson.String "asdf")
|
||||
in actual `shouldBe` expected
|
||||
it "coerces booleans" $
|
||||
let expected = Just (Boolean True)
|
||||
actual = coerceVariableValue
|
||||
actual = Coerce.coerceVariableValue
|
||||
(In.NamedScalarType boolean) (Aeson.Bool True)
|
||||
in actual `shouldBe` expected
|
||||
it "coerces zero to an integer" $
|
||||
let expected = Just (Int 0)
|
||||
actual = coerceVariableValue
|
||||
actual = Coerce.coerceVariableValue
|
||||
(In.NamedScalarType int) (Aeson.Number 0)
|
||||
in actual `shouldBe` expected
|
||||
it "rejects fractional if an integer is expected" $
|
||||
let actual = coerceVariableValue
|
||||
let actual = Coerce.coerceVariableValue
|
||||
(In.NamedScalarType int) (Aeson.Number $ scientific 14 (-1))
|
||||
in actual `shouldSatisfy` isNothing
|
||||
it "coerces float numbers" $
|
||||
let expected = Just (Float 1.4)
|
||||
actual = coerceVariableValue
|
||||
actual = Coerce.coerceVariableValue
|
||||
(In.NamedScalarType float) (Aeson.Number $ scientific 14 (-1))
|
||||
in actual `shouldBe` expected
|
||||
it "coerces IDs" $
|
||||
let expected = Just (String "1234")
|
||||
actual = coerceVariableValue
|
||||
(In.NamedScalarType id) (Aeson.String "1234")
|
||||
json = Aeson.String "1234"
|
||||
actual = Coerce.coerceVariableValue namedIdType json
|
||||
in actual `shouldBe` expected
|
||||
it "coerces input objects" $
|
||||
let actual = coerceVariableValue singletonInputObject
|
||||
let actual = Coerce.coerceVariableValue singletonInputObject
|
||||
$ Aeson.object ["field" .= ("asdf" :: Aeson.Value)]
|
||||
expected = Just $ Object $ HashMap.singleton "field" "asdf"
|
||||
in actual `shouldBe` expected
|
||||
it "skips the field if it is missing in the variables" $
|
||||
let actual = coerceVariableValue
|
||||
let actual = Coerce.coerceVariableValue
|
||||
singletonInputObject Aeson.emptyObject
|
||||
expected = Just $ Object HashMap.empty
|
||||
in actual `shouldBe` expected
|
||||
it "fails if input object value contains extra fields" $
|
||||
let actual = coerceVariableValue singletonInputObject
|
||||
let actual = Coerce.coerceVariableValue singletonInputObject
|
||||
$ Aeson.object variableFields
|
||||
variableFields =
|
||||
[ "field" .= ("asdf" :: Aeson.Value)
|
||||
@ -86,26 +89,26 @@ spec = do
|
||||
]
|
||||
in actual `shouldSatisfy` isNothing
|
||||
it "preserves null" $
|
||||
let actual = coerceVariableValue (In.NamedScalarType id) Aeson.Null
|
||||
let actual = Coerce.coerceVariableValue namedIdType Aeson.Null
|
||||
in actual `shouldBe` Just Null
|
||||
it "preserves list order" $
|
||||
let list = Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"]
|
||||
listType = (In.ListType $ In.NamedScalarType string)
|
||||
actual = coerceVariableValue listType list
|
||||
actual = Coerce.coerceVariableValue listType list
|
||||
expected = Just $ List [String "asdf", String "qwer"]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
describe "coerceInputLiterals" $ do
|
||||
it "coerces enums" $
|
||||
let expected = Just (Enum "NORTH")
|
||||
actual = coerceInputLiteral
|
||||
actual = Coerce.coerceInputLiteral
|
||||
(In.NamedEnumType direction) (Enum "NORTH")
|
||||
in actual `shouldBe` expected
|
||||
it "fails with non-existing enum value" $
|
||||
let actual = coerceInputLiteral
|
||||
let actual = Coerce.coerceInputLiteral
|
||||
(In.NamedEnumType direction) (Enum "NORTH_EAST")
|
||||
in actual `shouldSatisfy` isNothing
|
||||
it "coerces integers to IDs" $
|
||||
let expected = Just (String "1234")
|
||||
actual = coerceInputLiteral (In.NamedScalarType id) (Int 1234)
|
||||
actual = Coerce.coerceInputLiteral namedIdType (Int 1234)
|
||||
in actual `shouldBe` expected
|
||||
|
||||
@ -12,7 +12,7 @@ import Language.GraphQL.AST (Name)
|
||||
import Language.GraphQL.AST.Parser (document)
|
||||
import Language.GraphQL.Error
|
||||
import Language.GraphQL.Execute
|
||||
import Language.GraphQL.Type
|
||||
import Language.GraphQL.Type as Type
|
||||
import Language.GraphQL.Type.Out as Out
|
||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||
import Text.Megaparsec (parse)
|
||||
@ -25,7 +25,7 @@ queryType = Out.ObjectType "Query" Nothing []
|
||||
$ HashMap.singleton "philosopher"
|
||||
$ Out.Resolver philosopherField
|
||||
$ pure
|
||||
$ Object mempty
|
||||
$ Type.Object mempty
|
||||
where
|
||||
philosopherField =
|
||||
Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
|
||||
@ -38,8 +38,8 @@ philosopherType = Out.ObjectType "Philosopher" Nothing []
|
||||
[ ("firstName", firstNameResolver)
|
||||
, ("lastName", lastNameResolver)
|
||||
]
|
||||
firstNameResolver = Out.Resolver firstNameField $ pure $ String "Friedrich"
|
||||
lastNameResolver = Out.Resolver lastNameField $ pure $ String "Nietzsche"
|
||||
firstNameResolver = Out.Resolver firstNameField $ pure $ Type.String "Friedrich"
|
||||
lastNameResolver = Out.Resolver lastNameField $ pure $ Type.String "Nietzsche"
|
||||
firstNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
||||
lastNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
||||
|
||||
|
||||
@ -184,7 +184,7 @@ getFriends :: Character -> [Character]
|
||||
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
|
||||
|
||||
getEpisode :: Int -> Maybe Text
|
||||
getEpisode 4 = pure "NEWHOPE"
|
||||
getEpisode 4 = pure "NEW_HOPE"
|
||||
getEpisode 5 = pure "EMPIRE"
|
||||
getEpisode 6 = pure "JEDI"
|
||||
getEpisode _ = empty
|
||||
|
||||
@ -77,7 +77,7 @@ spec = describe "Star Wars Query Tests" $ do
|
||||
, "friends" .= [
|
||||
Aeson.object [
|
||||
"name" .= ("Luke Skywalker" :: Text)
|
||||
, "appearsIn" .= ["NEWHOPE","EMPIRE","JEDI" :: Text]
|
||||
, "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
|
||||
, "friends" .= [
|
||||
Aeson.object [hanName]
|
||||
, Aeson.object [leiaName]
|
||||
@ -87,7 +87,7 @@ spec = describe "Star Wars Query Tests" $ do
|
||||
]
|
||||
, Aeson.object [
|
||||
hanName
|
||||
, "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
|
||||
, "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
|
||||
, "friends" .=
|
||||
[ Aeson.object [lukeName]
|
||||
, Aeson.object [leiaName]
|
||||
@ -96,7 +96,7 @@ spec = describe "Star Wars Query Tests" $ do
|
||||
]
|
||||
, Aeson.object [
|
||||
leiaName
|
||||
, "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
|
||||
, "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
|
||||
, "friends" .=
|
||||
[ Aeson.object [lukeName]
|
||||
, Aeson.object [hanName]
|
||||
|
||||
@ -42,7 +42,7 @@ heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
|
||||
[ ("id", Out.Resolver idFieldType (idField "id"))
|
||||
, ("name", Out.Resolver nameFieldType (idField "name"))
|
||||
, ("friends", Out.Resolver friendsFieldType (idField "friends"))
|
||||
, ("appearsIn", Out.Resolver appearsInFieldType (idField "appearsIn"))
|
||||
, ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
|
||||
, ("homePlanet", Out.Resolver homePlanetFieldType (idField "homePlanet"))
|
||||
, ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
|
||||
, ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
|
||||
@ -55,7 +55,7 @@ droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
|
||||
[ ("id", Out.Resolver idFieldType (idField "id"))
|
||||
, ("name", Out.Resolver nameFieldType (idField "name"))
|
||||
, ("friends", Out.Resolver friendsFieldType (idField "friends"))
|
||||
, ("appearsIn", Out.Resolver appearsInFieldType (idField "appearsIn"))
|
||||
, ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
|
||||
, ("primaryFunction", Out.Resolver primaryFunctionFieldType (idField "primaryFunction"))
|
||||
, ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
|
||||
, ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
|
||||
@ -72,8 +72,11 @@ nameFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
|
||||
friendsFieldType :: Out.Field Identity
|
||||
friendsFieldType = Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty
|
||||
|
||||
appearsInFieldType :: Out.Field Identity
|
||||
appearsInFieldType = Out.Field Nothing (Out.ListType $ Out.NamedScalarType int) mempty
|
||||
appearsInField :: Out.Field Identity
|
||||
appearsInField = Out.Field (Just description) fieldType mempty
|
||||
where
|
||||
fieldType = Out.ListType $ Out.NamedEnumType episodeEnum
|
||||
description = "Which movies they appear in."
|
||||
|
||||
secretBackstoryFieldType :: Out.Field Identity
|
||||
secretBackstoryFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
|
||||
@ -97,7 +100,7 @@ hero :: ActionT Identity Value
|
||||
hero = do
|
||||
episode <- argument "episode"
|
||||
pure $ character $ case episode of
|
||||
Enum "NEWHOPE" -> getHero 4
|
||||
Enum "NEW_HOPE" -> getHero 4
|
||||
Enum "EMPIRE" -> getHero 5
|
||||
Enum "JEDI" -> getHero 6
|
||||
_ -> artoo
|
||||
|
||||
Loading…
Reference in New Issue
Block a user