forked from OSS/graphql
Fix block alignment in some parser tests
This commit is contained in:
parent
b056b4256f
commit
cdb2aa76b6
GPG Key ID:
A27FDC1E8EE902C0
@ -1,15 +1,26 @@
|
||||
{-# 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 Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
|
||||
import Test.QuickCheck (oneof, elements, listOf, resize, NonEmptyList (..))
|
||||
import Test.QuickCheck.Gen (Gen (..))
|
||||
import Data.Text (Text, pack)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Functor ((<&>))
|
||||
|
||||
newtype AnyPrintableChar = AnyPrintableChar { getAnyPrintableChar :: Char } deriving (Eq, Show)
|
||||
newtype AnyPrintableChar = AnyPrintableChar
|
||||
{ getAnyPrintableChar :: Char
|
||||
} deriving (Eq, Show)
|
||||
|
||||
alpha :: String
|
||||
alpha = ['a'..'z'] <> ['A'..'Z']
|
||||
@ -20,30 +31,42 @@ num = ['0'..'9']
|
||||
instance Arbitrary AnyPrintableChar where
|
||||
arbitrary = AnyPrintableChar <$> elements chars
|
||||
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
|
||||
arbitrary = do
|
||||
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
|
||||
newtype AnyName = AnyName { getAnyName :: Text } deriving (Eq, Show)
|
||||
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)
|
||||
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
|
||||
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
|
||||
arbitrary = do
|
||||
@ -51,7 +74,9 @@ instance Arbitrary a => Arbitrary (AnyNode a) where
|
||||
node' <- flip Doc.Node location' <$> arbitrary
|
||||
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
|
||||
arbitrary = do
|
||||
@ -60,8 +85,9 @@ instance Arbitrary a => Arbitrary (AnyObjectField a) where
|
||||
location' <- getAnyLocation <$> arbitrary
|
||||
pure $ AnyObjectField $ Doc.ObjectField name' value' location'
|
||||
|
||||
newtype AnyValue = AnyValue { getAnyValue :: Doc.Value }
|
||||
deriving (Eq, Show)
|
||||
newtype AnyValue = AnyValue
|
||||
{ getAnyValue :: Doc.Value
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance Arbitrary AnyValue
|
||||
where
|
||||
@ -88,8 +114,9 @@ instance Arbitrary AnyValue
|
||||
, Doc.Object <$> objectGen
|
||||
]
|
||||
|
||||
newtype AnyArgument a = AnyArgument { getAnyArgument :: Doc.Argument }
|
||||
deriving (Eq, Show)
|
||||
newtype AnyArgument a = AnyArgument
|
||||
{ getAnyArgument :: Doc.Argument
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance Arbitrary a => Arbitrary (AnyArgument a) where
|
||||
arbitrary = do
|
||||
@ -99,4 +126,5 @@ instance Arbitrary a => Arbitrary (AnyArgument a) where
|
||||
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'
|
||||
printArgument (AnyArgument (Doc.Argument name' (Doc.Node value' _) _)) =
|
||||
name' <> ": " <> (Text.pack . show) value'
|
||||
|
||||
@ -14,12 +14,9 @@ import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
|
||||
spec :: Spec
|
||||
spec = 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
|
||||
it "encodes null" $
|
||||
value minified Full.Null `shouldBe` "null"
|
||||
it "escapes \\" $
|
||||
value minified (Full.String "\\") `shouldBe` "\"\\\\\""
|
||||
it "escapes double quotes" $
|
||||
@ -45,6 +42,9 @@ spec = do
|
||||
it "~" $ value minified (Full.String "\x007E") `shouldBe` "\"~\""
|
||||
|
||||
context "pretty" $ do
|
||||
it "encodes null" $
|
||||
value pretty Full.Null `shouldBe` "null"
|
||||
|
||||
it "uses strings for short string values" $
|
||||
value pretty (Full.String "Short text") `shouldBe` "\"Short text\""
|
||||
it "uses block strings for text with new lines, with newline symbol" $
|
||||
|
||||
@ -1,16 +1,13 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
module Language.GraphQL.AST.ParserSpec
|
||||
( spec
|
||||
) 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
|
||||
import Language.GraphQL.TH
|
||||
import Test.Hspec (Spec, describe, it, context)
|
||||
import Test.Hspec.Megaparsec
|
||||
( shouldParse
|
||||
@ -28,127 +25,105 @@ spec = describe "Parser" $ do
|
||||
parse document "" `shouldSucceedOn` "\xfeff{foo}"
|
||||
|
||||
context "Arguments" $ do
|
||||
it "accepts block strings as argument" $
|
||||
parse document "" `shouldSucceedOn` [gql|{
|
||||
hello(text: """Argument""")
|
||||
}|]
|
||||
it "accepts block strings as argument" $
|
||||
parse document "" `shouldSucceedOn`
|
||||
"{ hello(text: \"\"\"Argument\"\"\") }"
|
||||
|
||||
it "accepts strings as argument" $
|
||||
parse document "" `shouldSucceedOn` [gql|{
|
||||
hello(text: "Argument")
|
||||
}|]
|
||||
it "accepts strings as argument" $
|
||||
parse document "" `shouldSucceedOn` "{ hello(text: \"Argument\") }"
|
||||
|
||||
it "accepts int as argument1" $
|
||||
parse document "" `shouldSucceedOn` [gql|{
|
||||
user(id: 4)
|
||||
}|]
|
||||
it "accepts int as argument" $
|
||||
parse document "" `shouldSucceedOn` "{ user(id: 4) }"
|
||||
|
||||
it "accepts boolean as argument" $
|
||||
parse document "" `shouldSucceedOn` [gql|{
|
||||
hello(flag: true) { field1 }
|
||||
}|]
|
||||
it "accepts boolean as argument" $
|
||||
parse document "" `shouldSucceedOn`
|
||||
"{ hello(flag: true) { field1 } }"
|
||||
|
||||
it "accepts float as argument" $
|
||||
parse document "" `shouldSucceedOn` [gql|{
|
||||
body(height: 172.5) { height }
|
||||
}|]
|
||||
it "accepts float as argument" $
|
||||
parse document "" `shouldSucceedOn`
|
||||
"{ body(height: 172.5) { height } }"
|
||||
|
||||
it "accepts empty list as argument" $
|
||||
parse document "" `shouldSucceedOn` [gql|{
|
||||
query(list: []) { field1 }
|
||||
}|]
|
||||
it "accepts empty list as argument" $
|
||||
parse document "" `shouldSucceedOn` "{ query(list: []) { field1 } }"
|
||||
|
||||
it "accepts two required arguments" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
mutation auth($username: String!, $password: String!){
|
||||
test
|
||||
}|]
|
||||
it "accepts two required arguments" $
|
||||
parse document "" `shouldSucceedOn`
|
||||
"mutation auth($username: String!, $password: String!) { test }"
|
||||
|
||||
it "accepts two string arguments" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
mutation auth{
|
||||
test(username: "username", password: "password")
|
||||
}|]
|
||||
it "accepts two string arguments" $
|
||||
parse document "" `shouldSucceedOn`
|
||||
"mutation auth { test(username: \"username\", password: \"password\") }"
|
||||
|
||||
it "accepts two block string arguments" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
mutation auth{
|
||||
test(username: """username""", password: """password""")
|
||||
}|]
|
||||
it "accepts two block string arguments" $
|
||||
let given = "mutation auth {\n\
|
||||
\ test(username: \"\"\"username\"\"\", password: \"\"\"password\"\"\")\n\
|
||||
\}"
|
||||
in parse document "" `shouldSucceedOn` given
|
||||
|
||||
it "fails to parse an empty argument list in parens" $
|
||||
parse document "" `shouldFailOn` "{ test() }"
|
||||
it "fails to parse an empty argument list in parens" $
|
||||
parse document "" `shouldFailOn` "{ test() }"
|
||||
|
||||
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 "accepts any arguments" $ mapSize (const 10) $ property $ \xs ->
|
||||
let 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 }|]
|
||||
parse document "" `shouldSucceedOn` "schema { query: Query }"
|
||||
|
||||
it "parses minimal scalar definition" $
|
||||
parse document "" `shouldSucceedOn` [gql|scalar Time|]
|
||||
parse document "" `shouldSucceedOn` "scalar Time"
|
||||
|
||||
it "parses ImplementsInterfaces" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
type Person implements NamedEntity & ValuedEntity {
|
||||
name: String
|
||||
}
|
||||
|]
|
||||
parse document "" `shouldSucceedOn`
|
||||
"type Person implements NamedEntity & ValuedEntity {\n\
|
||||
\ name: String\n\
|
||||
\}"
|
||||
|
||||
it "parses a type without ImplementsInterfaces" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
type Person {
|
||||
name: String
|
||||
}
|
||||
|]
|
||||
parse document "" `shouldSucceedOn`
|
||||
"type Person {\n\
|
||||
\ name: String\n\
|
||||
\}"
|
||||
|
||||
it "parses ArgumentsDefinition in an ObjectDefinition" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
type Person {
|
||||
name(first: String, last: String): String
|
||||
}
|
||||
|]
|
||||
parse document "" `shouldSucceedOn`
|
||||
"type Person {\n\
|
||||
\ name(first: String, last: String): String\n\
|
||||
\}"
|
||||
|
||||
it "parses minimal union type definition" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
union SearchResult = Photo | Person
|
||||
|]
|
||||
parse document "" `shouldSucceedOn`
|
||||
"union SearchResult = Photo | Person"
|
||||
|
||||
it "parses minimal interface type definition" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
interface NamedEntity {
|
||||
name: String
|
||||
}
|
||||
|]
|
||||
parse document "" `shouldSucceedOn`
|
||||
"interface NamedEntity {\n\
|
||||
\ name: String\n\
|
||||
\}"
|
||||
|
||||
it "parses minimal enum type definition" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
enum Direction {
|
||||
NORTH
|
||||
EAST
|
||||
SOUTH
|
||||
WEST
|
||||
}
|
||||
|]
|
||||
parse document "" `shouldSucceedOn`
|
||||
"enum Direction {\n\
|
||||
\ NORTH\n\
|
||||
\ EAST\n\
|
||||
\ SOUTH\n\
|
||||
\ WEST\n\
|
||||
\}"
|
||||
|
||||
it "parses minimal input object type definition" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
input Point2D {
|
||||
x: Float
|
||||
y: Float
|
||||
}
|
||||
|]
|
||||
parse document "" `shouldSucceedOn`
|
||||
"input Point2D {\n\
|
||||
\ x: Float\n\
|
||||
\ y: Float\n\
|
||||
\}"
|
||||
|
||||
it "parses minimal input enum definition with an optional pipe" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
directive @example on
|
||||
| FIELD
|
||||
| FRAGMENT_SPREAD
|
||||
|]
|
||||
parse document "" `shouldSucceedOn`
|
||||
"directive @example on\n\
|
||||
\ | FIELD\n\
|
||||
\ | FRAGMENT_SPREAD"
|
||||
|
||||
it "parses two minimal directive definitions" $
|
||||
let directive name' loc = TypeSystemDefinition
|
||||
@ -165,10 +140,10 @@ spec = describe "Parser" $ do
|
||||
(DirLoc.ExecutableDirectiveLocation DirLoc.Field)
|
||||
(Location {line = 2, column = 1})
|
||||
testSchemaExtension = example1 :| [example2]
|
||||
query = [gql|
|
||||
directive @example1 on FIELD_DEFINITION
|
||||
directive @example2 on FIELD
|
||||
|]
|
||||
query = Text.unlines
|
||||
[ "directive @example1 on FIELD_DEFINITION"
|
||||
, "directive @example2 on FIELD"
|
||||
]
|
||||
in parse document "" query `shouldParse` testSchemaExtension
|
||||
|
||||
it "parses a directive definition with a default empty list argument" $
|
||||
@ -185,21 +160,19 @@ spec = describe "Parser" $ do
|
||||
definition = DirectiveDefinition
|
||||
(Description Nothing)
|
||||
"test"
|
||||
(ArgumentsDefinition [argumentValueDefinition] )
|
||||
(ArgumentsDefinition [argumentValueDefinition])
|
||||
False
|
||||
(loc :| [])
|
||||
directive = TypeSystemDefinition definition
|
||||
$ 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 :| [])
|
||||
|
||||
it "parses schema extension with a new directive" $
|
||||
parse document "" `shouldSucceedOn`[gql|
|
||||
extend schema @newDirective
|
||||
|]
|
||||
parse document "" `shouldSucceedOn` "extend schema @newDirective"
|
||||
|
||||
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" $
|
||||
let newDirective = Directive "newDirective" [] $ Location 1 15
|
||||
@ -208,52 +181,42 @@ spec = describe "Parser" $ do
|
||||
$ OperationTypeDefinition Query "Query" :| []
|
||||
testSchemaExtension = TypeSystemExtension schemaExtension
|
||||
$ Location 1 1
|
||||
query = [gql|extend schema @newDirective { query: Query }|]
|
||||
query = "extend schema @newDirective { query: Query }"
|
||||
in parse document "" query `shouldParse` (testSchemaExtension :| [])
|
||||
|
||||
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' _ :| [])
|
||||
| DirectiveDefinition _ _ _ repeatable _ <- definition' = repeatable
|
||||
isRepeatable _ = False
|
||||
in parse document "" given `parseSatisfies` isRepeatable
|
||||
|
||||
it "parses an object extension" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
extend type Story {
|
||||
isHiddenLocally: Boolean
|
||||
}
|
||||
|]
|
||||
parse document "" `shouldSucceedOn`
|
||||
"extend type Story { isHiddenLocally: Boolean }"
|
||||
|
||||
it "rejects variables in DefaultValue" $
|
||||
parse document "" `shouldFailOn` [gql|
|
||||
query ($book: String = "Zarathustra", $author: String = $book) {
|
||||
title
|
||||
}
|
||||
|]
|
||||
parse document "" `shouldFailOn`
|
||||
"query ($book: String = \"Zarathustra\", $author: String = $book) {\n\
|
||||
\ title\n\
|
||||
\}"
|
||||
|
||||
it "rejects empty selection set" $
|
||||
parse document "" `shouldFailOn` [gql|
|
||||
query {
|
||||
innerField {}
|
||||
}
|
||||
|]
|
||||
parse document "" `shouldFailOn` "query { innerField {} }"
|
||||
|
||||
it "parses documents beginning with a comment" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
"""
|
||||
Query
|
||||
"""
|
||||
type Query {
|
||||
queryField: String
|
||||
}
|
||||
|]
|
||||
parse document "" `shouldSucceedOn`
|
||||
"\"\"\"\n\
|
||||
\Query\n\
|
||||
\\"\"\"\n\
|
||||
\type Query {\n\
|
||||
\ queryField: String\n\
|
||||
\}"
|
||||
|
||||
it "parses subscriptions" $
|
||||
parse document "" `shouldSucceedOn` [gql|
|
||||
subscription NewMessages {
|
||||
newMessage(roomId: 123) {
|
||||
sender
|
||||
}
|
||||
}
|
||||
|]
|
||||
parse document "" `shouldSucceedOn`
|
||||
"subscription NewMessages {\n\
|
||||
\ newMessage(roomId: 123) {\n\
|
||||
\ sender\n\
|
||||
\ }\n\
|
||||
\}"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user