prescientmoon/graphql
1
0
Fork 0
forked from OSS/graphql
Code Pull Requests Activity

Fix block alignment in some parser tests

Browse Source
This commit is contained in:
Eugen Wissner 2024-10-17 18:08:30 +02:00
parent b056b4256f
commit cdb2aa76b6
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
3 changed files with 148 additions and 157 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
tests/Language/GraphQL/AST/Arbitrary.hs
View File

@ -1,15 +1,26 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Language.GraphQL.AST.Arbitrary where module Language.GraphQL.AST.Arbitrary
( AnyArgument(..)
, AnyLocation(..)
, AnyName(..)
, AnyNode(..)
, AnyObjectField(..)
, AnyValue(..)
, printArgument
) where
import qualified Language.GraphQL.AST.Document as Doc import qualified Language.GraphQL.AST.Document as Doc
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary)) import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
import Test.QuickCheck (oneof, elements, listOf, resize, NonEmptyList (..)) import Test.QuickCheck (oneof, elements, listOf, resize, NonEmptyList (..))
import Test.QuickCheck.Gen (Gen (..)) import Test.QuickCheck.Gen (Gen (..))
import Data.Text (Text, pack) import Data.Text (Text)
import qualified Data.Text as Text
import Data.Functor ((<&>)) import Data.Functor ((<&>))
newtype AnyPrintableChar = AnyPrintableChar { getAnyPrintableChar :: Char } deriving (Eq, Show) newtype AnyPrintableChar = AnyPrintableChar
{ getAnyPrintableChar :: Char
} deriving (Eq, Show)
alpha :: String alpha :: String
alpha = ['a'..'z'] <> ['A'..'Z'] alpha = ['a'..'z'] <> ['A'..'Z']
@ -20,30 +31,42 @@ num = ['0'..'9']
instance Arbitrary AnyPrintableChar where instance Arbitrary AnyPrintableChar where
arbitrary = AnyPrintableChar <$> elements chars arbitrary = AnyPrintableChar <$> elements chars
where where
chars = alpha <> num <> ['_'] chars = alpha <> num <> ['_']
newtype AnyPrintableText = AnyPrintableText { getAnyPrintableText :: Text } deriving (Eq, Show) newtype AnyPrintableText = AnyPrintableText
{ getAnyPrintableText :: Text
} deriving (Eq, Show)
instance Arbitrary AnyPrintableText where instance Arbitrary AnyPrintableText where
arbitrary = do arbitrary = do
nonEmptyStr <- getNonEmpty <$> (arbitrary :: Gen (NonEmptyList AnyPrintableChar)) nonEmptyStr <- getNonEmpty <$> (arbitrary :: Gen (NonEmptyList AnyPrintableChar))
pure $ AnyPrintableText (pack $ map getAnyPrintableChar nonEmptyStr) pure $ AnyPrintableText
$ Text.pack
$ map getAnyPrintableChar nonEmptyStr
-- https://spec.graphql.org/June2018/#Name -- https://spec.graphql.org/June2018/#Name
newtype AnyName = AnyName { getAnyName :: Text } deriving (Eq, Show) newtype AnyName = AnyName
{ getAnyName :: Text
} deriving (Eq, Show)
instance Arbitrary AnyName where instance Arbitrary AnyName where
arbitrary = do arbitrary = do
firstChar <- elements $ alpha <> ['_'] firstChar <- elements $ alpha <> ['_']
rest <- (arbitrary :: Gen [AnyPrintableChar]) rest <- (arbitrary :: Gen [AnyPrintableChar])
pure $ AnyName (pack $ firstChar : map getAnyPrintableChar rest) pure $ AnyName
$ Text.pack
$ firstChar : map getAnyPrintableChar rest
newtype AnyLocation = AnyLocation { getAnyLocation :: Doc.Location } deriving (Eq, Show) newtype AnyLocation = AnyLocation
{ getAnyLocation :: Doc.Location
} deriving (Eq, Show)
instance Arbitrary AnyLocation where instance Arbitrary AnyLocation where
arbitrary = AnyLocation <$> (Doc.Location <$> arbitrary <*> arbitrary) arbitrary = AnyLocation <$> (Doc.Location <$> arbitrary <*> arbitrary)
newtype AnyNode a = AnyNode { getAnyNode :: Doc.Node a } deriving (Eq, Show) newtype AnyNode a = AnyNode
{ getAnyNode :: Doc.Node a
} deriving (Eq, Show)
instance Arbitrary a => Arbitrary (AnyNode a) where instance Arbitrary a => Arbitrary (AnyNode a) where
arbitrary = do arbitrary = do
@ -51,7 +74,9 @@ instance Arbitrary a => Arbitrary (AnyNode a) where
node' <- flip Doc.Node location' <$> arbitrary node' <- flip Doc.Node location' <$> arbitrary
pure $ AnyNode node' pure $ AnyNode node'
newtype AnyObjectField a = AnyObjectField { getAnyObjectField :: Doc.ObjectField a } deriving (Eq, Show) newtype AnyObjectField a = AnyObjectField
{ getAnyObjectField :: Doc.ObjectField a
} deriving (Eq, Show)
instance Arbitrary a => Arbitrary (AnyObjectField a) where instance Arbitrary a => Arbitrary (AnyObjectField a) where
arbitrary = do arbitrary = do
@ -60,8 +85,9 @@ instance Arbitrary a => Arbitrary (AnyObjectField a) where
location' <- getAnyLocation <$> arbitrary location' <- getAnyLocation <$> arbitrary
pure $ AnyObjectField $ Doc.ObjectField name' value' location' pure $ AnyObjectField $ Doc.ObjectField name' value' location'
newtype AnyValue = AnyValue { getAnyValue :: Doc.Value } newtype AnyValue = AnyValue
deriving (Eq, Show) { getAnyValue :: Doc.Value
} deriving (Eq, Show)
instance Arbitrary AnyValue instance Arbitrary AnyValue
where where
@ -88,8 +114,9 @@ instance Arbitrary AnyValue
, Doc.Object <$> objectGen , Doc.Object <$> objectGen
] ]
newtype AnyArgument a = AnyArgument { getAnyArgument :: Doc.Argument } newtype AnyArgument a = AnyArgument
deriving (Eq, Show) { getAnyArgument :: Doc.Argument
} deriving (Eq, Show)
instance Arbitrary a => Arbitrary (AnyArgument a) where instance Arbitrary a => Arbitrary (AnyArgument a) where
arbitrary = do arbitrary = do
@ -99,4 +126,5 @@ instance Arbitrary a => Arbitrary (AnyArgument a) where
pure $ AnyArgument $ Doc.Argument name' (Doc.Node value' location') location' pure $ AnyArgument $ Doc.Argument name' (Doc.Node value' location') location'
printArgument :: AnyArgument AnyValue -> Text printArgument :: AnyArgument AnyValue -> Text
printArgument (AnyArgument (Doc.Argument name' (Doc.Node value' _) _)) = name' <> ": " <> (pack . show) value' printArgument (AnyArgument (Doc.Argument name' (Doc.Node value' _) _)) =
name' <> ": " <> (Text.pack . show) value'

