prescientmoon/graphql
1
0
Fork 0
forked from OSS/graphql
Code Pull Requests Activity

Split input/output types and values into 2 modules

Browse Source
This commit is contained in:
Eugen Wissner 2020-05-25 07:41:21 +02:00
parent eb90a4091c
commit 61dbe6c728
16 changed files with 325 additions and 308 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
CHANGELOG.md
View File

@ -29,13 +29,17 @@ and this project adheres to
`AST.Document.Document` into `Execute.Transform.Document`. `AST.Document.Document` into `Execute.Transform.Document`.
- `AST.Core.Value` was moved into `Type.In`. Input values are used only in the - `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. 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 ### 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 - `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 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. 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 - `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 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 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 GraphQL. E.g. GraphQL distinguishes between Floats and Integersa and we need
a way to represent objects as a "Field Name -> Resolver" map. a way to represent objects as a "Field Name -> Resolver" map.
- `Schema.wrappedObject`. `Schema.object` creates now wrapped objects. - `Schema.wrappedObject`. `Schema.object` creates now wrapped objects.
- `Type` module. Superseded by `Type.Out`.
## [0.7.0.0] - 2020-05-11 ## [0.7.0.0] - 2020-05-11
### Fixed ### Fixed

24
docs/tutorial/tutorial.lhs
View File

@ -23,9 +23,9 @@ Since this file is a literate haskell file, we start by importing some dependenc
> import Data.Time (getCurrentTime) > import Data.Time (getCurrentTime)
> >
> import Language.GraphQL > import Language.GraphQL
> import Language.GraphQL.Type.Definition > import Language.GraphQL.Trans
> import Language.GraphQL.Type.Schema > import Language.GraphQL.Type
> import qualified Language.GraphQL.Type as Type > import qualified Language.GraphQL.Type.Out as Out
> >
> import Prelude hiding (putStrLn) > import Prelude hiding (putStrLn)
@ -42,10 +42,10 @@ First we build a GraphQL schema.
> queryType :: ObjectType IO > queryType :: ObjectType IO
> queryType = ObjectType "Query" Nothing > queryType = ObjectType "Query" Nothing
> $ HashMap.singleton "hello" > $ HashMap.singleton "hello"
> $ Field Nothing (ScalarOutputType string) mempty hello > $ Field Nothing (Out.NamedScalarType string) mempty hello
> >
> hello :: FieldResolver IO > hello :: ActionT IO (Out.Value IO)
> hello = NestingResolver $ pure $ Type.S "it's me" > hello = pure $ Out.String "it's me"
This defines a simple schema with one type and one field, that resolves to a fixed value. 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 IO
> queryType2 = ObjectType "Query" Nothing > queryType2 = ObjectType "Query" Nothing
> $ HashMap.singleton "time" > $ HashMap.singleton "time"
> $ Field Nothing (ScalarOutputType string) mempty time > $ Field Nothing (Out.NamedScalarType string) mempty time
> >
> time :: FieldResolver IO > time :: ActionT IO (Out.Value IO)
> time = NestingResolver $ do > time = do
> t <- liftIO getCurrentTime > 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, This defines a simple schema with one type and one field,
which resolves to the current time. 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 IO
> queryType3 = ObjectType "Query" Nothing $ HashMap.fromList > queryType3 = ObjectType "Query" Nothing $ HashMap.fromList
> [ ("hello", Field Nothing (ScalarOutputType string) mempty hello) > [ ("hello", Field Nothing (Out.NamedScalarType string) mempty hello)
> , ("time", Field Nothing (ScalarOutputType string) mempty time) > , ("time", Field Nothing (Out.NamedScalarType string) mempty time)
> ] > ]
> >
> query3 :: Text > query3 :: Text

6
src/Language/GraphQL/Execute.hs
View File

@ -16,7 +16,7 @@ import Language.GraphQL.Execute.Coerce
import qualified Language.GraphQL.Execute.Transform as Transform import qualified Language.GraphQL.Execute.Transform as Transform
import Language.GraphQL.Error import Language.GraphQL.Error
import qualified Language.GraphQL.Schema as Schema 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 import Language.GraphQL.Type.Schema
-- | The substitution is applied to the document, and the resolvers are applied -- | The substitution is applied to the document, and the resolvers are applied
@ -66,7 +66,7 @@ operation = schemaOperation
. flip Schema.resolve queryFields . flip Schema.resolve queryFields
. fmap getResolver . fmap getResolver
. fields . fields
fields (Definition.ObjectType _ _ objectFields) = objectFields fields (Out.ObjectType _ _ objectFields) = objectFields
lookupError = pure lookupError = pure
$ singleError "Root operation type couldn't be found in the schema." $ singleError "Root operation type couldn't be found in the schema."
schemaOperation Schema {query} (AST.Core.Query _ fields') = schemaOperation Schema {query} (AST.Core.Query _ fields') =
@ -75,4 +75,4 @@ operation = schemaOperation
resolve fields' mutation resolve fields' mutation
schemaOperation Schema {mutation = Nothing} (AST.Core.Mutation _ _) = schemaOperation Schema {mutation = Nothing} (AST.Core.Mutation _ _) =
lookupError lookupError
getResolver (Definition.Field _ _ _ resolver) = resolver getResolver (Out.Field _ _ _ resolver) = resolver

39
src/Language/GraphQL/Execute/Coerce.hs
View File

@ -4,7 +4,6 @@
module Language.GraphQL.Execute.Coerce module Language.GraphQL.Execute.Coerce
( VariableValue(..) ( VariableValue(..)
, coerceInputLiterals , coerceInputLiterals
, isNonNullInputType
) where ) where
import qualified Data.Aeson as Aeson 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 -- 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. -- be returned, the coercion will fail then and the query won't be executed.
coerceVariableValue 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. -> a -- ^ Variable value being coerced.
-> Maybe In.Value -- ^ Coerced value on success, 'Nothing' otherwise. -> Maybe In.Value -- ^ Coerced value on success, 'Nothing' otherwise.
instance VariableValue Aeson.Value where instance VariableValue Aeson.Value where
coerceVariableValue _ Aeson.Null = Just In.Null coerceVariableValue _ Aeson.Null = Just In.Null
coerceVariableValue (ScalarInputTypeDefinition scalarType) value coerceVariableValue (In.ScalarBaseType scalarType) value
| (Aeson.String stringValue) <- value = Just $ In.String stringValue | (Aeson.String stringValue) <- value = Just $ In.String stringValue
| (Aeson.Bool booleanValue) <- value = Just $ In.Boolean booleanValue | (Aeson.Bool booleanValue) <- value = Just $ In.Boolean booleanValue
| (Aeson.Number numberValue) <- value | (Aeson.Number numberValue) <- value
@ -59,11 +58,11 @@ instance VariableValue Aeson.Value where
Just $ In.Float $ toRealFloat numberValue Just $ In.Float $ toRealFloat numberValue
| (Aeson.Number numberValue) <- value = -- ID or Int | (Aeson.Number numberValue) <- value = -- ID or Int
In.Int <$> toBoundedInteger numberValue In.Int <$> toBoundedInteger numberValue
coerceVariableValue (EnumInputTypeDefinition _) (Aeson.String stringValue) = coerceVariableValue (In.EnumBaseType _) (Aeson.String stringValue) =
Just $ In.Enum stringValue Just $ In.Enum stringValue
coerceVariableValue (ObjectInputTypeDefinition objectType) value coerceVariableValue (In.InputObjectBaseType objectType) value
| (Aeson.Object objectValue) <- value = do | (Aeson.Object objectValue) <- value = do
let (InputObjectType _ _ inputFields) = objectType let (In.InputObjectType _ _ inputFields) = objectType
(newObjectValue, resultMap) <- foldWithKey objectValue inputFields (newObjectValue, resultMap) <- foldWithKey objectValue inputFields
if HashMap.null newObjectValue if HashMap.null newObjectValue
then Just $ In.Object resultMap then Just $ In.Object resultMap
@ -73,7 +72,7 @@ instance VariableValue Aeson.Value where
$ Just (objectValue, HashMap.empty) $ Just (objectValue, HashMap.empty)
matchFieldValues _ _ Nothing = Nothing matchFieldValues _ _ Nothing = Nothing
matchFieldValues fieldName inputField (Just (objectValue, resultMap)) = matchFieldValues fieldName inputField (Just (objectValue, resultMap)) =
let (InputField _ fieldType _) = inputField let (In.InputField _ fieldType _) = inputField
insert = flip (HashMap.insert fieldName) resultMap insert = flip (HashMap.insert fieldName) resultMap
newObjectValue = HashMap.delete fieldName objectValue newObjectValue = HashMap.delete fieldName objectValue
in case HashMap.lookup fieldName objectValue of in case HashMap.lookup fieldName objectValue of
@ -81,7 +80,7 @@ instance VariableValue Aeson.Value where
coerced <- coerceVariableValue fieldType variableValue coerced <- coerceVariableValue fieldType variableValue
pure (newObjectValue, insert coerced) pure (newObjectValue, insert coerced)
Nothing -> Just (objectValue, resultMap) Nothing -> Just (objectValue, resultMap)
coerceVariableValue (ListInputTypeDefinition listType) value coerceVariableValue (In.ListBaseType listType) value
| (Aeson.Array arrayValue) <- value = In.List | (Aeson.Array arrayValue) <- value = In.List
<$> foldr foldVector (Just []) arrayValue <$> foldr foldVector (Just []) arrayValue
| otherwise = coerceVariableValue listType value | otherwise = coerceVariableValue listType value
@ -95,7 +94,7 @@ instance VariableValue Aeson.Value where
-- | Coerces operation arguments according to the input coercion rules for the -- | Coerces operation arguments according to the input coercion rules for the
-- corresponding types. -- corresponding types.
coerceInputLiterals coerceInputLiterals
:: HashMap Name InputType :: HashMap Name In.Type
-> HashMap Name In.Value -> HashMap Name In.Value
-> Maybe Subs -> Maybe Subs
coerceInputLiterals variableTypes variableValues = coerceInputLiterals variableTypes variableValues =
@ -105,7 +104,7 @@ coerceInputLiterals variableTypes variableValues =
HashMap.insert variableName HashMap.insert variableName
<$> (lookupVariable variableName >>= coerceInputLiteral variableType) <$> (lookupVariable variableName >>= coerceInputLiteral variableType)
<*> resultMap <*> resultMap
coerceInputLiteral (ScalarInputType type') value coerceInputLiteral (In.NamedScalarType type') value
| (In.String stringValue) <- value | (In.String stringValue) <- value
, (ScalarType "String" _) <- type' = Just $ In.String stringValue , (ScalarType "String" _) <- type' = Just $ In.String stringValue
| (In.Boolean booleanValue) <- value | (In.Boolean booleanValue) <- value
@ -121,17 +120,17 @@ coerceInputLiterals variableTypes variableValues =
, (ScalarType "ID" _) <- type' = Just $ In.String stringValue , (ScalarType "ID" _) <- type' = Just $ In.String stringValue
| (In.Int intValue) <- value | (In.Int intValue) <- value
, (ScalarType "ID" _) <- type' = Just $ decimal intValue , (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 | member enumValue type' = Just $ In.Enum enumValue
coerceInputLiteral (ObjectInputType type') (In.Object _) = coerceInputLiteral (In.NamedInputObjectType type') (In.Object _) =
let (InputObjectType _ _ inputFields) = type' let (In.InputObjectType _ _ inputFields) = type'
in In.Object <$> foldWithKey matchFieldValues inputFields in In.Object <$> foldWithKey matchFieldValues inputFields
coerceInputLiteral _ _ = Nothing coerceInputLiteral _ _ = Nothing
member value (EnumType _ _ members) = Set.member value members 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 case lookupVariable fieldName of
Just In.Null Just In.Null
| isNonNullInputType type' -> Nothing | In.isNonNullType type' -> Nothing
| otherwise -> | otherwise ->
HashMap.insert fieldName In.Null <$> resultMap HashMap.insert fieldName In.Null <$> resultMap
Just variableValue -> HashMap.insert fieldName Just variableValue -> HashMap.insert fieldName
@ -141,7 +140,7 @@ coerceInputLiterals variableTypes variableValues =
| Just value <- defaultValue -> | Just value <- defaultValue ->
HashMap.insert fieldName value <$> resultMap HashMap.insert fieldName value <$> resultMap
| Nothing <- defaultValue | Nothing <- defaultValue
, isNonNullInputType type' -> Nothing , In.isNonNullType type' -> Nothing
| otherwise -> resultMap | otherwise -> resultMap
lookupVariable = flip HashMap.lookup variableValues lookupVariable = flip HashMap.lookup variableValues
foldWithKey f = HashMap.foldrWithKey f (Just HashMap.empty) foldWithKey f = HashMap.foldrWithKey f (Just HashMap.empty)
@ -149,11 +148,3 @@ coerceInputLiterals variableTypes variableValues =
. Text.Lazy.toStrict . Text.Lazy.toStrict
. Text.Builder.toLazyText . Text.Builder.toLazyText
. Text.Builder.decimal . 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

37
src/Language/GraphQL/Execute/Transform.hs
View File

@ -30,7 +30,6 @@ import qualified Language.GraphQL.AST as Full
import qualified Language.GraphQL.AST.Core as Core import qualified Language.GraphQL.AST.Core as Core
import Language.GraphQL.Execute.Coerce import Language.GraphQL.Execute.Coerce
import qualified Language.GraphQL.Schema as Schema 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.Directive as Directive
import qualified Language.GraphQL.Type.In as In import qualified Language.GraphQL.Type.In as In
import Language.GraphQL.Type.Schema import Language.GraphQL.Type.Schema
@ -86,31 +85,31 @@ getOperation (Just operationName) operations
lookupInputType lookupInputType
:: Full.Type :: Full.Type
-> HashMap.HashMap Full.Name (Definition.TypeDefinition m) -> HashMap.HashMap Full.Name (Type m)
-> Maybe Definition.InputType -> Maybe In.Type
lookupInputType (Full.TypeNamed name) types = lookupInputType (Full.TypeNamed name) types =
case HashMap.lookup name types of case HashMap.lookup name types of
Just (Definition.ScalarTypeDefinition scalarType) -> Just (ScalarType scalarType) ->
Just $ Definition.ScalarInputType scalarType Just $ In.NamedScalarType scalarType
Just (Definition.EnumTypeDefinition enumType) -> Just (EnumType enumType) ->
Just $ Definition.EnumInputType enumType Just $ In.NamedEnumType enumType
Just (Definition.InputObjectTypeDefinition objectType) -> Just (InputObjectType objectType) ->
Just $ Definition.ObjectInputType objectType Just $ In.NamedInputObjectType objectType
_ -> Nothing _ -> Nothing
lookupInputType (Full.TypeList list) types lookupInputType (Full.TypeList list) types
= Definition.ListInputType = In.ListType
<$> lookupInputType list types <$> lookupInputType list types
lookupInputType (Full.TypeNonNull (Full.NonNullTypeNamed nonNull)) types = lookupInputType (Full.TypeNonNull (Full.NonNullTypeNamed nonNull)) types =
case HashMap.lookup nonNull types of case HashMap.lookup nonNull types of
Just (Definition.ScalarTypeDefinition scalarType) -> Just (ScalarType scalarType) ->
Just $ Definition.NonNullScalarInputType scalarType Just $ In.NonNullScalarType scalarType
Just (Definition.EnumTypeDefinition enumType) -> Just (EnumType enumType) ->
Just $ Definition.NonNullEnumInputType enumType Just $ In.NonNullEnumType enumType
Just (Definition.InputObjectTypeDefinition objectType) -> Just (InputObjectType objectType) ->
Just $ Definition.NonNullObjectInputType objectType Just $ In.NonNullInputObjectType objectType
_ -> Nothing _ -> Nothing
lookupInputType (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types lookupInputType (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types
= Definition.NonNullListInputType = In.NonNullListType
<$> lookupInputType nonNull types <$> lookupInputType nonNull types
coerceVariableValues :: (Monad m, VariableValue a) coerceVariableValues :: (Monad m, VariableValue a)
@ -137,10 +136,10 @@ coerceVariableValues schema operationDefinition variableValues' =
<*> coercedValues <*> coercedValues
choose Nothing defaultValue variableType choose Nothing defaultValue variableType
| Just _ <- defaultValue = defaultValue | Just _ <- defaultValue = defaultValue
| not (isNonNullInputType variableType) = Just In.Null | not (In.isNonNullType variableType) = Just In.Null
choose (Just value') _ variableType choose (Just value') _ variableType
| Just coercedValue <- coerceVariableValue variableType value' | Just coercedValue <- coerceVariableValue variableType value'
, not (isNonNullInputType variableType) || coercedValue /= In.Null = , not (In.isNonNullType variableType) || coercedValue /= In.Null =
Just coercedValue Just coercedValue
choose _ _ _ = Nothing choose _ _ _ = Nothing

14
src/Language/GraphQL/Type.hs Normal file
View 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

174
src/Language/GraphQL/Type/Definition.hs
View File

@ -1,28 +1,9 @@
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-} {-# 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 module Language.GraphQL.Type.Definition
( Argument(..) ( EnumType(..)
, EnumType(..)
, Field(..)
, InputField(..)
, InputObjectType(..)
, InputType(..)
, ObjectType(..)
, OutputType(..)
, ScalarType(..) , ScalarType(..)
, TypeDefinition(..)
, pattern EnumInputTypeDefinition
, pattern ListInputTypeDefinition
, pattern ObjectInputTypeDefinition
, pattern ScalarInputTypeDefinition
, pattern EnumOutputTypeDefinition
, pattern ListOutputTypeDefinition
, pattern ObjectOutputTypeDefinition
, pattern ScalarOutputTypeDefinition
, boolean , boolean
, float , float
, id , id
@ -30,31 +11,11 @@ module Language.GraphQL.Type.Definition
, string , string
) where ) where
import Data.HashMap.Strict (HashMap)
import Data.Set (Set) import Data.Set (Set)
import Data.Text (Text) import Data.Text (Text)
import Language.GraphQL.AST.Document (Name) 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) 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. -- | Scalar type definition.
-- --
-- The leaf values of any request and input values to arguments are Scalars (or -- 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. -- kind of type, often integers.
data EnumType = EnumType Name (Maybe Text) (Set Text) 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 -- | The @String@ scalar type represents textual data, represented as UTF-8
-- character sequences. The String type is most often used by GraphQL to -- character sequences. The String type is most often used by GraphQL to
-- represent free-form human-readable text. -- 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 \ \JSON response as a String; however, it is not intended to be \
\human-readable. When expected as an input type, any string (such as \ \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." \`\"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

89
src/Language/GraphQL/Type/In.hs
View File

@ -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'. -- with 'Language.GraphQL.Type.Out'.
module Language.GraphQL.Type.In module Language.GraphQL.Type.In
( Value(..) ( Argument(..)
, InputField(..)
, InputObjectType(..)
, Type(..)
, Value(..)
, isNonNullType
, pattern EnumBaseType
, pattern ListBaseType
, pattern InputObjectBaseType
, pattern ScalarBaseType
) where ) where
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
@ -9,6 +23,28 @@ import Data.Int (Int32)
import Data.String (IsString(..)) import Data.String (IsString(..))
import Data.Text (Text) import Data.Text (Text)
import Language.GraphQL.AST.Document (Name) 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. -- | Represents accordingly typed GraphQL values.
data Value data Value
@ -24,3 +60,52 @@ data Value
instance IsString Value where instance IsString Value where
fromString = String . fromString 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

91
src/Language/GraphQL/Type/Out.hs
View File

@ -1,9 +1,22 @@
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-} {-# 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'. -- with 'Language.GraphQL.Type.In'.
module Language.GraphQL.Type.Out module Language.GraphQL.Type.Out
( Value(..) ( Field(..)
, ObjectType(..)
, Type(..)
, Value(..)
, isNonNullType
, pattern EnumBaseType
, pattern ListBaseType
, pattern ObjectBaseType
, pattern ScalarBaseType
) where ) where
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
@ -14,6 +27,32 @@ import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import Language.GraphQL.AST.Document (Name) import Language.GraphQL.AST.Document (Name)
import Language.GraphQL.Trans 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 -- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
-- type can wrap other wrapping or named types. Wrapping types are lists and -- 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 instance Show (Value m) where
show (Int integer) = "Int " ++ show integer 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 (String text) = Text.unpack $ "String " <> text
show (Boolean True) = "Boolean True" show (Boolean True) = "Boolean True"
show (Boolean False) = "Boolean False" show (Boolean False) = "Boolean False"
@ -56,3 +95,49 @@ instance Eq (Value m) where
(List this) == (List that) = this == that (List this) == (List that) = this == that
(Object this) == (Object that) = HashMap.keys this == HashMap.keys that (Object this) == (Object that) = HashMap.keys this == HashMap.keys that
_ == _ = False _ == _ = 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

64
src/Language/GraphQL/Type/Schema.hs
View File

@ -3,13 +3,23 @@
-- | Schema Definition. -- | Schema Definition.
module Language.GraphQL.Type.Schema module Language.GraphQL.Type.Schema
( Schema(..) ( Schema(..)
, Type(..)
, collectReferencedTypes , collectReferencedTypes
) where ) where
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Language.GraphQL.AST.Core (Name) 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, -- | 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 -- 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 -- are reachable by traversing the root types are included, other types must
-- be explicitly referenced. -- be explicitly referenced.
data Schema m = Schema data Schema m = Schema
{ query :: ObjectType m { query :: Out.ObjectType m
, mutation :: Maybe (ObjectType m) , mutation :: Maybe (Out.ObjectType m)
} }
-- | Traverses the schema and finds all referenced types. -- | 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 = collectReferencedTypes schema =
let queryTypes = traverseObjectType (query schema) HashMap.empty let queryTypes = traverseObjectType (query schema) HashMap.empty
in maybe queryTypes (`traverseObjectType` queryTypes) $ mutation schema in maybe queryTypes (`traverseObjectType` queryTypes) $ mutation schema
@ -33,36 +43,36 @@ collectReferencedTypes schema =
let newMap = HashMap.insert typeName element foundTypes let newMap = HashMap.insert typeName element foundTypes
in maybe (traverser newMap) (const foundTypes) in maybe (traverser newMap) (const foundTypes)
$ HashMap.lookup typeName foundTypes $ HashMap.lookup typeName foundTypes
visitFields (Field _ outputType arguments _) foundTypes visitFields (Out.Field _ outputType arguments _) foundTypes
= traverseOutputType outputType = traverseOutputType outputType
$ foldr visitArguments foundTypes arguments $ foldr visitArguments foundTypes arguments
visitArguments (Argument _ inputType _) = traverseInputType inputType visitArguments (In.Argument _ inputType _) = traverseInputType inputType
visitInputFields (InputField _ inputType _) = traverseInputType inputType visitInputFields (In.InputField _ inputType _) = traverseInputType inputType
traverseInputType (ObjectInputTypeDefinition objectType) = traverseInputType (In.InputObjectBaseType objectType) =
let (InputObjectType typeName _ inputFields) = objectType let (In.InputObjectType typeName _ inputFields) = objectType
element = InputObjectTypeDefinition objectType element = InputObjectType objectType
traverser = flip (foldr visitInputFields) inputFields traverser = flip (foldr visitInputFields) inputFields
in collect traverser typeName element in collect traverser typeName element
traverseInputType (ListInputTypeDefinition listType) = traverseInputType (In.ListBaseType listType) =
traverseInputType listType traverseInputType listType
traverseInputType (ScalarInputTypeDefinition scalarType) = traverseInputType (In.ScalarBaseType scalarType) =
let (ScalarType typeName _) = scalarType let (Definition.ScalarType typeName _) = scalarType
in collect Prelude.id typeName (ScalarTypeDefinition scalarType) in collect Prelude.id typeName (ScalarType scalarType)
traverseInputType (EnumInputTypeDefinition enumType) = traverseInputType (In.EnumBaseType enumType) =
let (EnumType typeName _ _) = enumType let (Definition.EnumType typeName _ _) = enumType
in collect Prelude.id typeName (EnumTypeDefinition enumType) in collect Prelude.id typeName (EnumType enumType)
traverseOutputType (ObjectOutputTypeDefinition objectType) = traverseOutputType (Out.ObjectBaseType objectType) =
traverseObjectType objectType traverseObjectType objectType
traverseOutputType (ListOutputTypeDefinition listType) = traverseOutputType (Out.ListBaseType listType) =
traverseOutputType listType traverseOutputType listType
traverseOutputType (ScalarOutputTypeDefinition scalarType) = traverseOutputType (Out.ScalarBaseType scalarType) =
let (ScalarType typeName _) = scalarType let (Definition.ScalarType typeName _) = scalarType
in collect Prelude.id typeName (ScalarTypeDefinition scalarType) in collect Prelude.id typeName (ScalarType scalarType)
traverseOutputType (EnumOutputTypeDefinition enumType) = traverseOutputType (Out.EnumBaseType enumType) =
let (EnumType typeName _ _) = enumType let (Definition.EnumType typeName _ _) = enumType
in collect Prelude.id typeName (EnumTypeDefinition enumType) in collect Prelude.id typeName (EnumType enumType)
traverseObjectType objectType foundTypes = traverseObjectType objectType foundTypes =
let (ObjectType typeName _ objectFields) = objectType let (Out.ObjectType typeName _ objectFields) = objectType
element = ObjectTypeDefinition objectType element = ObjectType objectType
traverser = flip (foldr visitFields) objectFields traverser = flip (foldr visitFields) objectFields
in collect traverser typeName element foundTypes in collect traverser typeName element foundTypes

34
tests/Language/GraphQL/Execute/CoerceSpec.hs
View File

@ -23,7 +23,7 @@ direction :: EnumType
direction = EnumType "Direction" Nothing direction = EnumType "Direction" Nothing
$ Set.fromList ["NORTH", "EAST", "SOUTH", "WEST"] $ Set.fromList ["NORTH", "EAST", "SOUTH", "WEST"]
coerceInputLiteral :: InputType -> In.Value -> Maybe Subs coerceInputLiteral :: In.Type -> In.Value -> Maybe Subs
coerceInputLiteral input value = coerceInputLiterals coerceInputLiteral input value = coerceInputLiterals
(HashMap.singleton "variableName" input) (HashMap.singleton "variableName" input)
(HashMap.singleton "variableName" value) (HashMap.singleton "variableName" value)
@ -31,12 +31,12 @@ coerceInputLiteral input value = coerceInputLiterals
lookupActual :: Maybe (HashMap Name In.Value) -> Maybe In.Value lookupActual :: Maybe (HashMap Name In.Value) -> Maybe In.Value
lookupActual = (HashMap.lookup "variableName" =<<) lookupActual = (HashMap.lookup "variableName" =<<)
singletonInputObject :: InputType singletonInputObject :: In.Type
singletonInputObject = ObjectInputType type' singletonInputObject = In.NamedInputObjectType type'
where where
type' = InputObjectType "ObjectName" Nothing inputFields type' = In.InputObjectType "ObjectName" Nothing inputFields
inputFields = HashMap.singleton "field" field inputFields = HashMap.singleton "field" field
field = InputField Nothing (ScalarInputType string) Nothing field = In.InputField Nothing (In.NamedScalarType string) Nothing
spec :: Spec spec :: Spec
spec = do spec = do
@ -44,36 +44,36 @@ spec = do
it "coerces strings" $ it "coerces strings" $
let expected = Just (In.String "asdf") let expected = Just (In.String "asdf")
actual = coerceVariableValue actual = coerceVariableValue
(ScalarInputType string) (Aeson.String "asdf") (In.NamedScalarType string) (Aeson.String "asdf")
in actual `shouldBe` expected in actual `shouldBe` expected
it "coerces non-null strings" $ it "coerces non-null strings" $
let expected = Just (In.String "asdf") let expected = Just (In.String "asdf")
actual = coerceVariableValue actual = coerceVariableValue
(NonNullScalarInputType string) (Aeson.String "asdf") (In.NonNullScalarType string) (Aeson.String "asdf")
in actual `shouldBe` expected in actual `shouldBe` expected
it "coerces booleans" $ it "coerces booleans" $
let expected = Just (In.Boolean True) let expected = Just (In.Boolean True)
actual = coerceVariableValue actual = coerceVariableValue
(ScalarInputType boolean) (Aeson.Bool True) (In.NamedScalarType boolean) (Aeson.Bool True)
in actual `shouldBe` expected in actual `shouldBe` expected
it "coerces zero to an integer" $ it "coerces zero to an integer" $
let expected = Just (In.Int 0) let expected = Just (In.Int 0)
actual = coerceVariableValue actual = coerceVariableValue
(ScalarInputType int) (Aeson.Number 0) (In.NamedScalarType int) (Aeson.Number 0)
in actual `shouldBe` expected in actual `shouldBe` expected
it "rejects fractional if an integer is expected" $ it "rejects fractional if an integer is expected" $
let actual = coerceVariableValue let actual = coerceVariableValue
(ScalarInputType int) (Aeson.Number $ scientific 14 (-1)) (In.NamedScalarType int) (Aeson.Number $ scientific 14 (-1))
in actual `shouldSatisfy` isNothing in actual `shouldSatisfy` isNothing
it "coerces float numbers" $ it "coerces float numbers" $
let expected = Just (In.Float 1.4) let expected = Just (In.Float 1.4)
actual = coerceVariableValue actual = coerceVariableValue
(ScalarInputType float) (Aeson.Number $ scientific 14 (-1)) (In.NamedScalarType float) (Aeson.Number $ scientific 14 (-1))
in actual `shouldBe` expected in actual `shouldBe` expected
it "coerces IDs" $ it "coerces IDs" $
let expected = Just (In.String "1234") let expected = Just (In.String "1234")
actual = coerceVariableValue actual = coerceVariableValue
(ScalarInputType id) (Aeson.String "1234") (In.NamedScalarType id) (Aeson.String "1234")
in actual `shouldBe` expected in actual `shouldBe` expected
it "coerces input objects" $ it "coerces input objects" $
let actual = coerceVariableValue singletonInputObject let actual = coerceVariableValue singletonInputObject
@ -94,11 +94,11 @@ spec = do
] ]
in actual `shouldSatisfy` isNothing in actual `shouldSatisfy` isNothing
it "preserves null" $ it "preserves null" $
let actual = coerceVariableValue (ScalarInputType id) Aeson.Null let actual = coerceVariableValue (In.NamedScalarType id) Aeson.Null
in actual `shouldBe` Just In.Null in actual `shouldBe` Just In.Null
it "preserves list order" $ it "preserves list order" $
let list = Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"] let list = Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"]
listType = (ListInputType $ ScalarInputType string) listType = (In.ListType $ In.NamedScalarType string)
actual = coerceVariableValue listType list actual = coerceVariableValue listType list
expected = Just $ In.List [In.String "asdf", In.String "qwer"] expected = Just $ In.List [In.String "asdf", In.String "qwer"]
in actual `shouldBe` expected in actual `shouldBe` expected
@ -107,13 +107,13 @@ spec = do
it "coerces enums" $ it "coerces enums" $
let expected = Just (In.Enum "NORTH") let expected = Just (In.Enum "NORTH")
actual = coerceInputLiteral actual = coerceInputLiteral
(EnumInputType direction) (In.Enum "NORTH") (In.NamedEnumType direction) (In.Enum "NORTH")
in lookupActual actual `shouldBe` expected in lookupActual actual `shouldBe` expected
it "fails with non-existing enum value" $ it "fails with non-existing enum value" $
let actual = coerceInputLiteral let actual = coerceInputLiteral
(EnumInputType direction) (In.Enum "NORTH_EAST") (In.NamedEnumType direction) (In.Enum "NORTH_EAST")
in actual `shouldSatisfy` isNothing in actual `shouldSatisfy` isNothing
it "coerces integers to IDs" $ it "coerces integers to IDs" $
let expected = Just (In.String "1234") 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 in lookupActual actual `shouldBe` expected

4
tests/Test/DirectiveSpec.hs
View File

@ -17,9 +17,9 @@ experimentalResolver :: Schema IO
experimentalResolver = Schema { query = queryType, mutation = Nothing } experimentalResolver = Schema { query = queryType, mutation = Nothing }
where where
resolver = pure $ Out.Int 5 resolver = pure $ Out.Int 5
queryType = ObjectType "Query" Nothing queryType = Out.ObjectType "Query" Nothing
$ HashMap.singleton "experimentalField" $ HashMap.singleton "experimentalField"
$ Field Nothing (ScalarOutputType int) mempty resolver $ Out.Field Nothing (Out.NamedScalarType int) mempty resolver
emptyObject :: Value emptyObject :: Value
emptyObject = object emptyObject = object

16
tests/Test/FragmentSpec.hs
View File

@ -50,17 +50,17 @@ hasErrors :: Value -> Bool
hasErrors (Object object') = HashMap.member "errors" object' hasErrors (Object object') = HashMap.member "errors" object'
hasErrors _ = True hasErrors _ = True
shirtType :: ObjectType IO shirtType :: Out.ObjectType IO
shirtType = ObjectType "Shirt" Nothing shirtType = Out.ObjectType "Shirt" Nothing
$ HashMap.singleton resolverName $ HashMap.singleton resolverName
$ Field Nothing (ScalarOutputType string) mempty resolve $ Out.Field Nothing (Out.NamedScalarType string) mempty resolve
where where
(Schema.Resolver resolverName resolve) = size (Schema.Resolver resolverName resolve) = size
hatType :: ObjectType IO hatType :: Out.ObjectType IO
hatType = ObjectType "Hat" Nothing hatType = Out.ObjectType "Hat" Nothing
$ HashMap.singleton resolverName $ HashMap.singleton resolverName
$ Field Nothing (ScalarOutputType int) mempty resolve $ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
where where
(Schema.Resolver resolverName resolve) = circumference (Schema.Resolver resolverName resolve) = circumference
@ -69,9 +69,9 @@ toSchema (Schema.Resolver resolverName resolve) = Schema
{ query = queryType, mutation = Nothing } { query = queryType, mutation = Nothing }
where where
unionMember = if resolverName == "Hat" then hatType else shirtType unionMember = if resolverName == "Hat" then hatType else shirtType
queryType = ObjectType "Query" Nothing queryType = Out.ObjectType "Query" Nothing
$ HashMap.singleton resolverName $ HashMap.singleton resolverName
$ Field Nothing (ObjectOutputType unionMember) mempty resolve $ Out.Field Nothing (Out.NamedObjectType unionMember) mempty resolve
spec :: Spec spec :: Spec
spec = do spec = do

14
tests/Test/RootOperationSpec.hs
View File

@ -14,27 +14,27 @@ import Language.GraphQL.Type.Definition
import qualified Language.GraphQL.Type.Out as Out import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema import Language.GraphQL.Type.Schema
hatType :: ObjectType IO hatType :: Out.ObjectType IO
hatType = ObjectType "Hat" Nothing hatType = Out.ObjectType "Hat" Nothing
$ HashMap.singleton resolverName $ HashMap.singleton resolverName
$ Field Nothing (ScalarOutputType int) mempty resolve $ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
where where
(Schema.Resolver resolverName resolve) = (Schema.Resolver resolverName resolve) =
Schema.Resolver "circumference" $ pure $ Out.Int 60 Schema.Resolver "circumference" $ pure $ Out.Int 60
schema :: Schema IO schema :: Schema IO
schema = Schema schema = Schema
(ObjectType "Query" Nothing hatField) (Out.ObjectType "Query" Nothing hatField)
(Just $ ObjectType "Mutation" Nothing incrementField) (Just $ Out.ObjectType "Mutation" Nothing incrementField)
where where
garment = pure $ Schema.object garment = pure $ Schema.object
[ Schema.Resolver "circumference" $ pure $ Out.Int 60 [ Schema.Resolver "circumference" $ pure $ Out.Int 60
] ]
incrementField = HashMap.singleton "incrementCircumference" incrementField = HashMap.singleton "incrementCircumference"
$ Field Nothing (ScalarOutputType int) mempty $ Out.Field Nothing (Out.NamedScalarType int) mempty
$ pure $ Out.Int 61 $ pure $ Out.Int 61
hatField = HashMap.singleton "garment" hatField = HashMap.singleton "garment"
$ Field Nothing (ObjectOutputType hatType) mempty garment $ Out.Field Nothing (Out.NamedObjectType hatType) mempty garment
spec :: Spec spec :: Spec
spec = spec =

6
tests/Test/StarWars/Data.hs
View File

@ -184,7 +184,7 @@ getFriends :: Character -> [Character]
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
getEpisode :: Int -> Maybe Text getEpisode :: Int -> Maybe Text
getEpisode 4 = pure $ "NEWHOPE" getEpisode 4 = pure "NEWHOPE"
getEpisode 5 = pure $ "EMPIRE" getEpisode 5 = pure "EMPIRE"
getEpisode 6 = pure $ "JEDI" getEpisode 6 = pure "JEDI"
getEpisode _ = empty getEpisode _ = empty

12
tests/Test/StarWars/Schema.hs
View File

@ -25,10 +25,10 @@ import Test.StarWars.Data
schema :: Schema Identity schema :: Schema Identity
schema = Schema { query = queryType, mutation = Nothing } schema = Schema { query = queryType, mutation = Nothing }
where where
queryType = ObjectType "Query" Nothing $ HashMap.fromList queryType = Out.ObjectType "Query" Nothing $ HashMap.fromList
[ ("hero", Field Nothing (ScalarOutputType string) mempty hero) [ ("hero", Out.Field Nothing (Out.NamedScalarType string) mempty hero)
, ("human", Field Nothing (ScalarOutputType string) mempty human) , ("human", Out.Field Nothing (Out.NamedScalarType string) mempty human)
, ("droid", Field Nothing (ScalarOutputType string) mempty droid) , ("droid", Out.Field Nothing (Out.NamedScalarType string) mempty droid)
] ]
hero :: ActionT Identity (Out.Value Identity) hero :: ActionT Identity (Out.Value Identity)
@ -55,7 +55,7 @@ droid :: ActionT Identity (Out.Value Identity)
droid = do droid = do
id' <- argument "id" id' <- argument "id"
case id' of case id' of
In.String i -> getDroid i >>= pure . character In.String i -> character <$> getDroid i
_ -> ActionT $ throwE "Invalid arguments." _ -> ActionT $ throwE "Invalid arguments."
character :: Character -> Out.Value Identity character :: Character -> Out.Value Identity
@ -63,7 +63,7 @@ character char = Schema.object
[ Schema.Resolver "id" $ pure $ Out.String $ id_ char [ Schema.Resolver "id" $ pure $ Out.String $ id_ char
, Schema.Resolver "name" $ pure $ Out.String $ name_ char , Schema.Resolver "name" $ pure $ Out.String $ name_ char
, Schema.Resolver "friends" , Schema.Resolver "friends"
$ pure $ Out.List $ fmap character $ getFriends char $ pure $ Out.List $ character <$> getFriends char
, Schema.Resolver "appearsIn" $ pure , Schema.Resolver "appearsIn" $ pure
$ Out.List $ Out.Enum <$> catMaybes (getEpisode <$> appearsIn char) $ Out.List $ Out.Enum <$> catMaybes (getEpisode <$> appearsIn char)
, Schema.Resolver "secretBackstory" $ Out.String , Schema.Resolver "secretBackstory" $ Out.String