diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Language/GraphQL.hs | 101 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Document.hs | 8 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Encoder.hs | 279 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute.hs | 11 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute/Coerce.hs | 76 | ||||
| -rw-r--r-- | src/Test/Hspec/GraphQL.hs | 49 |
6 files changed, 278 insertions, 246 deletions
diff --git a/src/Language/GraphQL.hs b/src/Language/GraphQL.hs index 4f3e8d9..949fd06 100644 --- a/src/Language/GraphQL.hs +++ b/src/Language/GraphQL.hs @@ -1,105 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -#ifdef WITH_JSON --- | This module provides the functions to parse and execute @GraphQL@ queries. --- --- The content of this module depends on the value of the __json__ flag, which --- is currently on by default. This behavior will change in the future, the flag --- will be switched off by default and then removed. --- --- This documentation is generated with the enabled __json__ flag and functions --- described here support JSON and are deprecated. JSON instances are provided --- now by an additional package, __graphql-spice__. To start using the new --- package create __cabal.project__ in the root directory of your project with --- the following contents: --- --- @ --- packages: . --- constraints: graphql -json --- @ --- --- Then add __graphql-spice__ as dependency. --- --- The new version of this module defines only one function, @graphql@, which --- works with the internal GraphQL value representation used by this lbirary. --- Refer to @Language.GraphQL.JSON.graphql@ in __graphql-spice__ for the --- function that accepts and returns JSON. -module Language.GraphQL - ( graphql - , graphqlSubs - ) where - -import Control.Monad.Catch (MonadCatch) -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Types as Aeson -import qualified Data.HashMap.Strict as HashMap -import Data.Maybe (catMaybes) -import qualified Data.Sequence as Seq -import Data.Text (Text) -import Language.GraphQL.AST -import Language.GraphQL.Error -import Language.GraphQL.Execute -import qualified Language.GraphQL.Validate as Validate -import Language.GraphQL.Type.Schema (Schema) -import Text.Megaparsec (parse) - -{-# DEPRECATED graphql "Use graphql-spice package instead" #-} --- | If the text parses correctly as a @GraphQL@ query the query is --- executed using the given 'Schema'. -graphql :: MonadCatch m - => Schema m -- ^ Resolvers. - -> Text -- ^ Text representing a @GraphQL@ request document. - -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response. -graphql schema = graphqlSubs schema mempty mempty - -{-# DEPRECATED graphqlSubs "Use graphql-spice package instead" #-} --- | If the text parses correctly as a @GraphQL@ query the substitution is --- applied to the query and the query is then executed using to the given --- 'Schema'. -graphqlSubs :: MonadCatch m - => Schema m -- ^ Resolvers. - -> Maybe Text -- ^ Operation name. - -> Aeson.Object -- ^ Variable substitution function. - -> Text -- ^ Text representing a @GraphQL@ request document. - -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response. -graphqlSubs schema operationName variableValues document' = - case parse document "" document' of - Left errorBundle -> pure . formatResponse <$> parseError errorBundle - Right parsed -> - case validate parsed of - Seq.Empty -> fmap formatResponse - <$> execute schema operationName variableValues parsed - errors -> pure $ pure - $ HashMap.singleton "errors" - $ Aeson.toJSON - $ fromValidationError <$> errors - where - validate = Validate.document schema Validate.specifiedRules - formatResponse (Response data'' Seq.Empty) = HashMap.singleton "data" data'' - formatResponse (Response data'' errors') = HashMap.fromList - [ ("data", data'') - , ("errors", Aeson.toJSON $ fromError <$> errors') - ] - fromError Error{..} = Aeson.object $ catMaybes - [ Just ("message", Aeson.toJSON message) - , toMaybe fromLocation "locations" locations - , toMaybe fromPath "path" path - ] - fromValidationError Validate.Error{..} = Aeson.object - [ ("message", Aeson.toJSON message) - , ("locations", Aeson.listValue fromLocation locations) - ] - toMaybe _ _ [] = Nothing - toMaybe f key xs = Just (key, Aeson.listValue f xs) - fromPath (Segment segment) = Aeson.String segment - fromPath (Index index) = Aeson.toJSON index - fromLocation Location{..} = Aeson.object - [ ("line", Aeson.toJSON line) - , ("column", Aeson.toJSON column) - ] -#else -- | This module provides the functions to parse and execute @GraphQL@ queries. module Language.GraphQL ( graphql @@ -144,4 +44,3 @@ graphql schema operationName variableValues document' = , locations = locations , path = [] } -#endif diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index ea640df..131285d 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -464,6 +464,14 @@ data SchemaExtension newtype Description = Description (Maybe Text) deriving (Eq, Show) +instance Semigroup Description + where + Description lhs <> Description rhs = Description $ lhs <> rhs + +instance Monoid Description + where + mempty = Description mempty + -- ** Types -- | Type definitions describe various user-defined types. diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs index 54967ea..120fb64 100644 --- a/src/Language/GraphQL/AST/Encoder.hs +++ b/src/Language/GraphQL/AST/Encoder.hs @@ -14,10 +14,11 @@ module Language.GraphQL.AST.Encoder , operationType , pretty , type' + , typeSystemDefinition , value ) where -import Data.Foldable (fold) +import Data.Foldable (fold, Foldable (..)) import qualified Data.List.NonEmpty as NonEmpty import Data.Text (Text) import qualified Data.Text as Text @@ -28,6 +29,7 @@ import qualified Data.Text.Lazy.Builder as Builder import Data.Text.Lazy.Builder.Int (decimal) import Data.Text.Lazy.Builder.RealFloat (realFloat) import qualified Language.GraphQL.AST.Document as Full +import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation -- | Instructs the encoder whether the GraphQL document should be minified or -- pretty printed. @@ -54,7 +56,246 @@ document formatter defs encodeDocument = foldr executableDefinition [] defs executableDefinition (Full.ExecutableDefinition executableDefinition') acc = definition formatter executableDefinition' : acc - executableDefinition _ acc = acc + executableDefinition (Full.TypeSystemDefinition typeSystemDefinition' _location) acc = + typeSystemDefinition formatter typeSystemDefinition' : acc + executableDefinition (Full.TypeSystemExtension typeSystemExtension' _location) acc = + typeSystemExtension formatter typeSystemExtension' : acc + +directiveLocation :: DirectiveLocation.DirectiveLocation -> Lazy.Text +directiveLocation = Lazy.Text.pack . show + +withLineBreak :: Formatter -> Lazy.Text.Text -> Lazy.Text.Text +withLineBreak formatter encodeDefinition + | Pretty _ <- formatter = Lazy.Text.snoc encodeDefinition '\n' + | Minified <- formatter = encodeDefinition + +typeSystemExtension :: Formatter -> Full.TypeSystemExtension -> Lazy.Text +typeSystemExtension formatter = \case + Full.SchemaExtension schemaExtension' -> + schemaExtension formatter schemaExtension' + Full.TypeExtension typeExtension' -> typeExtension formatter typeExtension' + +schemaExtension :: Formatter -> Full.SchemaExtension -> Lazy.Text +schemaExtension formatter = \case + Full.SchemaOperationExtension operationDirectives operationTypeDefinitions' -> + withLineBreak formatter + $ "extend schema " + <> optempty (directives formatter) operationDirectives + <> bracesList formatter (operationTypeDefinition formatter) (NonEmpty.toList operationTypeDefinitions') + Full.SchemaDirectivesExtension operationDirectives -> "extend schema " + <> optempty (directives formatter) (NonEmpty.toList operationDirectives) + +typeExtension :: Formatter -> Full.TypeExtension -> Lazy.Text +typeExtension formatter = \case + Full.ScalarTypeExtension name' directives' + -> "extend scalar " + <> Lazy.Text.fromStrict name' + <> directives formatter (NonEmpty.toList directives') + Full.ObjectTypeFieldsDefinitionExtension name' ifaces' directives' fields' + -> "extend type " + <> Lazy.Text.fromStrict name' + <> optempty (" " <>) (implementsInterfaces ifaces') + <> optempty (directives formatter) directives' + <> eitherFormat formatter " " "" + <> bracesList formatter (fieldDefinition nextFormatter) (NonEmpty.toList fields') + Full.ObjectTypeDirectivesExtension name' ifaces' directives' + -> "extend type " + <> Lazy.Text.fromStrict name' + <> optempty (" " <>) (implementsInterfaces ifaces') + <> optempty (directives formatter) (NonEmpty.toList directives') + Full.ObjectTypeImplementsInterfacesExtension name' ifaces' + -> "extend type " + <> Lazy.Text.fromStrict name' + <> optempty (" " <>) (implementsInterfaces ifaces') + Full.InterfaceTypeFieldsDefinitionExtension name' directives' fields' + -> "extend interface " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) directives' + <> eitherFormat formatter " " "" + <> bracesList formatter (fieldDefinition nextFormatter) (NonEmpty.toList fields') + Full.InterfaceTypeDirectivesExtension name' directives' + -> "extend interface " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) (NonEmpty.toList directives') + Full.UnionTypeUnionMemberTypesExtension name' directives' members' + -> "extend union " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) directives' + <> eitherFormat formatter " " "" + <> unionMemberTypes formatter members' + Full.UnionTypeDirectivesExtension name' directives' + -> "extend union " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) (NonEmpty.toList directives') + Full.EnumTypeEnumValuesDefinitionExtension name' directives' members' + -> "extend enum " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) directives' + <> eitherFormat formatter " " "" + <> bracesList formatter (enumValueDefinition formatter) (NonEmpty.toList members') + Full.EnumTypeDirectivesExtension name' directives' + -> "extend enum " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) (NonEmpty.toList directives') + Full.InputObjectTypeInputFieldsDefinitionExtension name' directives' fields' + -> "extend input " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) directives' + <> eitherFormat formatter " " "" + <> bracesList formatter (inputValueDefinition nextFormatter) (NonEmpty.toList fields') + Full.InputObjectTypeDirectivesExtension name' directives' + -> "extend input " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) (NonEmpty.toList directives') + where + nextFormatter = incrementIndent formatter + +-- | Converts a t'Full.TypeSystemDefinition' into a string. +typeSystemDefinition :: Formatter -> Full.TypeSystemDefinition -> Lazy.Text +typeSystemDefinition formatter = \case + Full.SchemaDefinition operationDirectives operationTypeDefinitions' -> + withLineBreak formatter + $ "schema " + <> optempty (directives formatter) operationDirectives + <> bracesList formatter (operationTypeDefinition formatter) (NonEmpty.toList operationTypeDefinitions') + Full.TypeDefinition typeDefinition' -> typeDefinition formatter typeDefinition' + Full.DirectiveDefinition description' name' arguments' locations + -> description formatter description' + <> "@" + <> Lazy.Text.fromStrict name' + <> argumentsDefinition formatter arguments' + <> " on" + <> pipeList formatter (directiveLocation <$> locations) + +operationTypeDefinition :: Formatter -> Full.OperationTypeDefinition -> Lazy.Text.Text +operationTypeDefinition formatter (Full.OperationTypeDefinition operationType' namedType') + = indentLine (incrementIndent formatter) + <> operationType formatter operationType' + <> colon formatter + <> Lazy.Text.fromStrict namedType' + +fieldDefinition :: Formatter -> Full.FieldDefinition -> Lazy.Text.Text +fieldDefinition formatter fieldDefinition' = + let Full.FieldDefinition description' name' arguments' type'' directives' = fieldDefinition' + in optempty (description formatter) description' + <> indentLine formatter + <> Lazy.Text.fromStrict name' + <> argumentsDefinition formatter arguments' + <> colon formatter + <> type' type'' + <> optempty (directives formatter) directives' + +argumentsDefinition :: Formatter -> Full.ArgumentsDefinition -> Lazy.Text.Text +argumentsDefinition formatter (Full.ArgumentsDefinition arguments') = + parensCommas formatter (argumentDefinition formatter) arguments' + +argumentDefinition :: Formatter -> Full.InputValueDefinition -> Lazy.Text.Text +argumentDefinition formatter definition' = + let Full.InputValueDefinition description' name' type'' defaultValue' directives' = definition' + in optempty (description formatter) description' + <> Lazy.Text.fromStrict name' + <> colon formatter + <> type' type'' + <> maybe mempty (defaultValue formatter . Full.node) defaultValue' + <> directives formatter directives' + +inputValueDefinition :: Formatter -> Full.InputValueDefinition -> Lazy.Text.Text +inputValueDefinition formatter definition' = + let Full.InputValueDefinition description' name' type'' defaultValue' directives' = definition' + in optempty (description formatter) description' + <> indentLine formatter + <> Lazy.Text.fromStrict name' + <> colon formatter + <> type' type'' + <> maybe mempty (defaultValue formatter . Full.node) defaultValue' + <> directives formatter directives' + +typeDefinition :: Formatter -> Full.TypeDefinition -> Lazy.Text +typeDefinition formatter = \case + Full.ScalarTypeDefinition description' name' directives' + -> optempty (description formatter) description' + <> "scalar " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) directives' + Full.ObjectTypeDefinition description' name' ifaces' directives' fields' + -> optempty (description formatter) description' + <> "type " + <> Lazy.Text.fromStrict name' + <> optempty (" " <>) (implementsInterfaces ifaces') + <> optempty (directives formatter) directives' + <> eitherFormat formatter " " "" + <> bracesList formatter (fieldDefinition nextFormatter) fields' + Full.InterfaceTypeDefinition description' name' directives' fields' + -> optempty (description formatter) description' + <> "interface " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) directives' + <> eitherFormat formatter " " "" + <> bracesList formatter (fieldDefinition nextFormatter) fields' + Full.UnionTypeDefinition description' name' directives' members' + -> optempty (description formatter) description' + <> "union " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) directives' + <> eitherFormat formatter " " "" + <> unionMemberTypes formatter members' + Full.EnumTypeDefinition description' name' directives' members' + -> optempty (description formatter) description' + <> "enum " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) directives' + <> eitherFormat formatter " " "" + <> bracesList formatter (enumValueDefinition formatter) members' + Full.InputObjectTypeDefinition description' name' directives' fields' + -> optempty (description formatter) description' + <> "input " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) directives' + <> eitherFormat formatter " " "" + <> bracesList formatter (inputValueDefinition nextFormatter) fields' + where + nextFormatter = incrementIndent formatter + +implementsInterfaces :: Foldable t => Full.ImplementsInterfaces t -> Lazy.Text +implementsInterfaces (Full.ImplementsInterfaces interfaces) + | null interfaces = mempty + | otherwise = Lazy.Text.fromStrict + $ Text.append "implements " + $ Text.intercalate " & " + $ toList interfaces + +unionMemberTypes :: Foldable t => Formatter -> Full.UnionMemberTypes t -> Lazy.Text +unionMemberTypes formatter (Full.UnionMemberTypes memberTypes) + | null memberTypes = mempty + | otherwise = Lazy.Text.append "=" + $ pipeList formatter + $ Lazy.Text.fromStrict + <$> toList memberTypes + +pipeList :: Foldable t => Formatter -> t Lazy.Text -> Lazy.Text +pipeList Minified = (" " <>) . Lazy.Text.intercalate " | " . toList +pipeList (Pretty _) = Lazy.Text.concat + . fmap (("\n" <> indentSymbol <> "| ") <>) + . toList + +enumValueDefinition :: Formatter -> Full.EnumValueDefinition -> Lazy.Text +enumValueDefinition (Pretty _) enumValue = + let Full.EnumValueDefinition description' name' directives' = enumValue + formatter = Pretty 1 + in description formatter description' + <> indentLine formatter + <> Lazy.Text.fromStrict name' + <> directives formatter directives' +enumValueDefinition Minified enumValue = + let Full.EnumValueDefinition description' name' directives' = enumValue + in description Minified description' + <> Lazy.Text.fromStrict name' + <> directives Minified directives' + +description :: Formatter -> Full.Description -> Lazy.Text.Text +description _formatter (Full.Description Nothing) = "" +description formatter (Full.Description (Just description')) = + stringValue formatter description' -- | Converts a t'Full.ExecutableDefinition' into a string. definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text @@ -100,7 +341,7 @@ variableDefinition formatter variableDefinition' = let Full.VariableDefinition variableName variableType defaultValue' _ = variableDefinition' in variable variableName - <> eitherFormat formatter ": " ":" + <> colon formatter <> type' variableType <> maybe mempty (defaultValue formatter . Full.node) defaultValue' @@ -127,20 +368,26 @@ indent :: (Integral a) => a -> Lazy.Text indent indentation = Lazy.Text.replicate (fromIntegral indentation) indentSymbol selection :: Formatter -> Full.Selection -> Lazy.Text -selection formatter = Lazy.Text.append indent' . encodeSelection +selection formatter = Lazy.Text.append (indentLine formatter') + . encodeSelection where encodeSelection (Full.FieldSelection fieldSelection) = - field incrementIndent fieldSelection + field formatter' fieldSelection encodeSelection (Full.InlineFragmentSelection fragmentSelection) = - inlineFragment incrementIndent fragmentSelection + inlineFragment formatter' fragmentSelection encodeSelection (Full.FragmentSpreadSelection fragmentSelection) = - fragmentSpread incrementIndent fragmentSelection - incrementIndent - | Pretty indentation <- formatter = Pretty $ indentation + 1 - | otherwise = Minified - indent' - | Pretty indentation <- formatter = indent $ indentation + 1 - | otherwise = "" + fragmentSpread formatter' fragmentSelection + formatter' = incrementIndent formatter + +indentLine :: Formatter -> Lazy.Text +indentLine formatter + | Pretty indentation <- formatter = indent indentation + | otherwise = "" + +incrementIndent :: Formatter -> Formatter +incrementIndent formatter + | Pretty indentation <- formatter = Pretty $ indentation + 1 + | otherwise = Minified colon :: Formatter -> Lazy.Text colon formatter = eitherFormat formatter ": " ":" @@ -198,8 +445,10 @@ directive formatter (Full.Directive name args _) = "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args directives :: Formatter -> [Full.Directive] -> Lazy.Text -directives Minified = spaces (directive Minified) -directives formatter = Lazy.Text.cons ' ' . spaces (directive formatter) +directives Minified values = spaces (directive Minified) values +directives formatter values + | null values = "" + | otherwise = Lazy.Text.cons ' ' $ spaces (directive formatter) values -- | Converts a 'Full.Value' into a string. value :: Formatter -> Full.Value -> Lazy.Text diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs index 5ceb616..bbacdd2 100644 --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -39,6 +39,7 @@ import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (fromMaybe) import Data.Sequence (Seq) import qualified Data.Sequence as Seq +import qualified Data.Vector as Vector import Data.Text (Text) import qualified Data.Text as Text import Data.Typeable (cast) @@ -466,12 +467,12 @@ completeValue :: (MonadCatch m, Serialize a) completeValue (Out.isNonNullType -> False) _ _ Type.Null = pure null completeValue outputType@(Out.ListBaseType listType) fields errorPath (Type.List list) - = foldM go (0, []) list >>= coerceResult outputType . List . snd + = foldM go Vector.empty list >>= coerceResult outputType . List . Vector.toList where - go (index, accumulator) listItem = do - let updatedPath = Index index : errorPath - completedValue <- completeValue listType fields updatedPath listItem - pure (index + 1, completedValue : accumulator) + go accumulator listItem = + let updatedPath = Index (Vector.length accumulator) : errorPath + in Vector.snoc accumulator + <$> completeValue listType fields updatedPath listItem completeValue outputType@(Out.ScalarBaseType _) _ _ (Type.Int int) = coerceResult outputType $ Int int completeValue outputType@(Out.ScalarBaseType _) _ _ (Type.Boolean boolean) = diff --git a/src/Language/GraphQL/Execute/Coerce.hs b/src/Language/GraphQL/Execute/Coerce.hs index 4725d74..54fc1c1 100644 --- a/src/Language/GraphQL/Execute/Coerce.hs +++ b/src/Language/GraphQL/Execute/Coerce.hs @@ -5,14 +5,8 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE CPP #-} -- | Types and functions used for input and result coercion. --- --- JSON instances in this module are only available with the __json__ --- flag that is currently on by default, but will be disabled in the future. --- Refer to the documentation in the 'Language.GraphQL' module and to --- the __graphql-spice__ package. module Language.GraphQL.Execute.Coerce ( Output(..) , Serialize(..) @@ -21,10 +15,6 @@ module Language.GraphQL.Execute.Coerce , matchFieldValues ) where -#ifdef WITH_JSON -import qualified Data.Aeson as Aeson -import Data.Scientific (toBoundedInteger, toRealFloat) -#endif import Data.Int (Int32) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap @@ -232,69 +222,3 @@ instance Serialize Type.Value where $ HashMap.fromList $ OrderedMap.toList object serialize _ _ = Nothing - -#ifdef WITH_JSON -instance Serialize Aeson.Value where - serialize (Out.ScalarBaseType scalarType) value - | Type.ScalarType "Int" _ <- scalarType - , Int int <- value = Just $ Aeson.toJSON int - | Type.ScalarType "Float" _ <- scalarType - , Float float <- value = Just $ Aeson.toJSON float - | Type.ScalarType "String" _ <- scalarType - , String string <- value = Just $ Aeson.String string - | Type.ScalarType "ID" _ <- scalarType - , String string <- value = Just $ Aeson.String string - | Type.ScalarType "Boolean" _ <- scalarType - , Boolean boolean <- value = Just $ Aeson.Bool boolean - serialize _ (Enum enum) = Just $ Aeson.String enum - serialize _ (List list) = Just $ Aeson.toJSON list - serialize _ (Object object) = Just - $ Aeson.object - $ OrderedMap.toList - $ Aeson.toJSON <$> object - serialize _ _ = Nothing - null = Aeson.Null - -instance VariableValue Aeson.Value where - coerceVariableValue _ Aeson.Null = Just Type.Null - coerceVariableValue (In.ScalarBaseType scalarType) value - | (Aeson.String stringValue) <- value = Just $ Type.String stringValue - | (Aeson.Bool booleanValue) <- value = Just $ Type.Boolean booleanValue - | (Aeson.Number numberValue) <- value - , (Type.ScalarType "Float" _) <- scalarType = - Just $ Type.Float $ toRealFloat numberValue - | (Aeson.Number numberValue) <- value = -- ID or Int - Type.Int <$> toBoundedInteger numberValue - coerceVariableValue (In.EnumBaseType _) (Aeson.String stringValue) = - Just $ Type.Enum stringValue - coerceVariableValue (In.InputObjectBaseType objectType) value - | (Aeson.Object objectValue) <- value = do - let (In.InputObjectType _ _ inputFields) = objectType - (newObjectValue, resultMap) <- foldWithKey objectValue inputFields - if HashMap.null newObjectValue - then Just $ Type.Object resultMap - else Nothing - where - foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues' - $ Just (objectValue, HashMap.empty) - matchFieldValues' _ _ Nothing = Nothing - matchFieldValues' fieldName inputField (Just (objectValue, resultMap)) = - let (In.InputField _ fieldType _) = inputField - insert = flip (HashMap.insert fieldName) resultMap - newObjectValue = HashMap.delete fieldName objectValue - in case HashMap.lookup fieldName objectValue of - Just variableValue -> do - coerced <- coerceVariableValue fieldType variableValue - pure (newObjectValue, insert coerced) - Nothing -> Just (objectValue, resultMap) - coerceVariableValue (In.ListBaseType listType) value - | (Aeson.Array arrayValue) <- value = - Type.List <$> foldr foldVector (Just []) arrayValue - | otherwise = coerceVariableValue listType value - where - foldVector _ Nothing = Nothing - foldVector variableValue (Just list) = do - coerced <- coerceVariableValue listType variableValue - pure $ coerced : list - coerceVariableValue _ _ = Nothing -#endif diff --git a/src/Test/Hspec/GraphQL.hs b/src/Test/Hspec/GraphQL.hs deleted file mode 100644 index a848c15..0000000 --- a/src/Test/Hspec/GraphQL.hs +++ /dev/null @@ -1,49 +0,0 @@ -{- This Source Code Form is subject to the terms of the Mozilla Public License, - 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 CPP #-} - -#ifdef WITH_JSON -{-# LANGUAGE ExplicitForAll #-} -{-# LANGUAGE OverloadedStrings #-} - --- | Test helpers. -module Test.Hspec.GraphQL {-# DEPRECATED "Use graphql-spice package instead" #-} - ( shouldResolve - , shouldResolveTo - ) where - -import Control.Monad.Catch (MonadCatch) -import qualified Data.Aeson as Aeson -import qualified Data.HashMap.Strict as HashMap -import Data.Text (Text) -import Language.GraphQL.Error -import Test.Hspec.Expectations (Expectation, expectationFailure, shouldBe, shouldNotSatisfy) - --- | Asserts that a query resolves to some value. -shouldResolveTo :: MonadCatch m - => Either (ResponseEventStream m Aeson.Value) Aeson.Object - -> Aeson.Object - -> Expectation -shouldResolveTo (Right actual) expected = actual `shouldBe` expected -shouldResolveTo _ _ = expectationFailure - "the query is expected to resolve to a value, but it resolved to an event stream" - --- | Asserts that the response doesn't contain any errors. -shouldResolve :: MonadCatch m - => (Text -> IO (Either (ResponseEventStream m Aeson.Value) Aeson.Object)) - -> Text - -> Expectation -shouldResolve executor query = do - actual <- executor query - case actual of - Right response -> - response `shouldNotSatisfy` HashMap.member "errors" - _ -> expectationFailure - "the query is expected to resolve to a value, but it resolved to an event stream" -#else -module Test.Hspec.GraphQL {-# DEPRECATED "Use graphql-spice package instead" #-} - ( - ) where -#endif |