10
tests/Language/GraphQL/AST/EncoderSpec.hs
View File

@ -14,12 +14,9 @@ import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
spec :: Spec spec :: Spec
spec = do spec = do
describe "value" $ do describe "value" $ do
context "null value" $ do
let testNull formatter = value formatter Full.Null `shouldBe` "null"
it "minified" $ testNull minified
it "pretty" $ testNull pretty
context "minified" $ do context "minified" $ do
it "encodes null" $
value minified Full.Null `shouldBe` "null"
it "escapes \\" $ it "escapes \\" $
value minified (Full.String "\\") `shouldBe` "\"\\\\\"" value minified (Full.String "\\") `shouldBe` "\"\\\\\""
it "escapes double quotes" $ it "escapes double quotes" $
@ -45,6 +42,9 @@ spec = do
it "~" $ value minified (Full.String "\x007E") `shouldBe` "\"~\"" it "~" $ value minified (Full.String "\x007E") `shouldBe` "\"~\""
context "pretty" $ do context "pretty" $ do
it "encodes null" $
value pretty Full.Null `shouldBe` "null"
it "uses strings for short string values" $ it "uses strings for short string values" $
value pretty (Full.String "Short text") `shouldBe` "\"Short text\"" value pretty (Full.String "Short text") `shouldBe` "\"Short text\""
it "uses block strings for text with new lines, with newline symbol" $ it "uses block strings for text with new lines, with newline symbol" $

