From 05e6aa4c95782e6525f37edb323959da4d65898e Mon Sep 17 00:00:00 2001 From: Dmitrii Skurikhin Date: Wed, 2 Feb 2022 20:52:46 +0300 Subject: [PATCH] add Arbitrary instances for AST.Document, add random arguments Parser test --- CHANGELOG.md | 3 + graphql.cabal | 1 + tests/Language/GraphQL/AST/Arbitrary.hs | 99 ++++++++++++++++++++++++ tests/Language/GraphQL/AST/ParserSpec.hs | 25 +++--- 4 files changed, 115 insertions(+), 13 deletions(-) create mode 100644 tests/Language/GraphQL/AST/Arbitrary.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index f9f7926..2d54639 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,9 @@ and this project adheres to swapped). - Parsing empty list as an argument. +### Added +- quickCheck Parser test for arguments. Arbitrary instances for Language.GraphQL.AST.Document. + ## [1.0.2.0] - 2021-12-26 ### Added - `Serialize` instance for `Type.Definition.Value`. diff --git a/graphql.cabal b/graphql.cabal index c81c01a..993c45b 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -93,6 +93,7 @@ test-suite graphql-test Language.GraphQL.AST.EncoderSpec Language.GraphQL.AST.LexerSpec Language.GraphQL.AST.ParserSpec + Language.GraphQL.AST.Arbitrary Language.GraphQL.ErrorSpec Language.GraphQL.Execute.CoerceSpec Language.GraphQL.Execute.OrderedMapSpec diff --git a/tests/Language/GraphQL/AST/Arbitrary.hs b/tests/Language/GraphQL/AST/Arbitrary.hs new file mode 100644 index 0000000..8d0544e --- /dev/null +++ b/tests/Language/GraphQL/AST/Arbitrary.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Language.GraphQL.AST.Arbitrary where + +import qualified Language.GraphQL.AST.Document as Doc +import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary)) +import Test.QuickCheck (oneof, elements, listOf, resize, NonEmptyList (..)) +import Test.QuickCheck.Gen (Gen (..)) +import Data.Text (Text, pack) + +newtype AnyPrintableChar = AnyPrintableChar { getAnyPrintableChar :: Char } deriving (Eq, Show) + +alpha :: String +alpha = ['a'..'z'] <> ['A'..'Z'] + +num :: String +num = ['0'..'9'] + +instance Arbitrary AnyPrintableChar where + arbitrary = AnyPrintableChar <$> elements chars + where + chars = alpha <> num <> ['_'] + +newtype AnyPrintableText = AnyPrintableText { getAnyPrintableText :: Text } deriving (Eq, Show) + +instance Arbitrary AnyPrintableText where + arbitrary = do + nonEmptyStr <- getNonEmpty <$> (arbitrary :: Gen (NonEmptyList AnyPrintableChar)) + pure $ AnyPrintableText (pack $ map getAnyPrintableChar nonEmptyStr) + +-- https://spec.graphql.org/June2018/#Name +newtype AnyName = AnyName { getAnyName :: Text } deriving (Eq, Show) + +instance Arbitrary AnyName where + arbitrary = do + firstChar <- elements $ alpha <> ['_'] + rest <- (arbitrary :: Gen [AnyPrintableChar]) + pure $ AnyName (pack $ firstChar : map getAnyPrintableChar rest) + +newtype AnyLocation = AnyLocation { getAnyLocation :: Doc.Location } deriving (Eq, Show) + +instance Arbitrary AnyLocation where + arbitrary = AnyLocation <$> (Doc.Location <$> arbitrary <*> arbitrary) + +newtype AnyNode a = AnyNode { getAnyNode :: Doc.Node a } deriving (Eq, Show) + +instance Arbitrary a => Arbitrary (AnyNode a) where + arbitrary = do + (AnyLocation location') <- arbitrary + node' <- flip Doc.Node location' <$> arbitrary + pure $ AnyNode node' + +newtype AnyObjectField a = AnyObjectField { getAnyObjectField :: Doc.ObjectField a } deriving (Eq, Show) + +instance Arbitrary a => Arbitrary (AnyObjectField a) where + arbitrary = do + name' <- getAnyName <$> arbitrary + value' <- getAnyNode <$> arbitrary + location' <- getAnyLocation <$> arbitrary + pure $ AnyObjectField $ Doc.ObjectField name' value' location' + +newtype AnyValue = AnyValue { getAnyValue :: Doc.Value } deriving (Eq, Show) + +instance Arbitrary AnyValue where + arbitrary = AnyValue <$> oneof + [ variableGen + , Doc.Int <$> arbitrary + , Doc.Float <$> arbitrary + , Doc.String <$> (getAnyPrintableText <$> arbitrary) + , Doc.Boolean <$> arbitrary + , MkGen $ \_ _ -> Doc.Null + , Doc.Enum <$> (getAnyName <$> arbitrary) + , Doc.List <$> listGen + , Doc.Object <$> objectGen + ] + where + variableGen :: Gen Doc.Value + variableGen = Doc.Variable <$> (getAnyName <$> arbitrary) + listGen :: Gen [Doc.Node Doc.Value] + listGen = (resize 5 . listOf) nodeGen + nodeGen = do + node' <- getAnyNode <$> (arbitrary :: Gen (AnyNode AnyValue)) + pure (getAnyValue <$> node') + objectGen :: Gen [Doc.ObjectField Doc.Value] + objectGen = resize 1 $ do + list <- getNonEmpty <$> (arbitrary :: Gen (NonEmptyList (AnyObjectField AnyValue))) + pure $ map (fmap getAnyValue . getAnyObjectField) list + +newtype AnyArgument a = AnyArgument { getAnyArgument :: Doc.Argument } deriving (Eq, Show) + +instance Arbitrary a => Arbitrary (AnyArgument a) where + arbitrary = do + name' <- getAnyName <$> arbitrary + (AnyValue value') <- arbitrary + (AnyLocation location') <- arbitrary + pure $ AnyArgument $ Doc.Argument name' (Doc.Node value' location') location' + +printArgument :: AnyArgument AnyValue -> Text +printArgument (AnyArgument (Doc.Argument name' (Doc.Node value' _) _)) = name' <> ": " <> (pack . show) value' diff --git a/tests/Language/GraphQL/AST/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs index dbdc063..13faa21 100644 --- a/tests/Language/GraphQL/AST/ParserSpec.hs +++ b/tests/Language/GraphQL/AST/ParserSpec.hs @@ -5,6 +5,8 @@ module Language.GraphQL.AST.ParserSpec ) where import Data.List.NonEmpty (NonEmpty(..)) +import Data.Text (Text) +import qualified Data.Text as Text import Language.GraphQL.AST.Document import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc import Language.GraphQL.AST.Parser @@ -12,6 +14,8 @@ import Language.GraphQL.TH import Test.Hspec (Spec, describe, it, context) import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn) import Text.Megaparsec (parse) +import Test.QuickCheck (property, NonEmptyList (..), mapSize) +import Language.GraphQL.AST.Arbitrary spec :: Spec spec = describe "Parser" $ do @@ -29,7 +33,7 @@ spec = describe "Parser" $ do hello(text: "Argument") }|] - it "accepts int as argument" $ + it "accepts int as argument1" $ parse document "" `shouldSucceedOn` [gql|{ user(id: 4) }|] @@ -66,8 +70,13 @@ spec = describe "Parser" $ do mutation auth{ test(username: """username""", password: """password""") }|] - - + + it "accepts any arguments" $ mapSize (const 10) $ property $ \xs -> + let + query' :: Text + arguments = map printArgument $ getNonEmpty (xs :: NonEmptyList (AnyArgument AnyValue)) + query' = "query(" <> Text.intercalate ", " arguments <> ")" in + parse document "" `shouldSucceedOn` ("{ " <> query' <> " }") it "parses minimal schema definition" $ parse document "" `shouldSucceedOn` [gql|schema { query: Query }|] @@ -118,16 +127,6 @@ spec = describe "Parser" $ do } |] - it "parses minimal enum type definition" $ - parse document "" `shouldSucceedOn` [gql| - enum Direction { - NORTH - EAST - SOUTH - WEST - } - |] - it "parses minimal input object type definition" $ parse document "" `shouldSucceedOn` [gql| input Point2D {