diff options
Diffstat (limited to 'src/Language')
| -rw-r--r-- | src/Language/GraphQL/AST/Document.hs | 4 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute.hs | 41 | ||||
| -rw-r--r-- | src/Language/GraphQL/TH.hs | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type/Definition.hs | 10 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type/In.hs | 9 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type/Out.hs | 12 | ||||
| -rw-r--r-- | src/Language/GraphQL/Validate/Rules.hs | 21 |
7 files changed, 57 insertions, 42 deletions
diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index 131285d..66fc246 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -371,8 +371,8 @@ data NonNullType deriving Eq instance Show NonNullType where - show (NonNullTypeNamed typeName) = '!' : Text.unpack typeName - show (NonNullTypeList listType) = concat ["![", show listType, "]"] + show (NonNullTypeNamed typeName) = Text.unpack $ typeName <> "!" + show (NonNullTypeList listType) = concat ["[", show listType, "]!"] -- ** Directives diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs index bbacdd2..265e94f 100644 --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -556,33 +556,24 @@ coerceArgumentValues argumentDefinitions argumentValues = $ Just inputValue | otherwise -> throwM $ InputCoercionException (Text.unpack argumentName) variableType Nothing + matchFieldValues' = matchFieldValues coerceArgumentValue $ Full.node <$> argumentValues - coerceArgumentValue inputType (Transform.Int integer) = - coerceInputLiteral inputType (Type.Int integer) - coerceArgumentValue inputType (Transform.Boolean boolean) = - coerceInputLiteral inputType (Type.Boolean boolean) - coerceArgumentValue inputType (Transform.String string) = - coerceInputLiteral inputType (Type.String string) - coerceArgumentValue inputType (Transform.Float float) = - coerceInputLiteral inputType (Type.Float float) - coerceArgumentValue inputType (Transform.Enum enum) = - coerceInputLiteral inputType (Type.Enum enum) - coerceArgumentValue inputType Transform.Null - | In.isNonNullType inputType = Nothing - | otherwise = coerceInputLiteral inputType Type.Null - coerceArgumentValue (In.ListBaseType inputType) (Transform.List list) = - let coerceItem = coerceArgumentValue inputType - in Type.List <$> traverse coerceItem list - coerceArgumentValue (In.InputObjectBaseType inputType) (Transform.Object object) - | In.InputObjectType _ _ inputFields <- inputType = - let go = forEachField object - resultMap = HashMap.foldrWithKey go (pure mempty) inputFields - in Type.Object <$> resultMap - coerceArgumentValue _ (Transform.Variable variable) = pure variable - coerceArgumentValue _ _ = Nothing - forEachField object variableName (In.InputField _ variableType defaultValue) = - matchFieldValues coerceArgumentValue object variableName variableType defaultValue + + coerceArgumentValue inputType transform = + coerceInputLiteral inputType $ extractArgumentValue transform + + extractArgumentValue (Transform.Int integer) = Type.Int integer + extractArgumentValue (Transform.Boolean boolean) = Type.Boolean boolean + extractArgumentValue (Transform.String string) = Type.String string + extractArgumentValue (Transform.Float float) = Type.Float float + extractArgumentValue (Transform.Enum enum) = Type.Enum enum + extractArgumentValue Transform.Null = Type.Null + extractArgumentValue (Transform.List list) = + Type.List $ extractArgumentValue <$> list + extractArgumentValue (Transform.Object object) = + Type.Object $ extractArgumentValue <$> object + extractArgumentValue (Transform.Variable variable) = variable collectFields :: Monad m => Out.ObjectType m diff --git a/src/Language/GraphQL/TH.hs b/src/Language/GraphQL/TH.hs index b6bc18c..8e1fcb3 100644 --- a/src/Language/GraphQL/TH.hs +++ b/src/Language/GraphQL/TH.hs @@ -21,7 +21,7 @@ stripIndentation code = reverse indent count (' ' : xs) = indent (count - 1) xs indent _ xs = xs withoutLeadingNewlines = dropNewlines code - dropNewlines = dropWhile (== '\n') + dropNewlines = dropWhile $ flip any ['\n', '\r'] . (==) spaces = length $ takeWhile (== ' ') withoutLeadingNewlines -- | Removes leading and trailing newlines. Indentation of the first line is diff --git a/src/Language/GraphQL/Type/Definition.hs b/src/Language/GraphQL/Type/Definition.hs index 1c8876a..ad4b538 100644 --- a/src/Language/GraphQL/Type/Definition.hs +++ b/src/Language/GraphQL/Type/Definition.hs @@ -18,6 +18,8 @@ module Language.GraphQL.Type.Definition , float , id , int + , showNonNullType + , showNonNullListType , selection , string ) where @@ -207,3 +209,11 @@ include = handle include' (Just (Boolean True)) -> Include directive' _ -> Skip include' directive' = Continue directive' + +showNonNullType :: Show a => a -> String +showNonNullType = (++ "!") . show + +showNonNullListType :: Show a => a -> String +showNonNullListType listType = + let representation = show listType + in concat ["[", representation, "]!"] diff --git a/src/Language/GraphQL/Type/In.hs b/src/Language/GraphQL/Type/In.hs index 376ed6f..c777e69 100644 --- a/src/Language/GraphQL/Type/In.hs +++ b/src/Language/GraphQL/Type/In.hs @@ -66,10 +66,11 @@ instance Show Type where show (NamedEnumType enumType) = show enumType show (NamedInputObjectType inputObjectType) = show inputObjectType show (ListType baseType) = concat ["[", show baseType, "]"] - show (NonNullScalarType scalarType) = '!' : show scalarType - show (NonNullEnumType enumType) = '!' : show enumType - show (NonNullInputObjectType inputObjectType) = '!' : show inputObjectType - show (NonNullListType baseType) = concat ["![", show baseType, "]"] + show (NonNullScalarType scalarType) = Definition.showNonNullType scalarType + show (NonNullEnumType enumType) = Definition.showNonNullType enumType + show (NonNullInputObjectType inputObjectType) = + Definition.showNonNullType inputObjectType + show (NonNullListType baseType) = Definition.showNonNullListType baseType -- | Field argument definition. data Argument = Argument (Maybe Text) Type (Maybe Definition.Value) diff --git a/src/Language/GraphQL/Type/Out.hs b/src/Language/GraphQL/Type/Out.hs index 847a8a5..6854926 100644 --- a/src/Language/GraphQL/Type/Out.hs +++ b/src/Language/GraphQL/Type/Out.hs @@ -115,12 +115,12 @@ instance forall a. Show (Type a) where show (NamedInterfaceType interfaceType) = show interfaceType show (NamedUnionType unionType) = show unionType show (ListType baseType) = concat ["[", show baseType, "]"] - show (NonNullScalarType scalarType) = '!' : show scalarType - show (NonNullEnumType enumType) = '!' : show enumType - show (NonNullObjectType inputObjectType) = '!' : show inputObjectType - show (NonNullInterfaceType interfaceType) = '!' : show interfaceType - show (NonNullUnionType unionType) = '!' : show unionType - show (NonNullListType baseType) = concat ["![", show baseType, "]"] + show (NonNullScalarType scalarType) = showNonNullType scalarType + show (NonNullEnumType enumType) = showNonNullType enumType + show (NonNullObjectType inputObjectType) = showNonNullType inputObjectType + show (NonNullInterfaceType interfaceType) = showNonNullType interfaceType + show (NonNullUnionType unionType) = showNonNullType unionType + show (NonNullListType baseType) = showNonNullListType baseType -- | Matches either 'NamedScalarType' or 'NonNullScalarType'. pattern ScalarBaseType :: forall m. ScalarType -> Type m diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs index 8c3156b..2d7adba 100644 --- a/src/Language/GraphQL/Validate/Rules.hs +++ b/src/Language/GraphQL/Validate/Rules.hs @@ -2,11 +2,13 @@ v. 2.0. If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. -} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} -- | This module contains default rules defined in the GraphQL specification. @@ -61,6 +63,7 @@ import Data.Sequence (Seq(..), (|>)) import qualified Data.Sequence as Seq import Data.Text (Text) import qualified Data.Text as Text +import GHC.Records (HasField(..)) import qualified Language.GraphQL.AST.Document as Full import qualified Language.GraphQL.Type.Definition as Definition import qualified Language.GraphQL.Type.Internal as Type @@ -618,6 +621,10 @@ noUndefinedVariablesRule = , "\"." ] +-- Used to find the difference between defined and used variables. The first +-- argument are variables defined in the operation, the second argument are +-- variables used in the query. It should return the difference between these +-- 2 sets. type UsageDifference = HashMap Full.Name [Full.Location] -> HashMap Full.Name [Full.Location] @@ -664,11 +671,17 @@ variableUsageDifference difference errorMessage = OperationDefinitionRule $ \cas = filterSelections' selections >>= lift . mapReaderT (<> mapDirectives directives') . pure findDirectiveVariables (Full.Directive _ arguments _) = mapArguments arguments - mapArguments = Seq.fromList . mapMaybe findArgumentVariables + mapArguments = Seq.fromList . (>>= findArgumentVariables) mapDirectives = foldMap findDirectiveVariables - findArgumentVariables (Full.Argument _ Full.Node{ node = Full.Variable value', ..} _) = - Just (value', [location]) - findArgumentVariables _ = Nothing + + findArgumentVariables (Full.Argument _ value _) = findNodeVariables value + findNodeVariables Full.Node{ node = value, ..} = findValueVariables location value + + findValueVariables location (Full.Variable value') = [(value', [location])] + findValueVariables _ (Full.List values) = values >>= findNodeVariables + findValueVariables _ (Full.Object fields) = fields + >>= findNodeVariables . getField @"value" + findValueVariables _ _ = [] makeError operationName (variableName, locations') = Error { message = errorMessage operationName variableName , locations = locations' |