235
tests/Language/GraphQL/AST/ParserSpec.hs
View File

@ -1,16 +1,13 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.AST.ParserSpec module Language.GraphQL.AST.ParserSpec
( spec ( spec
) where ) where
import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import Language.GraphQL.AST.Document import Language.GraphQL.AST.Document
import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc
import Language.GraphQL.AST.Parser import Language.GraphQL.AST.Parser
import Language.GraphQL.TH
import Test.Hspec (Spec, describe, it, context) import Test.Hspec (Spec, describe, it, context)
import Test.Hspec.Megaparsec import Test.Hspec.Megaparsec
( shouldParse ( shouldParse
@ -28,127 +25,105 @@ spec = describe "Parser" $ do
parse document "" `shouldSucceedOn` "\xfeff{foo}" parse document "" `shouldSucceedOn` "\xfeff{foo}"
context "Arguments" $ do context "Arguments" $ do
it "accepts block strings as argument" $ it "accepts block strings as argument" $
parse document "" `shouldSucceedOn` [gql|{ parse document "" `shouldSucceedOn`
hello(text: """Argument""") "{ hello(text: \"\"\"Argument\"\"\") }"
}|]
it "accepts strings as argument" $ it "accepts strings as argument" $
parse document "" `shouldSucceedOn` [gql|{ parse document "" `shouldSucceedOn` "{ hello(text: \"Argument\") }"
hello(text: "Argument")
}|]
it "accepts int as argument1" $ it "accepts int as argument" $
parse document "" `shouldSucceedOn` [gql|{ parse document "" `shouldSucceedOn` "{ user(id: 4) }"
user(id: 4)
}|]
it "accepts boolean as argument" $ it "accepts boolean as argument" $
parse document "" `shouldSucceedOn` [gql|{ parse document "" `shouldSucceedOn`
hello(flag: true) { field1 } "{ hello(flag: true) { field1 } }"
}|]
it "accepts float as argument" $ it "accepts float as argument" $
parse document "" `shouldSucceedOn` [gql|{ parse document "" `shouldSucceedOn`
body(height: 172.5) { height } "{ body(height: 172.5) { height } }"
}|]
it "accepts empty list as argument" $ it "accepts empty list as argument" $
parse document "" `shouldSucceedOn` [gql|{ parse document "" `shouldSucceedOn` "{ query(list: []) { field1 } }"
query(list: []) { field1 }
}|]
it "accepts two required arguments" $ it "accepts two required arguments" $
parse document "" `shouldSucceedOn` [gql| parse document "" `shouldSucceedOn`
mutation auth($username: String!, $password: String!){ "mutation auth($username: String!, $password: String!) { test }"
test
}|]
it "accepts two string arguments" $ it "accepts two string arguments" $
parse document "" `shouldSucceedOn` [gql| parse document "" `shouldSucceedOn`
mutation auth{ "mutation auth { test(username: \"username\", password: \"password\") }"
test(username: "username", password: "password")
}|]
it "accepts two block string arguments" $ it "accepts two block string arguments" $
parse document "" `shouldSucceedOn` [gql| let given = "mutation auth {\n\
mutation auth{ \ test(username: \"\"\"username\"\"\", password: \"\"\"password\"\"\")\n\
test(username: """username""", password: """password""") \}"
}|] in parse document "" `shouldSucceedOn` given
it "fails to parse an empty argument list in parens" $ it "fails to parse an empty argument list in parens" $
parse document "" `shouldFailOn` "{ test() }" parse document "" `shouldFailOn` "{ test() }"
it "accepts any arguments" $ mapSize (const 10) $ property $ \xs -> it "accepts any arguments" $ mapSize (const 10) $ property $ \xs ->
let let arguments' = map printArgument
query' :: Text $ getNonEmpty (xs :: NonEmptyList (AnyArgument AnyValue))
arguments' = map printArgument $ getNonEmpty (xs :: NonEmptyList (AnyArgument AnyValue)) query' = "query(" <> Text.intercalate ", " arguments' <> ")"
query' = "query(" <> Text.intercalate ", " arguments' <> ")" in in parse document "" `shouldSucceedOn` ("{ " <> query' <> " }")
parse document "" `shouldSucceedOn` ("{ " <> query' <> " }")
it "parses minimal schema definition" $ it "parses minimal schema definition" $
parse document "" `shouldSucceedOn` [gql|schema { query: Query }|] parse document "" `shouldSucceedOn` "schema { query: Query }"
it "parses minimal scalar definition" $ it "parses minimal scalar definition" $
parse document "" `shouldSucceedOn` [gql|scalar Time|] parse document "" `shouldSucceedOn` "scalar Time"
it "parses ImplementsInterfaces" $ it "parses ImplementsInterfaces" $
parse document "" `shouldSucceedOn` [gql| parse document "" `shouldSucceedOn`
type Person implements NamedEntity & ValuedEntity { "type Person implements NamedEntity & ValuedEntity {\n\
name: String \ name: String\n\
} \}"
|]
it "parses a type without ImplementsInterfaces" $ it "parses a type without ImplementsInterfaces" $
parse document "" `shouldSucceedOn` [gql| parse document "" `shouldSucceedOn`
type Person { "type Person {\n\
name: String \ name: String\n\
} \}"
|]
it "parses ArgumentsDefinition in an ObjectDefinition" $ it "parses ArgumentsDefinition in an ObjectDefinition" $
parse document "" `shouldSucceedOn` [gql| parse document "" `shouldSucceedOn`
type Person { "type Person {\n\
name(first: String, last: String): String \ name(first: String, last: String): String\n\
} \}"
|]
it "parses minimal union type definition" $ it "parses minimal union type definition" $
parse document "" `shouldSucceedOn` [gql| parse document "" `shouldSucceedOn`
union SearchResult = Photo | Person "union SearchResult = Photo | Person"
|]
it "parses minimal interface type definition" $ it "parses minimal interface type definition" $
parse document "" `shouldSucceedOn` [gql| parse document "" `shouldSucceedOn`
interface NamedEntity { "interface NamedEntity {\n\
name: String \ name: String\n\
} \}"
|]
it "parses minimal enum type definition" $ it "parses minimal enum type definition" $
parse document "" `shouldSucceedOn` [gql| parse document "" `shouldSucceedOn`
enum Direction { "enum Direction {\n\
NORTH \ NORTH\n\
EAST \ EAST\n\
SOUTH \ SOUTH\n\
WEST \ WEST\n\
} \}"
|]
it "parses minimal input object type definition" $ it "parses minimal input object type definition" $
parse document "" `shouldSucceedOn` [gql| parse document "" `shouldSucceedOn`
input Point2D { "input Point2D {\n\
x: Float \ x: Float\n\
y: Float \ y: Float\n\
} \}"
|]
it "parses minimal input enum definition with an optional pipe" $ it "parses minimal input enum definition with an optional pipe" $
parse document "" `shouldSucceedOn` [gql| parse document "" `shouldSucceedOn`
directive @example on "directive @example on\n\
| FIELD \ | FIELD\n\
| FRAGMENT_SPREAD \ | FRAGMENT_SPREAD"
|]
it "parses two minimal directive definitions" $ it "parses two minimal directive definitions" $
let directive name' loc = TypeSystemDefinition let directive name' loc = TypeSystemDefinition
@ -165,10 +140,10 @@ spec = describe "Parser" $ do
(DirLoc.ExecutableDirectiveLocation DirLoc.Field) (DirLoc.ExecutableDirectiveLocation DirLoc.Field)
(Location {line = 2, column = 1}) (Location {line = 2, column = 1})
testSchemaExtension = example1 :| [example2] testSchemaExtension = example1 :| [example2]
query = [gql| query = Text.unlines
directive @example1 on FIELD_DEFINITION [ "directive @example1 on FIELD_DEFINITION"
directive @example2 on FIELD , "directive @example2 on FIELD"
|] ]
in parse document "" query `shouldParse` testSchemaExtension in parse document "" query `shouldParse` testSchemaExtension
it "parses a directive definition with a default empty list argument" $ it "parses a directive definition with a default empty list argument" $
@ -185,21 +160,19 @@ spec = describe "Parser" $ do
definition = DirectiveDefinition definition = DirectiveDefinition
(Description Nothing) (Description Nothing)
"test" "test"
(ArgumentsDefinition [argumentValueDefinition] ) (ArgumentsDefinition [argumentValueDefinition])
False False
(loc :| []) (loc :| [])
directive = TypeSystemDefinition definition directive = TypeSystemDefinition definition
$ Location{ line = 1, column = 1 } $ Location{ line = 1, column = 1 }
query = [gql|directive @test(foo: [String] = []) on FIELD_DEFINITION|] query = "directive @test(foo: [String] = []) on FIELD_DEFINITION"
in parse document "" query `shouldParse` (directive :| []) in parse document "" query `shouldParse` (directive :| [])
it "parses schema extension with a new directive" $ it "parses schema extension with a new directive" $
parse document "" `shouldSucceedOn`[gql| parse document "" `shouldSucceedOn` "extend schema @newDirective"
extend schema @newDirective
|]
it "parses schema extension with an operation type definition" $ it "parses schema extension with an operation type definition" $
parse document "" `shouldSucceedOn` [gql|extend schema { query: Query }|] parse document "" `shouldSucceedOn` "extend schema { query: Query }"
it "parses schema extension with an operation type and directive" $ it "parses schema extension with an operation type and directive" $
let newDirective = Directive "newDirective" [] $ Location 1 15 let newDirective = Directive "newDirective" [] $ Location 1 15
@ -208,52 +181,42 @@ spec = describe "Parser" $ do
$ OperationTypeDefinition Query "Query" :| [] $ OperationTypeDefinition Query "Query" :| []
testSchemaExtension = TypeSystemExtension schemaExtension testSchemaExtension = TypeSystemExtension schemaExtension
$ Location 1 1 $ Location 1 1
query = [gql|extend schema @newDirective { query: Query }|] query = "extend schema @newDirective { query: Query }"
in parse document "" query `shouldParse` (testSchemaExtension :| []) in parse document "" query `shouldParse` (testSchemaExtension :| [])
it "parses a repeatable directive definition" $ it "parses a repeatable directive definition" $
let given = [gql|directive @test repeatable on FIELD_DEFINITION|] let given = "directive @test repeatable on FIELD_DEFINITION"
isRepeatable (TypeSystemDefinition definition' _ :| []) isRepeatable (TypeSystemDefinition definition' _ :| [])
| DirectiveDefinition _ _ _ repeatable _ <- definition' = repeatable | DirectiveDefinition _ _ _ repeatable _ <- definition' = repeatable
isRepeatable _ = False isRepeatable _ = False
in parse document "" given `parseSatisfies` isRepeatable in parse document "" given `parseSatisfies` isRepeatable
it "parses an object extension" $ it "parses an object extension" $
parse document "" `shouldSucceedOn` [gql| parse document "" `shouldSucceedOn`
extend type Story { "extend type Story { isHiddenLocally: Boolean }"
isHiddenLocally: Boolean
}
|]
it "rejects variables in DefaultValue" $ it "rejects variables in DefaultValue" $
parse document "" `shouldFailOn` [gql| parse document "" `shouldFailOn`
query ($book: String = "Zarathustra", $author: String = $book) { "query ($book: String = \"Zarathustra\", $author: String = $book) {\n\
title \ title\n\
} \}"
|]
it "rejects empty selection set" $ it "rejects empty selection set" $
parse document "" `shouldFailOn` [gql| parse document "" `shouldFailOn` "query { innerField {} }"
query {
innerField {}
}
|]
it "parses documents beginning with a comment" $ it "parses documents beginning with a comment" $
parse document "" `shouldSucceedOn` [gql| parse document "" `shouldSucceedOn`
""" "\"\"\"\n\
Query \Query\n\
""" \\"\"\"\n\
type Query { \type Query {\n\
queryField: String \ queryField: String\n\
} \}"
|]
it "parses subscriptions" $ it "parses subscriptions" $
parse document "" `shouldSucceedOn` [gql| parse document "" `shouldSucceedOn`
subscription NewMessages { "subscription NewMessages {\n\
newMessage(roomId: 123) { \ newMessage(roomId: 123) {\n\
sender \ sender\n\
} \ }\n\
} \}"
|]