forked from OSS/graphql
Split input/output types and values into 2 modules
This commit is contained in:
parent
eb90a4091c
commit
61dbe6c728
@ -29,13 +29,17 @@ and this project adheres to
|
||||
`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.
|
||||
- `Type` module is superseded by `Type.Out`. This module contains now only
|
||||
exports from other module that complete `Type.In` and `Type.Out` exports.
|
||||
|
||||
### Added
|
||||
- `Type.Definition` contains input and the most output types.
|
||||
- `Type.Definition` contains base type system definition, e.g. Enums and
|
||||
Scalars.
|
||||
- `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`.
|
||||
- `Type.In` and `Type.Out` contain definitions for input and the most output
|
||||
types.
|
||||
- `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
|
||||
@ -51,7 +55,6 @@ and this project adheres to
|
||||
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
|
||||
|
||||
@ -23,9 +23,9 @@ Since this file is a literate haskell file, we start by importing some dependenc
|
||||
> import Data.Time (getCurrentTime)
|
||||
>
|
||||
> import Language.GraphQL
|
||||
> import Language.GraphQL.Type.Definition
|
||||
> import Language.GraphQL.Type.Schema
|
||||
> import qualified Language.GraphQL.Type as Type
|
||||
> import Language.GraphQL.Trans
|
||||
> import Language.GraphQL.Type
|
||||
> import qualified Language.GraphQL.Type.Out as Out
|
||||
>
|
||||
> import Prelude hiding (putStrLn)
|
||||
|
||||
@ -42,10 +42,10 @@ First we build a GraphQL schema.
|
||||
> queryType :: ObjectType IO
|
||||
> queryType = ObjectType "Query" Nothing
|
||||
> $ HashMap.singleton "hello"
|
||||
> $ Field Nothing (ScalarOutputType string) mempty hello
|
||||
> $ Field Nothing (Out.NamedScalarType string) mempty hello
|
||||
>
|
||||
> hello :: FieldResolver IO
|
||||
> hello = NestingResolver $ pure $ Type.S "it's me"
|
||||
> hello :: ActionT IO (Out.Value IO)
|
||||
> hello = pure $ Out.String "it's me"
|
||||
|
||||
This defines a simple schema with one type and one field, that resolves to a fixed value.
|
||||
|
||||
@ -77,12 +77,12 @@ For this example, we're going to be using time.
|
||||
> queryType2 :: ObjectType IO
|
||||
> queryType2 = ObjectType "Query" Nothing
|
||||
> $ HashMap.singleton "time"
|
||||
> $ Field Nothing (ScalarOutputType string) mempty time
|
||||
> $ Field Nothing (Out.NamedScalarType string) mempty time
|
||||
>
|
||||
> time :: FieldResolver IO
|
||||
> time = NestingResolver $ do
|
||||
> time :: ActionT IO (Out.Value IO)
|
||||
> time = do
|
||||
> t <- liftIO getCurrentTime
|
||||
> pure $ Type.S $ Text.pack $ show t
|
||||
> pure $ Out.String $ Text.pack $ show t
|
||||
|
||||
This defines a simple schema with one type and one field,
|
||||
which resolves to the current time.
|
||||
@ -140,8 +140,8 @@ Now that we have two resolvers, we can define a schema which uses them both.
|
||||
>
|
||||
> queryType3 :: ObjectType IO
|
||||
> queryType3 = ObjectType "Query" Nothing $ HashMap.fromList
|
||||
> [ ("hello", Field Nothing (ScalarOutputType string) mempty hello)
|
||||
> , ("time", Field Nothing (ScalarOutputType string) mempty time)
|
||||
> [ ("hello", Field Nothing (Out.NamedScalarType string) mempty hello)
|
||||
> , ("time", Field Nothing (Out.NamedScalarType string) mempty time)
|
||||
> ]
|
||||
>
|
||||
> query3 :: Text
|
||||
|
||||
@ -16,7 +16,7 @@ import Language.GraphQL.Execute.Coerce
|
||||
import qualified Language.GraphQL.Execute.Transform as Transform
|
||||
import Language.GraphQL.Error
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
import qualified Language.GraphQL.Type.Definition as Definition
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Language.GraphQL.Type.Schema
|
||||
|
||||
-- | The substitution is applied to the document, and the resolvers are applied
|
||||
@ -66,7 +66,7 @@ operation = schemaOperation
|
||||
. flip Schema.resolve queryFields
|
||||
. fmap getResolver
|
||||
. fields
|
||||
fields (Definition.ObjectType _ _ objectFields) = objectFields
|
||||
fields (Out.ObjectType _ _ objectFields) = objectFields
|
||||
lookupError = pure
|
||||
$ singleError "Root operation type couldn't be found in the schema."
|
||||
schemaOperation Schema {query} (AST.Core.Query _ fields') =
|
||||
@ -75,4 +75,4 @@ operation = schemaOperation
|
||||
resolve fields' mutation
|
||||
schemaOperation Schema {mutation = Nothing} (AST.Core.Mutation _ _) =
|
||||
lookupError
|
||||
getResolver (Definition.Field _ _ _ resolver) = resolver
|
||||
getResolver (Out.Field _ _ _ resolver) = resolver
|
||||
|
||||
@ -4,7 +4,6 @@
|
||||
module Language.GraphQL.Execute.Coerce
|
||||
( VariableValue(..)
|
||||
, coerceInputLiterals
|
||||
, isNonNullInputType
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
@ -45,13 +44,13 @@ class VariableValue a where
|
||||
-- If a value cannot be coerced without losing information, 'Nothing' should
|
||||
-- be returned, the coercion will fail then and the query won't be executed.
|
||||
coerceVariableValue
|
||||
:: InputType -- ^ Expected type (variable type given in the query).
|
||||
:: In.Type -- ^ Expected type (variable type given in the query).
|
||||
-> a -- ^ Variable value being coerced.
|
||||
-> Maybe In.Value -- ^ Coerced value on success, 'Nothing' otherwise.
|
||||
|
||||
instance VariableValue Aeson.Value where
|
||||
coerceVariableValue _ Aeson.Null = Just In.Null
|
||||
coerceVariableValue (ScalarInputTypeDefinition scalarType) value
|
||||
coerceVariableValue (In.ScalarBaseType scalarType) value
|
||||
| (Aeson.String stringValue) <- value = Just $ In.String stringValue
|
||||
| (Aeson.Bool booleanValue) <- value = Just $ In.Boolean booleanValue
|
||||
| (Aeson.Number numberValue) <- value
|
||||
@ -59,11 +58,11 @@ instance VariableValue Aeson.Value where
|
||||
Just $ In.Float $ toRealFloat numberValue
|
||||
| (Aeson.Number numberValue) <- value = -- ID or Int
|
||||
In.Int <$> toBoundedInteger numberValue
|
||||
coerceVariableValue (EnumInputTypeDefinition _) (Aeson.String stringValue) =
|
||||
coerceVariableValue (In.EnumBaseType _) (Aeson.String stringValue) =
|
||||
Just $ In.Enum stringValue
|
||||
coerceVariableValue (ObjectInputTypeDefinition objectType) value
|
||||
coerceVariableValue (In.InputObjectBaseType objectType) value
|
||||
| (Aeson.Object objectValue) <- value = do
|
||||
let (InputObjectType _ _ inputFields) = objectType
|
||||
let (In.InputObjectType _ _ inputFields) = objectType
|
||||
(newObjectValue, resultMap) <- foldWithKey objectValue inputFields
|
||||
if HashMap.null newObjectValue
|
||||
then Just $ In.Object resultMap
|
||||
@ -73,7 +72,7 @@ instance VariableValue Aeson.Value where
|
||||
$ Just (objectValue, HashMap.empty)
|
||||
matchFieldValues _ _ Nothing = Nothing
|
||||
matchFieldValues fieldName inputField (Just (objectValue, resultMap)) =
|
||||
let (InputField _ fieldType _) = inputField
|
||||
let (In.InputField _ fieldType _) = inputField
|
||||
insert = flip (HashMap.insert fieldName) resultMap
|
||||
newObjectValue = HashMap.delete fieldName objectValue
|
||||
in case HashMap.lookup fieldName objectValue of
|
||||
@ -81,7 +80,7 @@ instance VariableValue Aeson.Value where
|
||||
coerced <- coerceVariableValue fieldType variableValue
|
||||
pure (newObjectValue, insert coerced)
|
||||
Nothing -> Just (objectValue, resultMap)
|
||||
coerceVariableValue (ListInputTypeDefinition listType) value
|
||||
coerceVariableValue (In.ListBaseType listType) value
|
||||
| (Aeson.Array arrayValue) <- value = In.List
|
||||
<$> foldr foldVector (Just []) arrayValue
|
||||
| otherwise = coerceVariableValue listType value
|
||||
@ -95,7 +94,7 @@ instance VariableValue Aeson.Value where
|
||||
-- | Coerces operation arguments according to the input coercion rules for the
|
||||
-- corresponding types.
|
||||
coerceInputLiterals
|
||||
:: HashMap Name InputType
|
||||
:: HashMap Name In.Type
|
||||
-> HashMap Name In.Value
|
||||
-> Maybe Subs
|
||||
coerceInputLiterals variableTypes variableValues =
|
||||
@ -105,7 +104,7 @@ coerceInputLiterals variableTypes variableValues =
|
||||
HashMap.insert variableName
|
||||
<$> (lookupVariable variableName >>= coerceInputLiteral variableType)
|
||||
<*> resultMap
|
||||
coerceInputLiteral (ScalarInputType type') value
|
||||
coerceInputLiteral (In.NamedScalarType type') value
|
||||
| (In.String stringValue) <- value
|
||||
, (ScalarType "String" _) <- type' = Just $ In.String stringValue
|
||||
| (In.Boolean booleanValue) <- value
|
||||
@ -121,17 +120,17 @@ coerceInputLiterals variableTypes variableValues =
|
||||
, (ScalarType "ID" _) <- type' = Just $ In.String stringValue
|
||||
| (In.Int intValue) <- value
|
||||
, (ScalarType "ID" _) <- type' = Just $ decimal intValue
|
||||
coerceInputLiteral (EnumInputType type') (In.Enum enumValue)
|
||||
coerceInputLiteral (In.NamedEnumType type') (In.Enum enumValue)
|
||||
| member enumValue type' = Just $ In.Enum enumValue
|
||||
coerceInputLiteral (ObjectInputType type') (In.Object _) =
|
||||
let (InputObjectType _ _ inputFields) = type'
|
||||
coerceInputLiteral (In.NamedInputObjectType type') (In.Object _) =
|
||||
let (In.InputObjectType _ _ inputFields) = type'
|
||||
in In.Object <$> foldWithKey matchFieldValues inputFields
|
||||
coerceInputLiteral _ _ = Nothing
|
||||
member value (EnumType _ _ members) = Set.member value members
|
||||
matchFieldValues fieldName (InputField _ type' defaultValue) resultMap =
|
||||
matchFieldValues fieldName (In.InputField _ type' defaultValue) resultMap =
|
||||
case lookupVariable fieldName of
|
||||
Just In.Null
|
||||
| isNonNullInputType type' -> Nothing
|
||||
| In.isNonNullType type' -> Nothing
|
||||
| otherwise ->
|
||||
HashMap.insert fieldName In.Null <$> resultMap
|
||||
Just variableValue -> HashMap.insert fieldName
|
||||
@ -141,7 +140,7 @@ coerceInputLiterals variableTypes variableValues =
|
||||
| Just value <- defaultValue ->
|
||||
HashMap.insert fieldName value <$> resultMap
|
||||
| Nothing <- defaultValue
|
||||
, isNonNullInputType type' -> Nothing
|
||||
, In.isNonNullType type' -> Nothing
|
||||
| otherwise -> resultMap
|
||||
lookupVariable = flip HashMap.lookup variableValues
|
||||
foldWithKey f = HashMap.foldrWithKey f (Just HashMap.empty)
|
||||
@ -149,11 +148,3 @@ coerceInputLiterals variableTypes variableValues =
|
||||
. Text.Lazy.toStrict
|
||||
. Text.Builder.toLazyText
|
||||
. Text.Builder.decimal
|
||||
|
||||
-- | Checks whether the given input type is a non-null type.
|
||||
isNonNullInputType :: InputType -> Bool
|
||||
isNonNullInputType (NonNullScalarInputType _) = True
|
||||
isNonNullInputType (NonNullEnumInputType _) = True
|
||||
isNonNullInputType (NonNullObjectInputType _) = True
|
||||
isNonNullInputType (NonNullListInputType _) = True
|
||||
isNonNullInputType _ = False
|
||||
|
||||
@ -30,7 +30,6 @@ import qualified Language.GraphQL.AST as Full
|
||||
import qualified Language.GraphQL.AST.Core as Core
|
||||
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
|
||||
@ -86,31 +85,31 @@ getOperation (Just operationName) operations
|
||||
|
||||
lookupInputType
|
||||
:: Full.Type
|
||||
-> HashMap.HashMap Full.Name (Definition.TypeDefinition m)
|
||||
-> Maybe Definition.InputType
|
||||
-> HashMap.HashMap Full.Name (Type m)
|
||||
-> Maybe In.Type
|
||||
lookupInputType (Full.TypeNamed name) types =
|
||||
case HashMap.lookup name types of
|
||||
Just (Definition.ScalarTypeDefinition scalarType) ->
|
||||
Just $ Definition.ScalarInputType scalarType
|
||||
Just (Definition.EnumTypeDefinition enumType) ->
|
||||
Just $ Definition.EnumInputType enumType
|
||||
Just (Definition.InputObjectTypeDefinition objectType) ->
|
||||
Just $ Definition.ObjectInputType objectType
|
||||
Just (ScalarType scalarType) ->
|
||||
Just $ In.NamedScalarType scalarType
|
||||
Just (EnumType enumType) ->
|
||||
Just $ In.NamedEnumType enumType
|
||||
Just (InputObjectType objectType) ->
|
||||
Just $ In.NamedInputObjectType objectType
|
||||
_ -> Nothing
|
||||
lookupInputType (Full.TypeList list) types
|
||||
= Definition.ListInputType
|
||||
= In.ListType
|
||||
<$> lookupInputType list types
|
||||
lookupInputType (Full.TypeNonNull (Full.NonNullTypeNamed nonNull)) types =
|
||||
case HashMap.lookup nonNull types of
|
||||
Just (Definition.ScalarTypeDefinition scalarType) ->
|
||||
Just $ Definition.NonNullScalarInputType scalarType
|
||||
Just (Definition.EnumTypeDefinition enumType) ->
|
||||
Just $ Definition.NonNullEnumInputType enumType
|
||||
Just (Definition.InputObjectTypeDefinition objectType) ->
|
||||
Just $ Definition.NonNullObjectInputType objectType
|
||||
Just (ScalarType scalarType) ->
|
||||
Just $ In.NonNullScalarType scalarType
|
||||
Just (EnumType enumType) ->
|
||||
Just $ In.NonNullEnumType enumType
|
||||
Just (InputObjectType objectType) ->
|
||||
Just $ In.NonNullInputObjectType objectType
|
||||
_ -> Nothing
|
||||
lookupInputType (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types
|
||||
= Definition.NonNullListInputType
|
||||
= In.NonNullListType
|
||||
<$> lookupInputType nonNull types
|
||||
|
||||
coerceVariableValues :: (Monad m, VariableValue a)
|
||||
@ -137,10 +136,10 @@ coerceVariableValues schema operationDefinition variableValues' =
|
||||
<*> coercedValues
|
||||
choose Nothing defaultValue variableType
|
||||
| Just _ <- defaultValue = defaultValue
|
||||
| not (isNonNullInputType variableType) = Just In.Null
|
||||
| not (In.isNonNullType variableType) = Just In.Null
|
||||
choose (Just value') _ variableType
|
||||
| Just coercedValue <- coerceVariableValue variableType value'
|
||||
, not (isNonNullInputType variableType) || coercedValue /= In.Null =
|
||||
, not (In.isNonNullType variableType) || coercedValue /= In.Null =
|
||||
Just coercedValue
|
||||
choose _ _ _ = Nothing
|
||||
|
||||
|
||||
14
src/Language/GraphQL/Type.hs
Normal file
14
src/Language/GraphQL/Type.hs
Normal file
@ -0,0 +1,14 @@
|
||||
-- | Reexports non-conflicting type system and schema definitions.
|
||||
module Language.GraphQL.Type
|
||||
( In.InputField(..)
|
||||
, In.InputObjectType(..)
|
||||
, Out.Field(..)
|
||||
, Out.ObjectType(..)
|
||||
, module Language.GraphQL.Type.Definition
|
||||
, module Language.GraphQL.Type.Schema
|
||||
) where
|
||||
|
||||
import Language.GraphQL.Type.Definition
|
||||
import Language.GraphQL.Type.Schema (Schema(..))
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
@ -1,28 +1,9 @@
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
-- | Types representing GraphQL type system.
|
||||
-- | Types that can be used as both input and output types.
|
||||
module Language.GraphQL.Type.Definition
|
||||
( Argument(..)
|
||||
, EnumType(..)
|
||||
, Field(..)
|
||||
, InputField(..)
|
||||
, InputObjectType(..)
|
||||
, InputType(..)
|
||||
, ObjectType(..)
|
||||
, OutputType(..)
|
||||
( EnumType(..)
|
||||
, ScalarType(..)
|
||||
, TypeDefinition(..)
|
||||
, pattern EnumInputTypeDefinition
|
||||
, pattern ListInputTypeDefinition
|
||||
, pattern ObjectInputTypeDefinition
|
||||
, pattern ScalarInputTypeDefinition
|
||||
, pattern EnumOutputTypeDefinition
|
||||
, pattern ListOutputTypeDefinition
|
||||
, pattern ObjectOutputTypeDefinition
|
||||
, pattern ScalarOutputTypeDefinition
|
||||
, boolean
|
||||
, float
|
||||
, id
|
||||
@ -30,31 +11,11 @@ module Language.GraphQL.Type.Definition
|
||||
, string
|
||||
) where
|
||||
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Data.Set (Set)
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
import Language.GraphQL.Trans
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Prelude hiding (id)
|
||||
|
||||
-- | Object type definition.
|
||||
--
|
||||
-- Almost all of the GraphQL types you define will be object types. Object
|
||||
-- types have a name, but most importantly describe their fields.
|
||||
data ObjectType m = ObjectType Name (Maybe Text) (HashMap Name (Field m))
|
||||
|
||||
-- | Output object field definition.
|
||||
data Field m = Field
|
||||
(Maybe Text) -- ^ Description.
|
||||
(OutputType m) -- ^ Field type.
|
||||
(HashMap Name Argument) -- ^ Arguments.
|
||||
(ActionT m (Out.Value m)) -- ^ Resolver.
|
||||
|
||||
-- | Field argument definition.
|
||||
data Argument = Argument (Maybe Text) InputType (Maybe In.Value)
|
||||
|
||||
-- | Scalar type definition.
|
||||
--
|
||||
-- The leaf values of any request and input values to arguments are Scalars (or
|
||||
@ -68,45 +29,6 @@ data ScalarType = ScalarType Name (Maybe Text)
|
||||
-- kind of type, often integers.
|
||||
data EnumType = EnumType Name (Maybe Text) (Set Text)
|
||||
|
||||
-- | Single field of an 'InputObjectType'.
|
||||
data InputField = InputField (Maybe Text) InputType (Maybe In.Value)
|
||||
|
||||
-- | Input object type definition.
|
||||
--
|
||||
-- An input object defines a structured collection of fields which may be
|
||||
-- supplied to a field argument.
|
||||
data InputObjectType = InputObjectType
|
||||
Name (Maybe Text) (HashMap Name InputField)
|
||||
|
||||
-- | These types may be used as input types for arguments and directives.
|
||||
data InputType
|
||||
= ScalarInputType ScalarType
|
||||
| EnumInputType EnumType
|
||||
| ObjectInputType InputObjectType
|
||||
| ListInputType InputType
|
||||
| NonNullScalarInputType ScalarType
|
||||
| NonNullEnumInputType EnumType
|
||||
| NonNullObjectInputType InputObjectType
|
||||
| NonNullListInputType InputType
|
||||
|
||||
-- | These types may be used as output types as the result of fields.
|
||||
data OutputType m
|
||||
= ScalarOutputType ScalarType
|
||||
| EnumOutputType EnumType
|
||||
| ObjectOutputType (ObjectType m)
|
||||
| ListOutputType (OutputType m)
|
||||
| NonNullScalarOutputType ScalarType
|
||||
| NonNullEnumOutputType EnumType
|
||||
| NonNullObjectOutputType (ObjectType m)
|
||||
| NonNullListOutputType (OutputType m)
|
||||
|
||||
-- | These are all of the possible kinds of types.
|
||||
data TypeDefinition m
|
||||
= ScalarTypeDefinition ScalarType
|
||||
| EnumTypeDefinition EnumType
|
||||
| ObjectTypeDefinition (ObjectType m)
|
||||
| InputObjectTypeDefinition InputObjectType
|
||||
|
||||
-- | The @String@ scalar type represents textual data, represented as UTF-8
|
||||
-- character sequences. The String type is most often used by GraphQL to
|
||||
-- represent free-form human-readable text.
|
||||
@ -158,95 +80,3 @@ id = ScalarType "ID" (Just description)
|
||||
\JSON response as a String; however, it is not intended to be \
|
||||
\human-readable. When expected as an input type, any string (such as \
|
||||
\`\"4\"`) or integer (such as `4`) input value will be accepted as an ID."
|
||||
|
||||
-- | Matches either 'ScalarInputType' or 'NonNullScalarInputType'.
|
||||
pattern ScalarInputTypeDefinition :: ScalarType -> InputType
|
||||
pattern ScalarInputTypeDefinition scalarType <-
|
||||
(isScalarInputType -> Just scalarType)
|
||||
|
||||
-- | Matches either 'EnumInputType' or 'NonNullEnumInputType'.
|
||||
pattern EnumInputTypeDefinition :: EnumType -> InputType
|
||||
pattern EnumInputTypeDefinition enumType <-
|
||||
(isEnumInputType -> Just enumType)
|
||||
|
||||
-- | Matches either 'ObjectInputType' or 'NonNullObjectInputType'.
|
||||
pattern ObjectInputTypeDefinition :: InputObjectType -> InputType
|
||||
pattern ObjectInputTypeDefinition objectType <-
|
||||
(isObjectInputType -> Just objectType)
|
||||
|
||||
-- | Matches either 'ListInputType' or 'NonNullListInputType'.
|
||||
pattern ListInputTypeDefinition :: InputType -> InputType
|
||||
pattern ListInputTypeDefinition listType <-
|
||||
(isListInputType -> Just listType)
|
||||
|
||||
{-# COMPLETE EnumInputTypeDefinition
|
||||
, ListInputTypeDefinition
|
||||
, ObjectInputTypeDefinition
|
||||
, ScalarInputTypeDefinition
|
||||
#-}
|
||||
|
||||
-- | Matches either 'ScalarOutputType' or 'NonNullScalarOutputType'.
|
||||
pattern ScalarOutputTypeDefinition :: forall m. ScalarType -> OutputType m
|
||||
pattern ScalarOutputTypeDefinition scalarType <-
|
||||
(isScalarOutputType -> Just scalarType)
|
||||
|
||||
-- | Matches either 'EnumOutputType' or 'NonNullEnumOutputType'.
|
||||
pattern EnumOutputTypeDefinition :: forall m. EnumType -> OutputType m
|
||||
pattern EnumOutputTypeDefinition enumType <-
|
||||
(isEnumOutputType -> Just enumType)
|
||||
|
||||
-- | Matches either 'ObjectOutputType' or 'NonNullObjectOutputType'.
|
||||
pattern ObjectOutputTypeDefinition :: forall m. ObjectType m -> OutputType m
|
||||
pattern ObjectOutputTypeDefinition objectType <-
|
||||
(isObjectOutputType -> Just objectType)
|
||||
|
||||
-- | Matches either 'ListOutputType' or 'NonNullListOutputType'.
|
||||
pattern ListOutputTypeDefinition :: forall m. OutputType m -> OutputType m
|
||||
pattern ListOutputTypeDefinition listType <-
|
||||
(isListOutputType -> Just listType)
|
||||
|
||||
{-# COMPLETE ScalarOutputTypeDefinition
|
||||
, EnumOutputTypeDefinition
|
||||
, ObjectOutputTypeDefinition
|
||||
, ListOutputTypeDefinition
|
||||
#-}
|
||||
|
||||
isScalarInputType :: InputType -> Maybe ScalarType
|
||||
isScalarInputType (ScalarInputType inputType) = Just inputType
|
||||
isScalarInputType (NonNullScalarInputType inputType) = Just inputType
|
||||
isScalarInputType _ = Nothing
|
||||
|
||||
isObjectInputType :: InputType -> Maybe InputObjectType
|
||||
isObjectInputType (ObjectInputType inputType) = Just inputType
|
||||
isObjectInputType (NonNullObjectInputType inputType) = Just inputType
|
||||
isObjectInputType _ = Nothing
|
||||
|
||||
isEnumInputType :: InputType -> Maybe EnumType
|
||||
isEnumInputType (EnumInputType inputType) = Just inputType
|
||||
isEnumInputType (NonNullEnumInputType inputType) = Just inputType
|
||||
isEnumInputType _ = Nothing
|
||||
|
||||
isListInputType :: InputType -> Maybe InputType
|
||||
isListInputType (ListInputType inputType) = Just inputType
|
||||
isListInputType (NonNullListInputType inputType) = Just inputType
|
||||
isListInputType _ = Nothing
|
||||
|
||||
isScalarOutputType :: forall m. OutputType m -> Maybe ScalarType
|
||||
isScalarOutputType (ScalarOutputType outputType) = Just outputType
|
||||
isScalarOutputType (NonNullScalarOutputType outputType) = Just outputType
|
||||
isScalarOutputType _ = Nothing
|
||||
|
||||
isObjectOutputType :: forall m. OutputType m -> Maybe (ObjectType m)
|
||||
isObjectOutputType (ObjectOutputType outputType) = Just outputType
|
||||
isObjectOutputType (NonNullObjectOutputType outputType) = Just outputType
|
||||
isObjectOutputType _ = Nothing
|
||||
|
||||
isEnumOutputType :: forall m. OutputType m -> Maybe EnumType
|
||||
isEnumOutputType (EnumOutputType outputType) = Just outputType
|
||||
isEnumOutputType (NonNullEnumOutputType outputType) = Just outputType
|
||||
isEnumOutputType _ = Nothing
|
||||
|
||||
isListOutputType :: forall m. OutputType m -> Maybe (OutputType m)
|
||||
isListOutputType (ListOutputType outputType) = Just outputType
|
||||
isListOutputType (NonNullListOutputType outputType) = Just outputType
|
||||
isListOutputType _ = Nothing
|
||||
|
||||
@ -1,7 +1,21 @@
|
||||
-- | This module is intended to be imported qualified, to avoid name clashes
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
-- | Input types and values.
|
||||
--
|
||||
-- This module is intended to be imported qualified, to avoid name clashes
|
||||
-- with 'Language.GraphQL.Type.Out'.
|
||||
module Language.GraphQL.Type.In
|
||||
( Value(..)
|
||||
( Argument(..)
|
||||
, InputField(..)
|
||||
, InputObjectType(..)
|
||||
, Type(..)
|
||||
, Value(..)
|
||||
, isNonNullType
|
||||
, pattern EnumBaseType
|
||||
, pattern ListBaseType
|
||||
, pattern InputObjectBaseType
|
||||
, pattern ScalarBaseType
|
||||
) where
|
||||
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
@ -9,6 +23,28 @@ import Data.Int (Int32)
|
||||
import Data.String (IsString(..))
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
import Language.GraphQL.Type.Definition
|
||||
|
||||
-- | Single field of an 'InputObjectType'.
|
||||
data InputField = InputField (Maybe Text) Type (Maybe Value)
|
||||
|
||||
-- | Input object type definition.
|
||||
--
|
||||
-- An input object defines a structured collection of fields which may be
|
||||
-- supplied to a field argument.
|
||||
data InputObjectType = InputObjectType
|
||||
Name (Maybe Text) (HashMap Name InputField)
|
||||
|
||||
-- | These types may be used as input types for arguments and directives.
|
||||
data Type
|
||||
= NamedScalarType ScalarType
|
||||
| NamedEnumType EnumType
|
||||
| NamedInputObjectType InputObjectType
|
||||
| ListType Type
|
||||
| NonNullScalarType ScalarType
|
||||
| NonNullEnumType EnumType
|
||||
| NonNullInputObjectType InputObjectType
|
||||
| NonNullListType Type
|
||||
|
||||
-- | Represents accordingly typed GraphQL values.
|
||||
data Value
|
||||
@ -24,3 +60,52 @@ data Value
|
||||
|
||||
instance IsString Value where
|
||||
fromString = String . fromString
|
||||
|
||||
-- | Field argument definition.
|
||||
data Argument = Argument (Maybe Text) Type (Maybe Value)
|
||||
|
||||
-- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
|
||||
pattern ScalarBaseType :: ScalarType -> Type
|
||||
pattern ScalarBaseType scalarType <- (isScalarType -> Just scalarType)
|
||||
|
||||
-- | Matches either 'NamedEnumType' or 'NonNullEnumType'.
|
||||
pattern EnumBaseType :: EnumType -> Type
|
||||
pattern EnumBaseType enumType <- (isEnumType -> Just enumType)
|
||||
|
||||
-- | Matches either 'NamedInputObjectType' or 'NonNullInputObjectType'.
|
||||
pattern InputObjectBaseType :: InputObjectType -> Type
|
||||
pattern InputObjectBaseType objectType <- (isInputObjectType -> Just objectType)
|
||||
|
||||
-- | Matches either 'ListType' or 'NonNullListType'.
|
||||
pattern ListBaseType :: Type -> Type
|
||||
pattern ListBaseType listType <- (isListType -> Just listType)
|
||||
|
||||
{-# COMPLETE EnumBaseType, ListBaseType, InputObjectBaseType, ScalarBaseType #-}
|
||||
|
||||
isScalarType :: Type -> Maybe ScalarType
|
||||
isScalarType (NamedScalarType inputType) = Just inputType
|
||||
isScalarType (NonNullScalarType inputType) = Just inputType
|
||||
isScalarType _ = Nothing
|
||||
|
||||
isInputObjectType :: Type -> Maybe InputObjectType
|
||||
isInputObjectType (NamedInputObjectType inputType) = Just inputType
|
||||
isInputObjectType (NonNullInputObjectType inputType) = Just inputType
|
||||
isInputObjectType _ = Nothing
|
||||
|
||||
isEnumType :: Type -> Maybe EnumType
|
||||
isEnumType (NamedEnumType inputType) = Just inputType
|
||||
isEnumType (NonNullEnumType inputType) = Just inputType
|
||||
isEnumType _ = Nothing
|
||||
|
||||
isListType :: Type -> Maybe Type
|
||||
isListType (ListType inputType) = Just inputType
|
||||
isListType (NonNullListType inputType) = Just inputType
|
||||
isListType _ = Nothing
|
||||
|
||||
-- | Checks whether the given input type is a non-null type.
|
||||
isNonNullType :: Type -> Bool
|
||||
isNonNullType (NonNullScalarType _) = True
|
||||
isNonNullType (NonNullEnumType _) = True
|
||||
isNonNullType (NonNullInputObjectType _) = True
|
||||
isNonNullType (NonNullListType _) = True
|
||||
isNonNullType _ = False
|
||||
|
||||
@ -1,9 +1,22 @@
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
-- | This module is intended to be imported qualified, to avoid name clashes
|
||||
-- | Output types and values.
|
||||
--
|
||||
-- This module is intended to be imported qualified, to avoid name clashes
|
||||
-- with 'Language.GraphQL.Type.In'.
|
||||
module Language.GraphQL.Type.Out
|
||||
( Value(..)
|
||||
( Field(..)
|
||||
, ObjectType(..)
|
||||
, Type(..)
|
||||
, Value(..)
|
||||
, isNonNullType
|
||||
, pattern EnumBaseType
|
||||
, pattern ListBaseType
|
||||
, pattern ObjectBaseType
|
||||
, pattern ScalarBaseType
|
||||
) where
|
||||
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
@ -14,6 +27,32 @@ import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
import Language.GraphQL.Trans
|
||||
import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
--
|
||||
-- | Object type definition.
|
||||
--
|
||||
-- Almost all of the GraphQL types you define will be object types. Object
|
||||
-- types have a name, but most importantly describe their fields.
|
||||
data ObjectType m = ObjectType Name (Maybe Text) (HashMap Name (Field m))
|
||||
|
||||
-- | Output object field definition.
|
||||
data Field m = Field
|
||||
(Maybe Text) -- ^ Description.
|
||||
(Type m) -- ^ Field type.
|
||||
(HashMap Name In.Argument) -- ^ Arguments.
|
||||
(ActionT m (Value m)) -- ^ Resolver.
|
||||
|
||||
-- | These types may be used as output types as the result of fields.
|
||||
data Type m
|
||||
= NamedScalarType ScalarType
|
||||
| NamedEnumType EnumType
|
||||
| NamedObjectType (ObjectType m)
|
||||
| ListType (Type m)
|
||||
| NonNullScalarType ScalarType
|
||||
| NonNullEnumType EnumType
|
||||
| NonNullObjectType (ObjectType m)
|
||||
| NonNullListType (Type m)
|
||||
|
||||
-- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
|
||||
-- type can wrap other wrapping or named types. Wrapping types are lists and
|
||||
@ -37,7 +76,7 @@ instance IsString (Value m) where
|
||||
|
||||
instance Show (Value m) where
|
||||
show (Int integer) = "Int " ++ show integer
|
||||
show (Float float) = "Float " ++ show float
|
||||
show (Float float') = "Float " ++ show float'
|
||||
show (String text) = Text.unpack $ "String " <> text
|
||||
show (Boolean True) = "Boolean True"
|
||||
show (Boolean False) = "Boolean False"
|
||||
@ -56,3 +95,49 @@ instance Eq (Value m) where
|
||||
(List this) == (List that) = this == that
|
||||
(Object this) == (Object that) = HashMap.keys this == HashMap.keys that
|
||||
_ == _ = False
|
||||
|
||||
-- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
|
||||
pattern ScalarBaseType :: forall m. ScalarType -> Type m
|
||||
pattern ScalarBaseType scalarType <- (isScalarType -> Just scalarType)
|
||||
|
||||
-- | Matches either 'NamedEnumType' or 'NonNullEnumType'.
|
||||
pattern EnumBaseType :: forall m. EnumType -> Type m
|
||||
pattern EnumBaseType enumType <- (isEnumType -> Just enumType)
|
||||
|
||||
-- | Matches either 'NamedObjectType' or 'NonNullObjectType'.
|
||||
pattern ObjectBaseType :: forall m. ObjectType m -> Type m
|
||||
pattern ObjectBaseType objectType <- (isObjectType -> Just objectType)
|
||||
|
||||
-- | Matches either 'ListType' or 'NonNullListType'.
|
||||
pattern ListBaseType :: forall m. Type m -> Type m
|
||||
pattern ListBaseType listType <- (isListType -> Just listType)
|
||||
|
||||
{-# COMPLETE ScalarBaseType, EnumBaseType, ObjectBaseType, ListBaseType #-}
|
||||
|
||||
isScalarType :: forall m. Type m -> Maybe ScalarType
|
||||
isScalarType (NamedScalarType outputType) = Just outputType
|
||||
isScalarType (NonNullScalarType outputType) = Just outputType
|
||||
isScalarType _ = Nothing
|
||||
|
||||
isObjectType :: forall m. Type m -> Maybe (ObjectType m)
|
||||
isObjectType (NamedObjectType outputType) = Just outputType
|
||||
isObjectType (NonNullObjectType outputType) = Just outputType
|
||||
isObjectType _ = Nothing
|
||||
|
||||
isEnumType :: forall m. Type m -> Maybe EnumType
|
||||
isEnumType (NamedEnumType outputType) = Just outputType
|
||||
isEnumType (NonNullEnumType outputType) = Just outputType
|
||||
isEnumType _ = Nothing
|
||||
|
||||
isListType :: forall m. Type m -> Maybe (Type m)
|
||||
isListType (ListType outputType) = Just outputType
|
||||
isListType (NonNullListType outputType) = Just outputType
|
||||
isListType _ = Nothing
|
||||
|
||||
-- | Checks whether the given output type is a non-null type.
|
||||
isNonNullType :: forall m. Type m -> Bool
|
||||
isNonNullType (NonNullScalarType _) = True
|
||||
isNonNullType (NonNullEnumType _) = True
|
||||
isNonNullType (NonNullObjectType _) = True
|
||||
isNonNullType (NonNullListType _) = True
|
||||
isNonNullType _ = False
|
||||
|
||||
@ -3,13 +3,23 @@
|
||||
-- | Schema Definition.
|
||||
module Language.GraphQL.Type.Schema
|
||||
( Schema(..)
|
||||
, Type(..)
|
||||
, collectReferencedTypes
|
||||
) where
|
||||
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Language.GraphQL.AST.Core (Name)
|
||||
import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type.Definition as Definition
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
|
||||
-- | These are all of the possible kinds of types.
|
||||
data Type m
|
||||
= ScalarType Definition.ScalarType
|
||||
| EnumType Definition.EnumType
|
||||
| ObjectType (Out.ObjectType m)
|
||||
| InputObjectType In.InputObjectType
|
||||
|
||||
-- | A Schema is created by supplying the root types of each type of operation,
|
||||
-- query and mutation (optional). A schema definition is then supplied to the
|
||||
@ -19,12 +29,12 @@ import Language.GraphQL.Type.Definition
|
||||
-- are reachable by traversing the root types are included, other types must
|
||||
-- be explicitly referenced.
|
||||
data Schema m = Schema
|
||||
{ query :: ObjectType m
|
||||
, mutation :: Maybe (ObjectType m)
|
||||
{ query :: Out.ObjectType m
|
||||
, mutation :: Maybe (Out.ObjectType m)
|
||||
}
|
||||
|
||||
-- | Traverses the schema and finds all referenced types.
|
||||
collectReferencedTypes :: forall m. Schema m -> HashMap Name (TypeDefinition m)
|
||||
collectReferencedTypes :: forall m. Schema m -> HashMap Name (Type m)
|
||||
collectReferencedTypes schema =
|
||||
let queryTypes = traverseObjectType (query schema) HashMap.empty
|
||||
in maybe queryTypes (`traverseObjectType` queryTypes) $ mutation schema
|
||||
@ -33,36 +43,36 @@ collectReferencedTypes schema =
|
||||
let newMap = HashMap.insert typeName element foundTypes
|
||||
in maybe (traverser newMap) (const foundTypes)
|
||||
$ HashMap.lookup typeName foundTypes
|
||||
visitFields (Field _ outputType arguments _) foundTypes
|
||||
visitFields (Out.Field _ outputType arguments _) foundTypes
|
||||
= traverseOutputType outputType
|
||||
$ foldr visitArguments foundTypes arguments
|
||||
visitArguments (Argument _ inputType _) = traverseInputType inputType
|
||||
visitInputFields (InputField _ inputType _) = traverseInputType inputType
|
||||
traverseInputType (ObjectInputTypeDefinition objectType) =
|
||||
let (InputObjectType typeName _ inputFields) = objectType
|
||||
element = InputObjectTypeDefinition objectType
|
||||
visitArguments (In.Argument _ inputType _) = traverseInputType inputType
|
||||
visitInputFields (In.InputField _ inputType _) = traverseInputType inputType
|
||||
traverseInputType (In.InputObjectBaseType objectType) =
|
||||
let (In.InputObjectType typeName _ inputFields) = objectType
|
||||
element = InputObjectType objectType
|
||||
traverser = flip (foldr visitInputFields) inputFields
|
||||
in collect traverser typeName element
|
||||
traverseInputType (ListInputTypeDefinition listType) =
|
||||
traverseInputType (In.ListBaseType listType) =
|
||||
traverseInputType listType
|
||||
traverseInputType (ScalarInputTypeDefinition scalarType) =
|
||||
let (ScalarType typeName _) = scalarType
|
||||
in collect Prelude.id typeName (ScalarTypeDefinition scalarType)
|
||||
traverseInputType (EnumInputTypeDefinition enumType) =
|
||||
let (EnumType typeName _ _) = enumType
|
||||
in collect Prelude.id typeName (EnumTypeDefinition enumType)
|
||||
traverseOutputType (ObjectOutputTypeDefinition objectType) =
|
||||
traverseInputType (In.ScalarBaseType scalarType) =
|
||||
let (Definition.ScalarType typeName _) = scalarType
|
||||
in collect Prelude.id typeName (ScalarType scalarType)
|
||||
traverseInputType (In.EnumBaseType enumType) =
|
||||
let (Definition.EnumType typeName _ _) = enumType
|
||||
in collect Prelude.id typeName (EnumType enumType)
|
||||
traverseOutputType (Out.ObjectBaseType objectType) =
|
||||
traverseObjectType objectType
|
||||
traverseOutputType (ListOutputTypeDefinition listType) =
|
||||
traverseOutputType (Out.ListBaseType listType) =
|
||||
traverseOutputType listType
|
||||
traverseOutputType (ScalarOutputTypeDefinition scalarType) =
|
||||
let (ScalarType typeName _) = scalarType
|
||||
in collect Prelude.id typeName (ScalarTypeDefinition scalarType)
|
||||
traverseOutputType (EnumOutputTypeDefinition enumType) =
|
||||
let (EnumType typeName _ _) = enumType
|
||||
in collect Prelude.id typeName (EnumTypeDefinition enumType)
|
||||
traverseOutputType (Out.ScalarBaseType scalarType) =
|
||||
let (Definition.ScalarType typeName _) = scalarType
|
||||
in collect Prelude.id typeName (ScalarType scalarType)
|
||||
traverseOutputType (Out.EnumBaseType enumType) =
|
||||
let (Definition.EnumType typeName _ _) = enumType
|
||||
in collect Prelude.id typeName (EnumType enumType)
|
||||
traverseObjectType objectType foundTypes =
|
||||
let (ObjectType typeName _ objectFields) = objectType
|
||||
element = ObjectTypeDefinition objectType
|
||||
let (Out.ObjectType typeName _ objectFields) = objectType
|
||||
element = ObjectType objectType
|
||||
traverser = flip (foldr visitFields) objectFields
|
||||
in collect traverser typeName element foundTypes
|
||||
|
||||
@ -23,7 +23,7 @@ direction :: EnumType
|
||||
direction = EnumType "Direction" Nothing
|
||||
$ Set.fromList ["NORTH", "EAST", "SOUTH", "WEST"]
|
||||
|
||||
coerceInputLiteral :: InputType -> In.Value -> Maybe Subs
|
||||
coerceInputLiteral :: In.Type -> In.Value -> Maybe Subs
|
||||
coerceInputLiteral input value = coerceInputLiterals
|
||||
(HashMap.singleton "variableName" input)
|
||||
(HashMap.singleton "variableName" value)
|
||||
@ -31,12 +31,12 @@ coerceInputLiteral input value = coerceInputLiterals
|
||||
lookupActual :: Maybe (HashMap Name In.Value) -> Maybe In.Value
|
||||
lookupActual = (HashMap.lookup "variableName" =<<)
|
||||
|
||||
singletonInputObject :: InputType
|
||||
singletonInputObject = ObjectInputType type'
|
||||
singletonInputObject :: In.Type
|
||||
singletonInputObject = In.NamedInputObjectType type'
|
||||
where
|
||||
type' = InputObjectType "ObjectName" Nothing inputFields
|
||||
type' = In.InputObjectType "ObjectName" Nothing inputFields
|
||||
inputFields = HashMap.singleton "field" field
|
||||
field = InputField Nothing (ScalarInputType string) Nothing
|
||||
field = In.InputField Nothing (In.NamedScalarType string) Nothing
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
@ -44,36 +44,36 @@ spec = do
|
||||
it "coerces strings" $
|
||||
let expected = Just (In.String "asdf")
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType string) (Aeson.String "asdf")
|
||||
(In.NamedScalarType string) (Aeson.String "asdf")
|
||||
in actual `shouldBe` expected
|
||||
it "coerces non-null strings" $
|
||||
let expected = Just (In.String "asdf")
|
||||
actual = coerceVariableValue
|
||||
(NonNullScalarInputType string) (Aeson.String "asdf")
|
||||
(In.NonNullScalarType string) (Aeson.String "asdf")
|
||||
in actual `shouldBe` expected
|
||||
it "coerces booleans" $
|
||||
let expected = Just (In.Boolean True)
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType boolean) (Aeson.Bool True)
|
||||
(In.NamedScalarType boolean) (Aeson.Bool True)
|
||||
in actual `shouldBe` expected
|
||||
it "coerces zero to an integer" $
|
||||
let expected = Just (In.Int 0)
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType int) (Aeson.Number 0)
|
||||
(In.NamedScalarType int) (Aeson.Number 0)
|
||||
in actual `shouldBe` expected
|
||||
it "rejects fractional if an integer is expected" $
|
||||
let actual = coerceVariableValue
|
||||
(ScalarInputType int) (Aeson.Number $ scientific 14 (-1))
|
||||
(In.NamedScalarType int) (Aeson.Number $ scientific 14 (-1))
|
||||
in actual `shouldSatisfy` isNothing
|
||||
it "coerces float numbers" $
|
||||
let expected = Just (In.Float 1.4)
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType float) (Aeson.Number $ scientific 14 (-1))
|
||||
(In.NamedScalarType float) (Aeson.Number $ scientific 14 (-1))
|
||||
in actual `shouldBe` expected
|
||||
it "coerces IDs" $
|
||||
let expected = Just (In.String "1234")
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType id) (Aeson.String "1234")
|
||||
(In.NamedScalarType id) (Aeson.String "1234")
|
||||
in actual `shouldBe` expected
|
||||
it "coerces input objects" $
|
||||
let actual = coerceVariableValue singletonInputObject
|
||||
@ -94,11 +94,11 @@ spec = do
|
||||
]
|
||||
in actual `shouldSatisfy` isNothing
|
||||
it "preserves null" $
|
||||
let actual = coerceVariableValue (ScalarInputType id) Aeson.Null
|
||||
let actual = coerceVariableValue (In.NamedScalarType id) Aeson.Null
|
||||
in actual `shouldBe` Just In.Null
|
||||
it "preserves list order" $
|
||||
let list = Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"]
|
||||
listType = (ListInputType $ ScalarInputType string)
|
||||
listType = (In.ListType $ In.NamedScalarType string)
|
||||
actual = coerceVariableValue listType list
|
||||
expected = Just $ In.List [In.String "asdf", In.String "qwer"]
|
||||
in actual `shouldBe` expected
|
||||
@ -107,13 +107,13 @@ spec = do
|
||||
it "coerces enums" $
|
||||
let expected = Just (In.Enum "NORTH")
|
||||
actual = coerceInputLiteral
|
||||
(EnumInputType direction) (In.Enum "NORTH")
|
||||
(In.NamedEnumType direction) (In.Enum "NORTH")
|
||||
in lookupActual actual `shouldBe` expected
|
||||
it "fails with non-existing enum value" $
|
||||
let actual = coerceInputLiteral
|
||||
(EnumInputType direction) (In.Enum "NORTH_EAST")
|
||||
(In.NamedEnumType direction) (In.Enum "NORTH_EAST")
|
||||
in actual `shouldSatisfy` isNothing
|
||||
it "coerces integers to IDs" $
|
||||
let expected = Just (In.String "1234")
|
||||
actual = coerceInputLiteral (ScalarInputType id) (In.Int 1234)
|
||||
actual = coerceInputLiteral (In.NamedScalarType id) (In.Int 1234)
|
||||
in lookupActual actual `shouldBe` expected
|
||||
|
||||
@ -17,9 +17,9 @@ experimentalResolver :: Schema IO
|
||||
experimentalResolver = Schema { query = queryType, mutation = Nothing }
|
||||
where
|
||||
resolver = pure $ Out.Int 5
|
||||
queryType = ObjectType "Query" Nothing
|
||||
queryType = Out.ObjectType "Query" Nothing
|
||||
$ HashMap.singleton "experimentalField"
|
||||
$ Field Nothing (ScalarOutputType int) mempty resolver
|
||||
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolver
|
||||
|
||||
emptyObject :: Value
|
||||
emptyObject = object
|
||||
|
||||
@ -50,17 +50,17 @@ hasErrors :: Value -> Bool
|
||||
hasErrors (Object object') = HashMap.member "errors" object'
|
||||
hasErrors _ = True
|
||||
|
||||
shirtType :: ObjectType IO
|
||||
shirtType = ObjectType "Shirt" Nothing
|
||||
shirtType :: Out.ObjectType IO
|
||||
shirtType = Out.ObjectType "Shirt" Nothing
|
||||
$ HashMap.singleton resolverName
|
||||
$ Field Nothing (ScalarOutputType string) mempty resolve
|
||||
$ Out.Field Nothing (Out.NamedScalarType string) mempty resolve
|
||||
where
|
||||
(Schema.Resolver resolverName resolve) = size
|
||||
|
||||
hatType :: ObjectType IO
|
||||
hatType = ObjectType "Hat" Nothing
|
||||
hatType :: Out.ObjectType IO
|
||||
hatType = Out.ObjectType "Hat" Nothing
|
||||
$ HashMap.singleton resolverName
|
||||
$ Field Nothing (ScalarOutputType int) mempty resolve
|
||||
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
|
||||
where
|
||||
(Schema.Resolver resolverName resolve) = circumference
|
||||
|
||||
@ -69,9 +69,9 @@ toSchema (Schema.Resolver resolverName resolve) = Schema
|
||||
{ query = queryType, mutation = Nothing }
|
||||
where
|
||||
unionMember = if resolverName == "Hat" then hatType else shirtType
|
||||
queryType = ObjectType "Query" Nothing
|
||||
queryType = Out.ObjectType "Query" Nothing
|
||||
$ HashMap.singleton resolverName
|
||||
$ Field Nothing (ObjectOutputType unionMember) mempty resolve
|
||||
$ Out.Field Nothing (Out.NamedObjectType unionMember) mempty resolve
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
|
||||
@ -14,27 +14,27 @@ import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Language.GraphQL.Type.Schema
|
||||
|
||||
hatType :: ObjectType IO
|
||||
hatType = ObjectType "Hat" Nothing
|
||||
hatType :: Out.ObjectType IO
|
||||
hatType = Out.ObjectType "Hat" Nothing
|
||||
$ HashMap.singleton resolverName
|
||||
$ Field Nothing (ScalarOutputType int) mempty resolve
|
||||
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
|
||||
where
|
||||
(Schema.Resolver resolverName resolve) =
|
||||
Schema.Resolver "circumference" $ pure $ Out.Int 60
|
||||
|
||||
schema :: Schema IO
|
||||
schema = Schema
|
||||
(ObjectType "Query" Nothing hatField)
|
||||
(Just $ ObjectType "Mutation" Nothing incrementField)
|
||||
(Out.ObjectType "Query" Nothing hatField)
|
||||
(Just $ Out.ObjectType "Mutation" Nothing incrementField)
|
||||
where
|
||||
garment = pure $ Schema.object
|
||||
[ Schema.Resolver "circumference" $ pure $ Out.Int 60
|
||||
]
|
||||
incrementField = HashMap.singleton "incrementCircumference"
|
||||
$ Field Nothing (ScalarOutputType int) mempty
|
||||
$ Out.Field Nothing (Out.NamedScalarType int) mempty
|
||||
$ pure $ Out.Int 61
|
||||
hatField = HashMap.singleton "garment"
|
||||
$ Field Nothing (ObjectOutputType hatType) mempty garment
|
||||
$ Out.Field Nothing (Out.NamedObjectType hatType) mempty garment
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
|
||||
@ -184,7 +184,7 @@ getFriends :: Character -> [Character]
|
||||
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
|
||||
|
||||
getEpisode :: Int -> Maybe Text
|
||||
getEpisode 4 = pure $ "NEWHOPE"
|
||||
getEpisode 5 = pure $ "EMPIRE"
|
||||
getEpisode 6 = pure $ "JEDI"
|
||||
getEpisode 4 = pure "NEWHOPE"
|
||||
getEpisode 5 = pure "EMPIRE"
|
||||
getEpisode 6 = pure "JEDI"
|
||||
getEpisode _ = empty
|
||||
|
||||
@ -25,10 +25,10 @@ import Test.StarWars.Data
|
||||
schema :: Schema Identity
|
||||
schema = Schema { query = queryType, mutation = Nothing }
|
||||
where
|
||||
queryType = ObjectType "Query" Nothing $ HashMap.fromList
|
||||
[ ("hero", Field Nothing (ScalarOutputType string) mempty hero)
|
||||
, ("human", Field Nothing (ScalarOutputType string) mempty human)
|
||||
, ("droid", Field Nothing (ScalarOutputType string) mempty droid)
|
||||
queryType = Out.ObjectType "Query" Nothing $ HashMap.fromList
|
||||
[ ("hero", Out.Field Nothing (Out.NamedScalarType string) mempty hero)
|
||||
, ("human", Out.Field Nothing (Out.NamedScalarType string) mempty human)
|
||||
, ("droid", Out.Field Nothing (Out.NamedScalarType string) mempty droid)
|
||||
]
|
||||
|
||||
hero :: ActionT Identity (Out.Value Identity)
|
||||
@ -55,7 +55,7 @@ droid :: ActionT Identity (Out.Value Identity)
|
||||
droid = do
|
||||
id' <- argument "id"
|
||||
case id' of
|
||||
In.String i -> getDroid i >>= pure . character
|
||||
In.String i -> character <$> getDroid i
|
||||
_ -> ActionT $ throwE "Invalid arguments."
|
||||
|
||||
character :: Character -> Out.Value Identity
|
||||
@ -63,7 +63,7 @@ character char = Schema.object
|
||||
[ 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
|
||||
$ pure $ Out.List $ character <$> getFriends char
|
||||
, Schema.Resolver "appearsIn" $ pure
|
||||
$ Out.List $ Out.Enum <$> catMaybes (getEpisode <$> appearsIn char)
|
||||
, Schema.Resolver "secretBackstory" $ Out.String
|
||||
|
||||
Loading…
Reference in New Issue
Block a user