Split input/output types and values into 2 modules
This commit is contained in:
@ -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
|
||||
|
||||
Reference in New Issue
Block a user