diff --git a/CHANGELOG.md b/CHANGELOG.md index 11e63bc..8c813ec 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/docs/tutorial/tutorial.lhs b/docs/tutorial/tutorial.lhs index c70c64c..e80e8c7 100644 --- a/docs/tutorial/tutorial.lhs +++ b/docs/tutorial/tutorial.lhs @@ -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 diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs index 295cb44..65ab6f7 100644 --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -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 diff --git a/src/Language/GraphQL/Execute/Coerce.hs b/src/Language/GraphQL/Execute/Coerce.hs index 32c48fd..4a9218b 100644 --- a/src/Language/GraphQL/Execute/Coerce.hs +++ b/src/Language/GraphQL/Execute/Coerce.hs @@ -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 diff --git a/src/Language/GraphQL/Execute/Transform.hs b/src/Language/GraphQL/Execute/Transform.hs index 9768675..849a646 100644 --- a/src/Language/GraphQL/Execute/Transform.hs +++ b/src/Language/GraphQL/Execute/Transform.hs @@ -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 diff --git a/src/Language/GraphQL/Type.hs b/src/Language/GraphQL/Type.hs new file mode 100644 index 0000000..c6e8507 --- /dev/null +++ b/src/Language/GraphQL/Type.hs @@ -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 diff --git a/src/Language/GraphQL/Type/Definition.hs b/src/Language/GraphQL/Type/Definition.hs index 54eac85..aecb64a 100644 --- a/src/Language/GraphQL/Type/Definition.hs +++ b/src/Language/GraphQL/Type/Definition.hs @@ -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 diff --git a/src/Language/GraphQL/Type/In.hs b/src/Language/GraphQL/Type/In.hs index a6d35e2..c2e8ded 100644 --- a/src/Language/GraphQL/Type/In.hs +++ b/src/Language/GraphQL/Type/In.hs @@ -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 diff --git a/src/Language/GraphQL/Type/Out.hs b/src/Language/GraphQL/Type/Out.hs index 96bc9cf..b421f2e 100644 --- a/src/Language/GraphQL/Type/Out.hs +++ b/src/Language/GraphQL/Type/Out.hs @@ -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 diff --git a/src/Language/GraphQL/Type/Schema.hs b/src/Language/GraphQL/Type/Schema.hs index 095f27d..91096d3 100644 --- a/src/Language/GraphQL/Type/Schema.hs +++ b/src/Language/GraphQL/Type/Schema.hs @@ -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 diff --git a/tests/Language/GraphQL/Execute/CoerceSpec.hs b/tests/Language/GraphQL/Execute/CoerceSpec.hs index 57f740b..c44c6c4 100644 --- a/tests/Language/GraphQL/Execute/CoerceSpec.hs +++ b/tests/Language/GraphQL/Execute/CoerceSpec.hs @@ -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 diff --git a/tests/Test/DirectiveSpec.hs b/tests/Test/DirectiveSpec.hs index 250ef6e..9ff8d8c 100644 --- a/tests/Test/DirectiveSpec.hs +++ b/tests/Test/DirectiveSpec.hs @@ -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 diff --git a/tests/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs index 5ebecab..2fb12d2 100644 --- a/tests/Test/FragmentSpec.hs +++ b/tests/Test/FragmentSpec.hs @@ -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 diff --git a/tests/Test/RootOperationSpec.hs b/tests/Test/RootOperationSpec.hs index 7e20e64..a20dc51 100644 --- a/tests/Test/RootOperationSpec.hs +++ b/tests/Test/RootOperationSpec.hs @@ -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 = diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs index 30a4cef..67a74cd 100644 --- a/tests/Test/StarWars/Data.hs +++ b/tests/Test/StarWars/Data.hs @@ -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 diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs index 993672c..f32c031 100644 --- a/tests/Test/StarWars/Schema.hs +++ b/tests/Test/StarWars/Schema.hs @@ -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