graphql 1.0.1.0 → 1.0.2.0
raw patch · 13 files changed
+217/−588 lines, 13 filesdep ~QuickCheckdep ~aesondep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: QuickCheck, aeson, base, conduit, containers, exceptions, hspec, hspec-megaparsec, megaparsec, parser-combinators, scientific, template-haskell, text, transformers, unordered-containers, vector
API changes (from Hackage documentation)
+ Language.GraphQL.Execute.Coerce: instance Language.GraphQL.Execute.Coerce.Serialize Language.GraphQL.Type.Definition.Value
+ Language.GraphQL.Execute.Coerce: instance Language.GraphQL.Execute.Coerce.VariableValue Language.GraphQL.Type.Definition.Value
Files
- CHANGELOG.md +8/−0
- graphql.cabal +77/−70
- src/Language/GraphQL.hs +9/−0
- src/Language/GraphQL/Execute/Coerce.hs +77/−20
- src/Language/GraphQL/Type/Schema.hs +2/−2
- src/Language/GraphQL/Validate/Rules.hs +5/−7
- src/Test/Hspec/GraphQL.hs +8/−0
- tests/Language/GraphQL/ErrorSpec.hs +2/−2
- tests/Language/GraphQL/Execute/CoerceSpec.hs +1/−75
- tests/Language/GraphQL/ExecuteSpec.hs +28/−44
- tests/Test/DirectiveSpec.hs +0/−92
- tests/Test/FragmentSpec.hs +0/−204
- tests/Test/RootOperationSpec.hs +0/−72
CHANGELOG.md view
@@ -6,6 +6,13 @@ and this project adheres to [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [1.0.2.0] - 2021-12-26+### Added+- `Serialize` instance for `Type.Definition.Value`.+- `VariableValue` instance for `Type.Definition.Value`.+- `Json` build flag, enabled by default. JSON and Aeson support can be disabled+ by disabling this flag.+ ## [1.0.1.0] - 2021-09-27 ### Added - Custom `Show` instance for `Type.Definition.Value` (for error@@ -459,6 +466,7 @@ ### Added - Data types for the GraphQL language. +[1.0.2.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=1.0.2.0&rev_to=v1.0.1.0 [1.0.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.1.0&rev_to=v1.0.0.0 [1.0.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.0.0&rev_to=v0.11.1.0 [0.11.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.11.1.0&rev_to=v0.11.0.0
graphql.cabal view
@@ -1,7 +1,7 @@-cabal-version: 2.2+cabal-version: 2.4 name: graphql-version: 1.0.1.0+version: 1.0.2.0 synopsis: Haskell GraphQL implementation description: Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation. category: Language@@ -18,93 +18,100 @@ LICENSE.MPL build-type: Simple extra-source-files:- CHANGELOG.md- README.md+ CHANGELOG.md+ README.md tested-with:- GHC == 8.10.7- , GHC == 9.0.1+ GHC == 8.10.7,+ GHC == 9.0.1,+ GHC == 9.2.1 source-repository head type: git location: git://caraus.tech/pub/graphql.git +flag Json+ description: Whether to build against @aeson 1.x@+ default: True+ manual: True+ library exposed-modules:- Language.GraphQL- Language.GraphQL.AST- Language.GraphQL.AST.DirectiveLocation- Language.GraphQL.AST.Document- Language.GraphQL.AST.Encoder- Language.GraphQL.AST.Lexer- Language.GraphQL.AST.Parser- Language.GraphQL.Error- Language.GraphQL.Execute- Language.GraphQL.Execute.Coerce- Language.GraphQL.Execute.OrderedMap- Language.GraphQL.TH- Language.GraphQL.Type- Language.GraphQL.Type.In- Language.GraphQL.Type.Out- Language.GraphQL.Type.Schema- Language.GraphQL.Validate- Language.GraphQL.Validate.Validation- Test.Hspec.GraphQL+ Language.GraphQL+ Language.GraphQL.AST+ Language.GraphQL.AST.DirectiveLocation+ Language.GraphQL.AST.Document+ Language.GraphQL.AST.Encoder+ Language.GraphQL.AST.Lexer+ Language.GraphQL.AST.Parser+ Language.GraphQL.Error+ Language.GraphQL.Execute+ Language.GraphQL.Execute.Coerce+ Language.GraphQL.Execute.OrderedMap+ Language.GraphQL.TH+ Language.GraphQL.Type+ Language.GraphQL.Type.In+ Language.GraphQL.Type.Out+ Language.GraphQL.Type.Schema+ Language.GraphQL.Validate+ Language.GraphQL.Validate.Validation+ Test.Hspec.GraphQL other-modules:- Language.GraphQL.Execute.Transform- Language.GraphQL.Type.Definition- Language.GraphQL.Type.Internal- Language.GraphQL.Validate.Rules+ Language.GraphQL.Execute.Transform+ Language.GraphQL.Type.Definition+ Language.GraphQL.Type.Internal+ Language.GraphQL.Validate.Rules hs-source-dirs:- src+ src ghc-options: -Wall+ build-depends:- aeson >= 1.5.6 && < 1.6- , base >= 4.7 && < 5- , conduit >= 1.3.4 && < 1.4- , containers >= 0.6.2 && < 0.7- , exceptions >= 0.10.4 && < 0.11- , hspec-expectations >= 0.8.2 && < 0.9- , megaparsec >= 9.0.1 && < 9.1- , parser-combinators >= 1.3.0 && < 1.4- , scientific >= 0.3.7 && < 0.4- , template-haskell >= 2.16 && < 2.18- , text >= 1.2.4 && < 1.3- , transformers >= 0.5.6 && < 0.6- , unordered-containers >= 0.2.14 && < 0.3- , vector >= 0.12.3 && < 0.13+ base >= 4.7 && < 5,+ conduit ^>= 1.3.4,+ containers ^>= 0.6.2,+ exceptions ^>= 0.10.4,+ megaparsec >= 9.0 && < 10,+ parser-combinators >= 1.3 && < 2,+ template-haskell >= 2.16 && < 3,+ text ^>= 1.2.4,+ transformers ^>= 0.5.6,+ unordered-containers ^>= 0.2.14,+ vector ^>= 0.12.3+ if flag(Json)+ build-depends:+ aeson >= 1.5.6 && < 1.6,+ hspec-expectations >= 0.8.2 && < 0.9,+ scientific >= 0.3.7 && < 0.4+ cpp-options: -DWITH_JSON+ default-language: Haskell2010 test-suite graphql-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules:- Language.GraphQL.AST.DocumentSpec- Language.GraphQL.AST.EncoderSpec- Language.GraphQL.AST.LexerSpec- Language.GraphQL.AST.ParserSpec- Language.GraphQL.ErrorSpec- Language.GraphQL.Execute.CoerceSpec- Language.GraphQL.Execute.OrderedMapSpec- Language.GraphQL.ExecuteSpec- Language.GraphQL.Type.OutSpec- Language.GraphQL.Validate.RulesSpec- Test.DirectiveSpec- Test.FragmentSpec- Test.RootOperationSpec+ Language.GraphQL.AST.DocumentSpec+ Language.GraphQL.AST.EncoderSpec+ Language.GraphQL.AST.LexerSpec+ Language.GraphQL.AST.ParserSpec+ Language.GraphQL.ErrorSpec+ Language.GraphQL.Execute.CoerceSpec+ Language.GraphQL.Execute.OrderedMapSpec+ Language.GraphQL.ExecuteSpec+ Language.GraphQL.Type.OutSpec+ Language.GraphQL.Validate.RulesSpec hs-source-dirs:- tests+ tests ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ build-depends:- QuickCheck >= 2.14.1 && < 2.15- , aeson- , base >= 4.8 && < 5- , conduit- , exceptions- , graphql- , hspec >= 2.8.2 && < 2.9- , hspec-megaparsec >= 2.2.0 && < 2.3- , megaparsec- , scientific- , text- , unordered-containers+ QuickCheck ^>= 2.14.1,+ base,+ conduit,+ exceptions,+ graphql,+ hspec ^>= 2.9.1,+ hspec-megaparsec ^>= 2.2.0,+ megaparsec,+ text,+ unordered-containers default-language: Haskell2010
src/Language/GraphQL.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE CPP #-}++#ifdef WITH_JSON {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -73,3 +76,9 @@ [ ("line", Aeson.toJSON line) , ("column", Aeson.toJSON column) ]+#else+-- | This module provides the functions to parse and execute @GraphQL@ queries.+module Language.GraphQL+ (+ ) where+#endif
src/Language/GraphQL/Execute/Coerce.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE CPP #-} -- | Types and functions used for input and result coercion. module Language.GraphQL.Execute.Coerce@@ -15,7 +16,10 @@ , 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@@ -24,7 +28,6 @@ import qualified Data.Text.Lazy as Text.Lazy import qualified Data.Text.Lazy.Builder as Text.Builder import qualified Data.Text.Lazy.Builder.Int as Text.Builder-import Data.Scientific (toBoundedInteger, toRealFloat) import Language.GraphQL.AST (Name) import Language.GraphQL.Execute.OrderedMap (OrderedMap) import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap@@ -61,20 +64,13 @@ -> a -- ^ Variable value being coerced. -> Maybe Type.Value -- ^ Coerced value on success, 'Nothing' otherwise. -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) =+instance VariableValue Type.Value where+ coerceVariableValue _ Type.Null = Just Type.Null+ coerceVariableValue (In.ScalarBaseType _) value = Just value+ coerceVariableValue (In.EnumBaseType _) (Type.Enum stringValue) = Just $ Type.Enum stringValue coerceVariableValue (In.InputObjectBaseType objectType) value- | (Aeson.Object objectValue) <- value = do+ | (Type.Object objectValue) <- value = do let (In.InputObjectType _ _ inputFields) = objectType (newObjectValue, resultMap) <- foldWithKey objectValue inputFields if HashMap.null newObjectValue@@ -94,14 +90,9 @@ pure (newObjectValue, insert coerced) Nothing -> Just (objectValue, resultMap) coerceVariableValue (In.ListBaseType listType) value- | (Aeson.Array arrayValue) <- value =- Type.List <$> foldr foldVector (Just []) arrayValue+ | (Type.List arrayValue) <- value =+ Type.List <$> traverse (coerceVariableValue listType) arrayValue | otherwise = coerceVariableValue listType value- where- foldVector _ Nothing = Nothing- foldVector variableValue (Just list) = do- coerced <- coerceVariableValue listType variableValue- pure $ coerced : list coerceVariableValue _ _ = Nothing -- | Looks up a value by name in the given map, coerces it and inserts into the@@ -216,6 +207,28 @@ instance forall a. IsString (Output a) where fromString = String . fromString +instance Serialize Type.Value where+ null = Type.Null+ serialize (Out.ScalarBaseType scalarType) value+ | Type.ScalarType "Int" _ <- scalarType+ , Int int <- value = Just $ Type.Int int+ | Type.ScalarType "Float" _ <- scalarType+ , Float float <- value = Just $ Type.Float float+ | Type.ScalarType "String" _ <- scalarType+ , String string <- value = Just $ Type.String string+ | Type.ScalarType "ID" _ <- scalarType+ , String string <- value = Just $ Type.String string+ | Type.ScalarType "Boolean" _ <- scalarType+ , Boolean boolean <- value = Just $ Type.Boolean boolean+ serialize _ (Enum enum) = Just $ Type.Enum enum+ serialize _ (List list) = Just $ Type.List list+ serialize _ (Object object) = Just+ $ Type.Object+ $ HashMap.fromList+ $ OrderedMap.toList object+ serialize _ _ = Nothing++#ifdef WITH_JSON instance Serialize Aeson.Value where serialize (Out.ScalarBaseType scalarType) value | Type.ScalarType "Int" _ <- scalarType@@ -236,3 +249,47 @@ $ 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
src/Language/GraphQL/Type/Schema.hs view
@@ -205,5 +205,5 @@ let Out.ObjectType _ _ interfaces _ = objectType in foldr (add implementation) accumulator interfaces go _ accumulator = accumulator- add implementation (Out.InterfaceType typeName _ _ _) accumulator =- HashMap.insertWith (++) typeName [implementation] accumulator+ add implementation (Out.InterfaceType typeName _ _ _) =+ HashMap.insertWith (++) typeName [implementation]
src/Language/GraphQL/Validate/Rules.hs view
@@ -152,7 +152,7 @@ where errorMessage = "Anonymous Subscription must select only one top level field."- collectFields selectionSet = foldM forEach HashSet.empty selectionSet+ collectFields = foldM forEach HashSet.empty forEach accumulator = \case Full.FieldSelection fieldSelection -> forField accumulator fieldSelection Full.FragmentSpreadSelection fragmentSelection ->@@ -472,7 +472,7 @@ collectCycles :: Traversable t => t Full.Selection -> StateT (Int, Full.Name) (ReaderT (Validation m) Seq) (HashMap Full.Name Int)- collectCycles selectionSet = foldM forEach HashMap.empty selectionSet+ collectCycles = foldM forEach HashMap.empty forEach accumulator = \case Full.FieldSelection fieldSelection -> forField accumulator fieldSelection Full.InlineFragmentSelection fragmentSelection ->@@ -702,8 +702,7 @@ where go (Full.Node (Full.Object fields) _) = filterFieldDuplicates fields go _ = mempty- filterFieldDuplicates fields =- filterDuplicates getFieldName "input field" fields+ filterFieldDuplicates = filterDuplicates getFieldName "input field" getFieldName (Full.ObjectField fieldName _ location') = (fieldName, location') constGo (Full.Node (Full.ConstObject fields) _) = filterFieldDuplicates fields constGo _ = mempty@@ -1331,8 +1330,8 @@ -> Type.CompositeType m -> t Full.Selection -> ValidationState m (Seq Error)- visitSelectionSet variables selectionType selections =- foldM (evaluateSelection variables selectionType) mempty selections+ visitSelectionSet variables selectionType =+ foldM (evaluateSelection variables selectionType) mempty evaluateFieldSelection variables selections accumulator = \case Just newParentType -> do let folder = evaluateSelection variables newParentType@@ -1617,4 +1616,3 @@ } | otherwise -> mempty _ -> checkResult-
src/Test/Hspec/GraphQL.hs view
@@ -2,6 +2,9 @@ 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 #-} @@ -39,3 +42,8 @@ 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+ (+ ) where+#endif
tests/Language/GraphQL/ErrorSpec.hs view
@@ -7,9 +7,9 @@ ( spec ) where -import qualified Data.Aeson as Aeson import Data.List.NonEmpty (NonEmpty (..)) import Language.GraphQL.Error+import qualified Language.GraphQL.Type as Type import Test.Hspec ( Spec , describe@@ -31,6 +31,6 @@ , pstateTabWidth = mkPos 1 , pstateLinePrefix = "" }- Response Aeson.Null actual <-+ Response Type.Null actual <- parseError (ParseErrorBundle parseErrors posState) length actual `shouldBe` 1
tests/Language/GraphQL/Execute/CoerceSpec.hs view
@@ -7,12 +7,8 @@ ( spec ) where -import Data.Aeson as Aeson ((.=))-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson import qualified Data.HashMap.Strict as HashMap import Data.Maybe (isNothing)-import Data.Scientific (scientific) import qualified Language.GraphQL.Execute.Coerce as Coerce import Language.GraphQL.Type import qualified Language.GraphQL.Type.In as In@@ -27,81 +23,11 @@ , ("WEST", EnumValue Nothing) ] -singletonInputObject :: In.Type-singletonInputObject = In.NamedInputObjectType type'- where- type' = In.InputObjectType "ObjectName" Nothing inputFields- inputFields = HashMap.singleton "field" field- field = In.InputField Nothing (In.NamedScalarType string) Nothing- namedIdType :: In.Type namedIdType = In.NamedScalarType id spec :: Spec-spec = do- describe "VariableValue Aeson" $ do- it "coerces strings" $- let expected = Just (String "asdf")- actual = Coerce.coerceVariableValue- (In.NamedScalarType string) (Aeson.String "asdf")- in actual `shouldBe` expected- it "coerces non-null strings" $- let expected = Just (String "asdf")- actual = Coerce.coerceVariableValue- (In.NonNullScalarType string) (Aeson.String "asdf")- in actual `shouldBe` expected- it "coerces booleans" $- let expected = Just (Boolean True)- actual = Coerce.coerceVariableValue- (In.NamedScalarType boolean) (Aeson.Bool True)- in actual `shouldBe` expected- it "coerces zero to an integer" $- let expected = Just (Int 0)- actual = Coerce.coerceVariableValue- (In.NamedScalarType int) (Aeson.Number 0)- in actual `shouldBe` expected- it "rejects fractional if an integer is expected" $- let actual = Coerce.coerceVariableValue- (In.NamedScalarType int) (Aeson.Number $ scientific 14 (-1))- in actual `shouldSatisfy` isNothing- it "coerces float numbers" $- let expected = Just (Float 1.4)- actual = Coerce.coerceVariableValue- (In.NamedScalarType float) (Aeson.Number $ scientific 14 (-1))- in actual `shouldBe` expected- it "coerces IDs" $- let expected = Just (String "1234")- json = Aeson.String "1234"- actual = Coerce.coerceVariableValue namedIdType json- in actual `shouldBe` expected- it "coerces input objects" $- let actual = Coerce.coerceVariableValue singletonInputObject- $ Aeson.object ["field" .= ("asdf" :: Aeson.Value)]- expected = Just $ Object $ HashMap.singleton "field" "asdf"- in actual `shouldBe` expected- it "skips the field if it is missing in the variables" $- let actual = Coerce.coerceVariableValue- singletonInputObject Aeson.emptyObject- expected = Just $ Object HashMap.empty- in actual `shouldBe` expected- it "fails if input object value contains extra fields" $- let actual = Coerce.coerceVariableValue singletonInputObject- $ Aeson.object variableFields- variableFields =- [ "field" .= ("asdf" :: Aeson.Value)- , "extra" .= ("qwer" :: Aeson.Value)- ]- in actual `shouldSatisfy` isNothing- it "preserves null" $- let actual = Coerce.coerceVariableValue namedIdType Aeson.Null- in actual `shouldBe` Just Null- it "preserves list order" $- let list = Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"]- listType = (In.ListType $ In.NamedScalarType string)- actual = Coerce.coerceVariableValue listType list- expected = Just $ List [String "asdf", String "qwer"]- in actual `shouldBe` expected-+spec = describe "coerceInputLiteral" $ do it "coerces enums" $ let expected = Just (Enum "NORTH")
tests/Language/GraphQL/ExecuteSpec.hs view
@@ -10,9 +10,6 @@ import Control.Exception (Exception(..), SomeException) import Control.Monad.Catch (throwM)-import Data.Aeson ((.=))-import qualified Data.Aeson as Aeson-import Data.Aeson.Types (emptyObject) import Data.Conduit import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap@@ -189,12 +186,12 @@ ] type EitherStreamOrValue = Either- (ResponseEventStream (Either SomeException) Aeson.Value)- (Response Aeson.Value)+ (ResponseEventStream (Either SomeException) Value)+ (Response Value) execute' :: Document -> Either SomeException EitherStreamOrValue execute' =- execute philosopherSchema Nothing (mempty :: HashMap Name Aeson.Value)+ execute philosopherSchema Nothing (mempty :: HashMap Name Value) spec :: Spec spec =@@ -209,38 +206,37 @@ ...cyclicFragment } |]- expected = Response emptyObject mempty+ expected = Response (Object mempty) mempty Right (Right actual) = either (pure . parseError) execute' $ parse document "" sourceQuery in actual `shouldBe` expected context "Query" $ do it "skips unknown fields" $- let data'' = Aeson.object- [ "philosopher" .= Aeson.object- [ "firstName" .= ("Friedrich" :: String)- ]- ]+ let data'' = Object+ $ HashMap.singleton "philosopher"+ $ Object+ $ HashMap.singleton "firstName"+ $ String "Friedrich" expected = Response data'' mempty Right (Right actual) = either (pure . parseError) execute' $ parse document "" "{ philosopher { firstName surname } }" in actual `shouldBe` expected it "merges selections" $- let data'' = Aeson.object- [ "philosopher" .= Aeson.object- [ "firstName" .= ("Friedrich" :: String)- , "lastName" .= ("Nietzsche" :: String)+ let data'' = Object+ $ HashMap.singleton "philosopher"+ $ Object+ $ HashMap.fromList+ [ ("firstName", String "Friedrich")+ , ("lastName", String "Nietzsche") ]- ] expected = Response data'' mempty Right (Right actual) = either (pure . parseError) execute' $ parse document "" "{ philosopher { firstName } philosopher { lastName } }" in actual `shouldBe` expected it "errors on invalid output enum values" $- let data'' = Aeson.object- [ "philosopher" .= Aeson.Null- ]+ let data'' = Object $ HashMap.singleton "philosopher" Null executionErrors = pure $ Error { message = "Value completion error. Expected type !School, found: EXISTENTIALISM."@@ -253,9 +249,7 @@ in actual `shouldBe` expected it "gives location information for non-null unions" $- let data'' = Aeson.object- [ "philosopher" .= Aeson.Null- ]+ let data'' = Object $ HashMap.singleton "philosopher" Null executionErrors = pure $ Error { message = "Value completion error. Expected type !Interest, found: { instrument: \"piano\" }."@@ -268,9 +262,7 @@ in actual `shouldBe` expected it "gives location information for invalid interfaces" $- let data'' = Aeson.object- [ "philosopher" .= Aeson.Null- ]+ let data'' = Object $ HashMap.singleton "philosopher" Null executionErrors = pure $ Error { message = "Value completion error. Expected type !Work, found:\@@ -284,9 +276,7 @@ in actual `shouldBe` expected it "gives location information for invalid scalar arguments" $- let data'' = Aeson.object- [ "philosopher" .= Aeson.Null- ]+ let data'' = Object $ HashMap.singleton "philosopher" Null executionErrors = pure $ Error { message = "Argument \"id\" has invalid type. Expected type ID, found: True."@@ -299,9 +289,7 @@ in actual `shouldBe` expected it "gives location information for failed result coercion" $- let data'' = Aeson.object- [ "philosopher" .= Aeson.Null- ]+ let data'' = Object $ HashMap.singleton "philosopher" Null executionErrors = pure $ Error { message = "Unable to coerce result to !Int." , locations = [Location 1 26]@@ -313,9 +301,7 @@ in actual `shouldBe` expected it "gives location information for failed result coercion" $- let data'' = Aeson.object- [ "genres" .= Aeson.Null- ]+ let data'' = Object $ HashMap.singleton "genres" Null executionErrors = pure $ Error { message = "PhilosopherException" , locations = [Location 1 3]@@ -332,15 +318,13 @@ , locations = [Location 1 3] , path = [Segment "count"] }- expected = Response Aeson.Null executionErrors+ expected = Response Null executionErrors Right (Right actual) = either (pure . parseError) execute' $ parse document "" "{ count }" in actual `shouldBe` expected it "detects nullability errors" $- let data'' = Aeson.object- [ "philosopher" .= Aeson.Null- ]+ let data'' = Object $ HashMap.singleton "philosopher" Null executionErrors = pure $ Error { message = "Value completion error. Expected type !String, found: null." , locations = [Location 1 26]@@ -353,11 +337,11 @@ context "Subscription" $ it "subscribes" $- let data'' = Aeson.object- [ "newQuote" .= Aeson.object- [ "quote" .= ("Naturam expelles furca, tamen usque recurret." :: String)- ]- ]+ let data'' = Object+ $ HashMap.singleton "newQuote"+ $ Object+ $ HashMap.singleton "quote"+ $ String "Naturam expelles furca, tamen usque recurret." expected = Response data'' mempty Right (Left stream) = either (pure . parseError) execute' $ parse document "" "subscription { newQuote { quote } }"
− tests/Test/DirectiveSpec.hs
@@ -1,92 +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 OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-module Test.DirectiveSpec- ( spec- ) where--import Data.Aeson (object, (.=))-import qualified Data.Aeson as Aeson-import qualified Data.HashMap.Strict as HashMap-import Language.GraphQL-import Language.GraphQL.TH-import Language.GraphQL.Type-import qualified Language.GraphQL.Type.Out as Out-import Test.Hspec (Spec, describe, it)-import Test.Hspec.GraphQL--experimentalResolver :: Schema IO-experimentalResolver = schema queryType Nothing Nothing mempty- where- queryType = Out.ObjectType "Query" Nothing []- $ HashMap.singleton "experimentalField"- $ Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)- $ pure $ Int 5--emptyObject :: Aeson.Object-emptyObject = HashMap.singleton "data" $ object []--spec :: Spec-spec =- describe "Directive executor" $ do- it "should be able to @skip fields" $ do- let sourceQuery = [gql|- {- experimentalField @skip(if: true)- }- |]-- actual <- graphql experimentalResolver sourceQuery- actual `shouldResolveTo` emptyObject-- it "should not skip fields if @skip is false" $ do- let sourceQuery = [gql|- {- experimentalField @skip(if: false)- }- |]- expected = HashMap.singleton "data"- $ object- [ "experimentalField" .= (5 :: Int)- ]- actual <- graphql experimentalResolver sourceQuery- actual `shouldResolveTo` expected-- it "should skip fields if @include is false" $ do- let sourceQuery = [gql|- {- experimentalField @include(if: false)- }- |]-- actual <- graphql experimentalResolver sourceQuery- actual `shouldResolveTo` emptyObject-- it "should be able to @skip a fragment spread" $ do- let sourceQuery = [gql|- {- ...experimentalFragment @skip(if: true)- }-- fragment experimentalFragment on Query {- experimentalField- }- |]-- actual <- graphql experimentalResolver sourceQuery- actual `shouldResolveTo` emptyObject-- it "should be able to @skip an inline fragment" $ do- let sourceQuery = [gql|- {- ... on Query @skip(if: true) {- experimentalField- }- }- |]-- actual <- graphql experimentalResolver sourceQuery- actual `shouldResolveTo` emptyObject
− tests/Test/FragmentSpec.hs
@@ -1,204 +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 OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-module Test.FragmentSpec- ( spec- ) where--import Data.Aeson ((.=))-import qualified Data.Aeson as Aeson-import qualified Data.HashMap.Strict as HashMap-import Data.Text (Text)-import Language.GraphQL-import Language.GraphQL.Type-import qualified Language.GraphQL.Type.Out as Out-import Language.GraphQL.TH-import Test.Hspec (Spec, describe, it)-import Test.Hspec.GraphQL--size :: (Text, Value)-size = ("size", String "L")--circumference :: (Text, Value)-circumference = ("circumference", Int 60)--garment :: Text -> (Text, Value)-garment typeName =- ("garment", Object $ HashMap.fromList- [ if typeName == "Hat" then circumference else size- , ("__typename", String typeName)- ]- )--inlineQuery :: Text-inlineQuery = [gql|- {- garment {- ... on Hat {- circumference- }- ... on Shirt {- size- }- }- }-|]--shirtType :: Out.ObjectType IO-shirtType = Out.ObjectType "Shirt" Nothing [] $ HashMap.fromList- [ ("size", sizeFieldType)- ]--hatType :: Out.ObjectType IO-hatType = Out.ObjectType "Hat" Nothing [] $ HashMap.fromList- [ ("size", sizeFieldType)- , ("circumference", circumferenceFieldType)- ]--circumferenceFieldType :: Out.Resolver IO-circumferenceFieldType- = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)- $ pure $ snd circumference--sizeFieldType :: Out.Resolver IO-sizeFieldType- = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)- $ pure $ snd size--toSchema :: Text -> (Text, Value) -> Schema IO-toSchema t (_, resolve) = schema queryType Nothing Nothing mempty- where- garmentType = Out.UnionType "Garment" Nothing [hatType, shirtType]- typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty- garmentField = Out.Field Nothing (Out.NamedUnionType garmentType) mempty- queryType =- case t of- "circumference" -> hatType- "size" -> shirtType- _ -> Out.ObjectType "Query" Nothing []- $ HashMap.fromList- [ ("garment", ValueResolver garmentField (pure resolve))- , ("__typename", ValueResolver typeNameField (pure $ String "Shirt"))- ]--spec :: Spec-spec = do- describe "Inline fragment executor" $ do- it "chooses the first selection if the type matches" $ do- actual <- graphql (toSchema "Hat" $ garment "Hat") inlineQuery- let expected = HashMap.singleton "data"- $ Aeson.object- [ "garment" .= Aeson.object- [ "circumference" .= (60 :: Int)- ]- ]- in actual `shouldResolveTo` expected-- it "chooses the last selection if the type matches" $ do- actual <- graphql (toSchema "Shirt" $ garment "Shirt") inlineQuery- let expected = HashMap.singleton "data"- $ Aeson.object- [ "garment" .= Aeson.object- [ "size" .= ("L" :: Text)- ]- ]- in actual `shouldResolveTo` expected-- it "embeds inline fragments without type" $ do- let sourceQuery = [gql|- {- circumference- ... {- size- }- }- |]- actual <- graphql (toSchema "circumference" circumference) sourceQuery- let expected = HashMap.singleton "data"- $ Aeson.object- [ "circumference" .= (60 :: Int)- , "size" .= ("L" :: Text)- ]- in actual `shouldResolveTo` expected-- it "evaluates fragments on Query" $ do- let sourceQuery = [gql|- {- ... {- size- }- }- |]- in graphql (toSchema "size" size) `shouldResolve` sourceQuery-- describe "Fragment spread executor" $ do- it "evaluates fragment spreads" $ do- let sourceQuery = [gql|- {- ...circumferenceFragment- }-- fragment circumferenceFragment on Hat {- circumference- }- |]-- actual <- graphql (toSchema "circumference" circumference) sourceQuery- let expected = HashMap.singleton "data"- $ Aeson.object- [ "circumference" .= (60 :: Int)- ]- in actual `shouldResolveTo` expected-- it "evaluates nested fragments" $ do- let sourceQuery = [gql|- {- garment {- ...circumferenceFragment- }- }-- fragment circumferenceFragment on Hat {- ...hatFragment- }-- fragment hatFragment on Hat {- circumference- }- |]-- actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery- let expected = HashMap.singleton "data"- $ Aeson.object- [ "garment" .= Aeson.object- [ "circumference" .= (60 :: Int)- ]- ]- in actual `shouldResolveTo` expected-- it "considers type condition" $ do- let sourceQuery = [gql|- {- garment {- ...circumferenceFragment- ...sizeFragment- }- }- fragment circumferenceFragment on Hat {- circumference- }- fragment sizeFragment on Shirt {- size- }- |]- expected = HashMap.singleton "data"- $ Aeson.object- [ "garment" .= Aeson.object- [ "circumference" .= (60 :: Int)- ]- ]- actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery- actual `shouldResolveTo` expected
− tests/Test/RootOperationSpec.hs
@@ -1,72 +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 OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-module Test.RootOperationSpec- ( spec- ) where--import Data.Aeson ((.=), object)-import qualified Data.HashMap.Strict as HashMap-import Language.GraphQL-import Test.Hspec (Spec, describe, it)-import Language.GraphQL.TH-import Language.GraphQL.Type-import qualified Language.GraphQL.Type.Out as Out-import Test.Hspec.GraphQL--hatType :: Out.ObjectType IO-hatType = Out.ObjectType "Hat" Nothing []- $ HashMap.singleton "circumference"- $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)- $ pure $ Int 60--garmentSchema :: Schema IO-garmentSchema = schema queryType (Just mutationType) Nothing mempty- where- queryType = Out.ObjectType "Query" Nothing [] hatFieldResolver- mutationType = Out.ObjectType "Mutation" Nothing [] incrementFieldResolver- garment = pure $ Object $ HashMap.fromList- [ ("circumference", Int 60)- ]- incrementFieldResolver = HashMap.singleton "incrementCircumference"- $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)- $ pure $ Int 61- hatField = Out.Field Nothing (Out.NamedObjectType hatType) mempty- hatFieldResolver =- HashMap.singleton "garment" $ ValueResolver hatField garment--spec :: Spec-spec =- describe "Root operation type" $ do- it "returns objects from the root resolvers" $ do- let querySource = [gql|- {- garment {- circumference- }- }- |]- expected = HashMap.singleton "data"- $ object- [ "garment" .= object- [ "circumference" .= (60 :: Int)- ]- ]- actual <- graphql garmentSchema querySource- actual `shouldResolveTo` expected-- it "chooses Mutation" $ do- let querySource = [gql|- mutation {- incrementCircumference- }- |]- expected = HashMap.singleton "data"- $ object- [ "incrementCircumference" .= (61 :: Int)- ]- actual <- graphql garmentSchema querySource- actual `shouldResolveTo` expected