Replace tasty and HUnit with Hspec
This commit is contained in:
parent
61879fb124
commit
eb40810f25
@ -4,7 +4,7 @@ cabal-version: 1.12
|
|||||||
--
|
--
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: 20a76d38355648944315f3aa937e5cd72837bbd1b93037f53e2849906de3f2c0
|
-- hash: 2ad18ce352b6b5324c5e8c4fa3e7c1dc39022b209696d162367d13300c4046fd
|
||||||
|
|
||||||
name: graphql
|
name: graphql
|
||||||
version: 0.4.0.0
|
version: 0.4.0.0
|
||||||
@ -65,11 +65,12 @@ library
|
|||||||
|
|
||||||
test-suite tasty
|
test-suite tasty
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: tasty.hs
|
main-is: Spec.hs
|
||||||
other-modules:
|
other-modules:
|
||||||
Language.GraphQL.LexerTest
|
Language.GraphQL.LexerSpec
|
||||||
|
Test.KitchenSinkSpec
|
||||||
Test.StarWars.Data
|
Test.StarWars.Data
|
||||||
Test.StarWars.QueryTests
|
Test.StarWars.QuerySpec
|
||||||
Test.StarWars.Schema
|
Test.StarWars.Schema
|
||||||
Paths_graphql
|
Paths_graphql
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
@ -79,10 +80,10 @@ test-suite tasty
|
|||||||
aeson
|
aeson
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, graphql
|
, graphql
|
||||||
|
, hspec
|
||||||
|
, hspec-expectations
|
||||||
, megaparsec
|
, megaparsec
|
||||||
, raw-strings-qq
|
, raw-strings-qq
|
||||||
, tasty
|
|
||||||
, tasty-hunit
|
|
||||||
, text
|
, text
|
||||||
, transformers
|
, transformers
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
@ -41,7 +41,7 @@ library:
|
|||||||
|
|
||||||
tests:
|
tests:
|
||||||
tasty:
|
tasty:
|
||||||
main: tasty.hs
|
main: Spec.hs
|
||||||
source-dirs: tests
|
source-dirs: tests
|
||||||
ghc-options:
|
ghc-options:
|
||||||
- -threaded
|
- -threaded
|
||||||
@ -49,6 +49,6 @@ tests:
|
|||||||
- -with-rtsopts=-N
|
- -with-rtsopts=-N
|
||||||
dependencies:
|
dependencies:
|
||||||
- graphql
|
- graphql
|
||||||
|
- hspec
|
||||||
|
- hspec-expectations
|
||||||
- raw-strings-qq
|
- raw-strings-qq
|
||||||
- tasty
|
|
||||||
- tasty-hunit
|
|
||||||
|
99
tests/Language/GraphQL/LexerSpec.hs
Normal file
99
tests/Language/GraphQL/LexerSpec.hs
Normal file
@ -0,0 +1,99 @@
|
|||||||
|
{-# LANGUAGE ExplicitForAll #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
module Language.GraphQL.LexerSpec
|
||||||
|
( spec
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Language.GraphQL.Lexer
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import Data.Void (Void)
|
||||||
|
import Test.Hspec ( Spec
|
||||||
|
, context
|
||||||
|
, describe
|
||||||
|
, it
|
||||||
|
, shouldBe
|
||||||
|
)
|
||||||
|
import Text.Megaparsec ( ParseErrorBundle
|
||||||
|
, parse
|
||||||
|
)
|
||||||
|
import Text.RawString.QQ (r)
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "Lexer" $ do
|
||||||
|
context "Reference tests" $ do
|
||||||
|
it "lexes strings" $ do
|
||||||
|
runParser string [r|"simple"|] `shouldBe` Right "simple"
|
||||||
|
runParser string [r|" white space "|] `shouldBe` Right " white space "
|
||||||
|
runParser string [r|"quote \""|] `shouldBe` Right [r|quote "|]
|
||||||
|
runParser string [r|"escaped \n"|] `shouldBe` Right "escaped \n"
|
||||||
|
runParser string [r|"slashes \\ \/"|] `shouldBe` Right [r|slashes \ /|]
|
||||||
|
runParser string [r|"unicode \u1234\u5678\u90AB\uCDEF"|]
|
||||||
|
`shouldBe` Right "unicode ሴ噸邫췯"
|
||||||
|
|
||||||
|
it "lexes block string" $ do
|
||||||
|
runParser blockString [r|"""simple"""|] `shouldBe` Right "simple"
|
||||||
|
runParser blockString [r|""" white space """|]
|
||||||
|
`shouldBe` Right " white space "
|
||||||
|
runParser blockString [r|"""contains " quote"""|]
|
||||||
|
`shouldBe` Right [r|contains " quote|]
|
||||||
|
runParser blockString [r|"""contains \""" triplequote"""|]
|
||||||
|
`shouldBe` Right [r|contains """ triplequote|]
|
||||||
|
runParser blockString "\"\"\"multi\nline\"\"\"" `shouldBe` Right "multi\nline"
|
||||||
|
runParser blockString "\"\"\"multi\rline\r\nnormalized\"\"\""
|
||||||
|
`shouldBe` Right "multi\nline\nnormalized"
|
||||||
|
runParser blockString "\"\"\"multi\rline\r\nnormalized\"\"\""
|
||||||
|
`shouldBe` Right "multi\nline\nnormalized"
|
||||||
|
runParser blockString [r|"""unescaped \n\r\b\t\f\u1234"""|]
|
||||||
|
`shouldBe` Right [r|unescaped \n\r\b\t\f\u1234|]
|
||||||
|
runParser blockString [r|"""slashes \\ \/"""|]
|
||||||
|
`shouldBe` Right [r|slashes \\ \/|]
|
||||||
|
runParser blockString [r|"""
|
||||||
|
|
||||||
|
spans
|
||||||
|
multiple
|
||||||
|
lines
|
||||||
|
|
||||||
|
"""|] `shouldBe` Right "spans\n multiple\n lines"
|
||||||
|
|
||||||
|
it "lexes numbers" $ do
|
||||||
|
runParser integer "4" `shouldBe` Right (4 :: Int)
|
||||||
|
runParser float "4.123" `shouldBe` Right 4.123
|
||||||
|
runParser integer "-4" `shouldBe` Right (-4 :: Int)
|
||||||
|
runParser integer "9" `shouldBe` Right (9 :: Int)
|
||||||
|
runParser integer "0" `shouldBe` Right (0 :: Int)
|
||||||
|
runParser float "-4.123" `shouldBe` Right (-4.123)
|
||||||
|
runParser float "0.123" `shouldBe` Right 0.123
|
||||||
|
runParser float "123e4" `shouldBe` Right 123e4
|
||||||
|
runParser float "123E4" `shouldBe` Right 123E4
|
||||||
|
runParser float "123e-4" `shouldBe` Right 123e-4
|
||||||
|
runParser float "123e+4" `shouldBe` Right 123e+4
|
||||||
|
runParser float "-1.123e4" `shouldBe` Right (-1.123e4)
|
||||||
|
runParser float "-1.123E4" `shouldBe` Right (-1.123E4)
|
||||||
|
runParser float "-1.123e-4" `shouldBe` Right (-1.123e-4)
|
||||||
|
runParser float "-1.123e+4" `shouldBe` Right (-1.123e+4)
|
||||||
|
runParser float "-1.123e4567" `shouldBe` Right (-1.123e4567)
|
||||||
|
|
||||||
|
it "lexes punctuation" $ do
|
||||||
|
runParser bang "!" `shouldBe` Right '!'
|
||||||
|
runParser dollar "$" `shouldBe` Right '$'
|
||||||
|
runBetween parens "()" `shouldBe` Right ()
|
||||||
|
runParser spread "..." `shouldBe` Right "..."
|
||||||
|
runParser colon ":" `shouldBe` Right ":"
|
||||||
|
runParser equals "=" `shouldBe` Right "="
|
||||||
|
runParser at "@" `shouldBe` Right '@'
|
||||||
|
runBetween brackets "[]" `shouldBe` Right ()
|
||||||
|
runBetween braces "{}" `shouldBe` Right ()
|
||||||
|
runParser pipe "|" `shouldBe` Right "|"
|
||||||
|
|
||||||
|
context "Implementation tests" $ do
|
||||||
|
it "lexes empty block strings" $
|
||||||
|
runParser blockString [r|""""""|] `shouldBe` Right ""
|
||||||
|
it "lexes ampersand" $
|
||||||
|
runParser amp "&" `shouldBe` Right "&"
|
||||||
|
|
||||||
|
runParser :: forall a. Parser a -> T.Text -> Either (ParseErrorBundle T.Text Void) a
|
||||||
|
runParser = flip parse ""
|
||||||
|
|
||||||
|
runBetween :: (Parser () -> Parser ()) -> T.Text -> Either (ParseErrorBundle T.Text Void) ()
|
||||||
|
runBetween parser = parse (parser $ pure ()) ""
|
@ -1,102 +0,0 @@
|
|||||||
{-# LANGUAGE ExplicitForAll #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
module Language.GraphQL.LexerTest
|
|
||||||
( implementation
|
|
||||||
, reference
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Language.GraphQL.Lexer
|
|
||||||
import qualified Data.Text as T
|
|
||||||
import Data.Void (Void)
|
|
||||||
import Test.Tasty ( TestTree
|
|
||||||
, testGroup
|
|
||||||
)
|
|
||||||
import Test.Tasty.HUnit ( testCase
|
|
||||||
, (@?=)
|
|
||||||
)
|
|
||||||
import Text.Megaparsec ( ParseErrorBundle
|
|
||||||
, parse
|
|
||||||
)
|
|
||||||
import Text.RawString.QQ (r)
|
|
||||||
|
|
||||||
reference :: TestTree
|
|
||||||
reference = testGroup "Lexer"
|
|
||||||
[ testCase "lexes strings" $ do
|
|
||||||
runParser string [r|"simple"|] @?= Right "simple"
|
|
||||||
runParser string [r|" white space "|] @?= Right " white space "
|
|
||||||
runParser string [r|"quote \""|] @?= Right [r|quote "|]
|
|
||||||
runParser string [r|"escaped \n"|] @?= Right "escaped \n"
|
|
||||||
runParser string [r|"slashes \\ \/"|] @?= Right [r|slashes \ /|]
|
|
||||||
runParser string [r|"unicode \u1234\u5678\u90AB\uCDEF"|]
|
|
||||||
@?= Right "unicode ሴ噸邫췯"
|
|
||||||
|
|
||||||
, testCase "lexes block string" $ do
|
|
||||||
runParser blockString [r|"""simple"""|] @?= Right "simple"
|
|
||||||
runParser blockString [r|""" white space """|]
|
|
||||||
@?= Right " white space "
|
|
||||||
runParser blockString [r|"""contains " quote"""|]
|
|
||||||
@?= Right [r|contains " quote|]
|
|
||||||
runParser blockString [r|"""contains \""" triplequote"""|]
|
|
||||||
@?= Right [r|contains """ triplequote|]
|
|
||||||
runParser blockString "\"\"\"multi\nline\"\"\"" @?= Right "multi\nline"
|
|
||||||
runParser blockString "\"\"\"multi\rline\r\nnormalized\"\"\""
|
|
||||||
@?= Right "multi\nline\nnormalized"
|
|
||||||
runParser blockString "\"\"\"multi\rline\r\nnormalized\"\"\""
|
|
||||||
@?= Right "multi\nline\nnormalized"
|
|
||||||
runParser blockString [r|"""unescaped \n\r\b\t\f\u1234"""|]
|
|
||||||
@?= Right [r|unescaped \n\r\b\t\f\u1234|]
|
|
||||||
runParser blockString [r|"""slashes \\ \/"""|]
|
|
||||||
@?= Right [r|slashes \\ \/|]
|
|
||||||
runParser blockString [r|"""
|
|
||||||
|
|
||||||
spans
|
|
||||||
multiple
|
|
||||||
lines
|
|
||||||
|
|
||||||
"""|] @?= Right "spans\n multiple\n lines"
|
|
||||||
|
|
||||||
, testCase "lexes numbers" $ do
|
|
||||||
runParser integer "4" @?= Right (4 :: Int)
|
|
||||||
runParser float "4.123" @?= Right 4.123
|
|
||||||
runParser integer "-4" @?= Right (-4 :: Int)
|
|
||||||
runParser integer "9" @?= Right (9 :: Int)
|
|
||||||
runParser integer "0" @?= Right (0 :: Int)
|
|
||||||
runParser float "-4.123" @?= Right (-4.123)
|
|
||||||
runParser float "0.123" @?= Right 0.123
|
|
||||||
runParser float "123e4" @?= Right 123e4
|
|
||||||
runParser float "123E4" @?= Right 123E4
|
|
||||||
runParser float "123e-4" @?= Right 123e-4
|
|
||||||
runParser float "123e+4" @?= Right 123e+4
|
|
||||||
runParser float "-1.123e4" @?= Right (-1.123e4)
|
|
||||||
runParser float "-1.123E4" @?= Right (-1.123E4)
|
|
||||||
runParser float "-1.123e-4" @?= Right (-1.123e-4)
|
|
||||||
runParser float "-1.123e+4" @?= Right (-1.123e+4)
|
|
||||||
runParser float "-1.123e4567" @?= Right (-1.123e4567)
|
|
||||||
|
|
||||||
, testCase "lexes punctuation" $ do
|
|
||||||
runParser bang "!" @?= Right '!'
|
|
||||||
runParser dollar "$" @?= Right '$'
|
|
||||||
runBetween parens "()" @?= Right ()
|
|
||||||
runParser spread "..." @?= Right "..."
|
|
||||||
runParser colon ":" @?= Right ":"
|
|
||||||
runParser equals "=" @?= Right "="
|
|
||||||
runParser at "@" @?= Right '@'
|
|
||||||
runBetween brackets "[]" @?= Right ()
|
|
||||||
runBetween braces "{}" @?= Right ()
|
|
||||||
runParser pipe "|" @?= Right "|"
|
|
||||||
]
|
|
||||||
|
|
||||||
implementation :: TestTree
|
|
||||||
implementation = testGroup "Lexer"
|
|
||||||
[ testCase "lexes empty block strings" $
|
|
||||||
runParser blockString [r|""""""|] @?= Right ""
|
|
||||||
, testCase "lexes ampersand" $
|
|
||||||
runParser amp "&" @?= Right "&"
|
|
||||||
]
|
|
||||||
|
|
||||||
runParser :: forall a. Parser a -> T.Text -> Either (ParseErrorBundle T.Text Void) a
|
|
||||||
runParser = flip parse ""
|
|
||||||
|
|
||||||
runBetween :: (Parser () -> Parser ()) -> T.Text -> Either (ParseErrorBundle T.Text Void) ()
|
|
||||||
runBetween parser = parse (parser $ pure ()) ""
|
|
1
tests/Spec.hs
Normal file
1
tests/Spec.hs
Normal file
@ -0,0 +1 @@
|
|||||||
|
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
29
tests/Test/KitchenSinkSpec.hs
Normal file
29
tests/Test/KitchenSinkSpec.hs
Normal file
@ -0,0 +1,29 @@
|
|||||||
|
module Test.KitchenSinkSpec
|
||||||
|
( spec
|
||||||
|
) where
|
||||||
|
|
||||||
|
import qualified Data.Text.IO as Text.IO
|
||||||
|
import qualified Language.GraphQL.Encoder as Encoder
|
||||||
|
import qualified Language.GraphQL.Parser as Parser
|
||||||
|
import Paths_graphql (getDataFileName)
|
||||||
|
import Test.Hspec ( Spec
|
||||||
|
, describe
|
||||||
|
, it
|
||||||
|
)
|
||||||
|
import Test.Hspec.Expectations ( expectationFailure
|
||||||
|
, shouldBe
|
||||||
|
)
|
||||||
|
import Text.Megaparsec ( errorBundlePretty
|
||||||
|
, parse
|
||||||
|
)
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "Kitchen Sink" $
|
||||||
|
it "prints the query" $ do
|
||||||
|
dataFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql"
|
||||||
|
expected <- Text.IO.readFile dataFileName
|
||||||
|
|
||||||
|
either
|
||||||
|
(expectationFailure . errorBundlePretty)
|
||||||
|
(flip shouldBe expected . Encoder.document)
|
||||||
|
$ parse Parser.document dataFileName expected
|
@ -1,6 +1,8 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
module Test.StarWars.QueryTests (test) where
|
module Test.StarWars.QuerySpec
|
||||||
|
( spec
|
||||||
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as Aeson
|
||||||
import Data.Aeson ( object
|
import Data.Aeson ( object
|
||||||
@ -10,52 +12,54 @@ import Data.Text (Text)
|
|||||||
import Language.GraphQL
|
import Language.GraphQL
|
||||||
import Language.GraphQL.Schema (Subs)
|
import Language.GraphQL.Schema (Subs)
|
||||||
import Text.RawString.QQ (r)
|
import Text.RawString.QQ (r)
|
||||||
import Test.Tasty (TestTree, testGroup)
|
import Test.Hspec.Expectations ( Expectation
|
||||||
import Test.Tasty.HUnit ( Assertion
|
, shouldBe
|
||||||
, testCase
|
)
|
||||||
, (@?=)
|
import Test.Hspec ( Spec
|
||||||
)
|
, describe
|
||||||
|
, it
|
||||||
|
)
|
||||||
import Test.StarWars.Schema
|
import Test.StarWars.Schema
|
||||||
|
|
||||||
-- * Test
|
-- * Test
|
||||||
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsQueryTests.js
|
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsQueryTests.js
|
||||||
|
|
||||||
test :: TestTree
|
spec :: Spec
|
||||||
test = testGroup "Star Wars Query Tests"
|
spec = describe "Star Wars Query Tests" $ do
|
||||||
[ testGroup "Basic Queries"
|
describe "Basic Queries" $ do
|
||||||
[ testCase "R2-D2 hero" . testQuery
|
it "R2-D2 hero" $ testQuery
|
||||||
[r| query HeroNameQuery {
|
[r| query HeroNameQuery {
|
||||||
hero {
|
hero {
|
||||||
id
|
id
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
$ object [ "data" .= object ["hero" .= object ["id" .= ("2001" :: Text)]]]
|
$ object [ "data" .= object ["hero" .= object ["id" .= ("2001" :: Text)]]]
|
||||||
, testCase "R2-D2 ID and friends" . testQuery
|
it "R2-D2 ID and friends" $ testQuery
|
||||||
[r| query HeroNameAndFriendsQuery {
|
[r| query HeroNameAndFriendsQuery {
|
||||||
hero {
|
hero {
|
||||||
id
|
id
|
||||||
name
|
name
|
||||||
friends {
|
friends {
|
||||||
name
|
name
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
$ object [ "data" .= object [
|
$ object [ "data" .= object [
|
||||||
"hero" .= object [
|
"hero" .= object
|
||||||
"id" .= ("2001" :: Text)
|
[ "id" .= ("2001" :: Text)
|
||||||
, r2d2Name
|
, r2d2Name
|
||||||
, "friends" .= [
|
, "friends" .=
|
||||||
object [lukeName]
|
[ object [lukeName]
|
||||||
, object [hanName]
|
, object [hanName]
|
||||||
, object [leiaName]
|
, object [leiaName]
|
||||||
|
]
|
||||||
]
|
]
|
||||||
]
|
|
||||||
]]
|
]]
|
||||||
]
|
|
||||||
, testGroup "Nested Queries"
|
describe "Nested Queries" $ do
|
||||||
[ testCase "R2-D2 friends" . testQuery
|
it "R2-D2 friends" $ testQuery
|
||||||
[r| query NestedQuery {
|
[r| query NestedQuery {
|
||||||
hero {
|
hero {
|
||||||
name
|
name
|
||||||
@ -69,7 +73,7 @@ test = testGroup "Star Wars Query Tests"
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
$ object [ "data" .= object [
|
$ object [ "data" .= object [
|
||||||
"hero" .= object [
|
"hero" .= object [
|
||||||
"name" .= ("R2-D2" :: Text)
|
"name" .= ("R2-D2" :: Text)
|
||||||
, "friends" .= [
|
, "friends" .= [
|
||||||
@ -105,101 +109,96 @@ test = testGroup "Star Wars Query Tests"
|
|||||||
]
|
]
|
||||||
]
|
]
|
||||||
]]
|
]]
|
||||||
, testCase "Luke ID" . testQuery
|
it "Luke ID" $ testQuery
|
||||||
[r| query FetchLukeQuery {
|
[r| query FetchLukeQuery {
|
||||||
human(id: "1000") {
|
human(id: "1000") {
|
||||||
name
|
name
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
$ object [ "data" .= object [
|
$ object [ "data" .= object [
|
||||||
"human" .= object [lukeName]
|
|
||||||
]
|
|
||||||
]]
|
|
||||||
, testCase "Luke ID with variable" . testQueryParams
|
|
||||||
(\v -> if v == "someId"
|
|
||||||
then Just "1000"
|
|
||||||
else Nothing)
|
|
||||||
[r| query FetchSomeIDQuery($someId: String!) {
|
|
||||||
human(id: $someId) {
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ object [ "data" .= object [
|
|
||||||
"human" .= object [lukeName]
|
"human" .= object [lukeName]
|
||||||
]]
|
]]
|
||||||
, testCase "Han ID with variable" . testQueryParams
|
|
||||||
(\v -> if v == "someId"
|
it "Luke ID with variable" $ testQueryParams
|
||||||
then Just "1002"
|
(\v -> if v == "someId" then Just "1000" else Nothing)
|
||||||
else Nothing)
|
[r| query FetchSomeIDQuery($someId: String!) {
|
||||||
[r| query FetchSomeIDQuery($someId: String!) {
|
human(id: $someId) {
|
||||||
human(id: $someId) {
|
name
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|]
|
}
|
||||||
|
|]
|
||||||
$ object [ "data" .= object [
|
$ object [ "data" .= object [
|
||||||
"human" .= object [hanName]
|
"human" .= object [lukeName]
|
||||||
]]
|
]]
|
||||||
, testCase "Invalid ID" . testQueryParams
|
it "Han ID with variable" $ testQueryParams
|
||||||
(\v -> if v == "id"
|
(\v -> if v == "someId" then Just "1002" else Nothing)
|
||||||
then Just "Not a valid ID"
|
[r| query FetchSomeIDQuery($someId: String!) {
|
||||||
else Nothing)
|
human(id: $someId) {
|
||||||
[r| query humanQuery($id: String!) {
|
name
|
||||||
human(id: $id) {
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|] $ object ["data" .= object ["human" .= Aeson.Null]]
|
}
|
||||||
, testCase "Luke aliased" . testQuery
|
|]
|
||||||
[r| query FetchLukeAliased {
|
|
||||||
luke: human(id: "1000") {
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ object [ "data" .= object [
|
$ object [ "data" .= object [
|
||||||
"luke" .= object [lukeName]
|
"human" .= object [hanName]
|
||||||
]]
|
]]
|
||||||
, testCase "R2-D2 ID and friends aliased" . testQuery
|
it "Invalid ID" $ testQueryParams
|
||||||
[r| query HeroNameAndFriendsQuery {
|
(\v -> if v == "id" then Just "Not a valid ID" else Nothing)
|
||||||
hero {
|
[r| query humanQuery($id: String!) {
|
||||||
id
|
human(id: $id) {
|
||||||
name
|
name
|
||||||
friends {
|
}
|
||||||
friendName: name
|
}
|
||||||
}
|
|] $ object ["data" .= object ["human" .= Aeson.Null]]
|
||||||
|
it "Luke aliased" $ testQuery
|
||||||
|
[r| query FetchLukeAliased {
|
||||||
|
luke: human(id: "1000") {
|
||||||
|
name
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
$ object [ "data" .= object [
|
||||||
|
"luke" .= object [lukeName]
|
||||||
|
]]
|
||||||
|
it "R2-D2 ID and friends aliased" $ testQuery
|
||||||
|
[r| query HeroNameAndFriendsQuery {
|
||||||
|
hero {
|
||||||
|
id
|
||||||
|
name
|
||||||
|
friends {
|
||||||
|
friendName: name
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|]
|
}
|
||||||
|
|]
|
||||||
$ object [ "data" .= object [
|
$ object [ "data" .= object [
|
||||||
"hero" .= object [
|
"hero" .= object [
|
||||||
"id" .= ("2001" :: Text)
|
"id" .= ("2001" :: Text)
|
||||||
, r2d2Name
|
, r2d2Name
|
||||||
, "friends" .= [
|
, "friends" .= [
|
||||||
object ["friendName" .= ("Luke Skywalker" :: Text)]
|
object ["friendName" .= ("Luke Skywalker" :: Text)]
|
||||||
, object ["friendName" .= ("Han Solo" :: Text)]
|
, object ["friendName" .= ("Han Solo" :: Text)]
|
||||||
, object ["friendName" .= ("Leia Organa" :: Text)]
|
, object ["friendName" .= ("Leia Organa" :: Text)]
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
]]
|
]]
|
||||||
, testCase "Luke and Leia aliased" . testQuery
|
it "Luke and Leia aliased" $ testQuery
|
||||||
[r| query FetchLukeAndLeiaAliased {
|
[r| query FetchLukeAndLeiaAliased {
|
||||||
luke: human(id: "1000") {
|
luke: human(id: "1000") {
|
||||||
name
|
name
|
||||||
}
|
|
||||||
leia: human(id: "1003") {
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|]
|
leia: human(id: "1003") {
|
||||||
|
name
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|]
|
||||||
$ object [ "data" .= object [
|
$ object [ "data" .= object [
|
||||||
"luke" .= object [lukeName]
|
"luke" .= object [lukeName]
|
||||||
, "leia" .= object [leiaName]
|
, "leia" .= object [leiaName]
|
||||||
]]
|
]]
|
||||||
, testGroup "Fragments for complex queries"
|
|
||||||
[ testCase "Aliases to query for duplicate content" . testQuery
|
describe "Fragments for complex queries" $ do
|
||||||
|
it "Aliases to query for duplicate content" $ testQuery
|
||||||
[r| query DuplicateFields {
|
[r| query DuplicateFields {
|
||||||
luke: human(id: "1000") {
|
luke: human(id: "1000") {
|
||||||
name
|
name
|
||||||
@ -211,11 +210,11 @@ test = testGroup "Star Wars Query Tests"
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
$ object [ "data" .= object [
|
$ object [ "data" .= object [
|
||||||
"luke" .= object [lukeName, tatooine]
|
"luke" .= object [lukeName, tatooine]
|
||||||
, "leia" .= object [leiaName, alderaan]
|
, "leia" .= object [leiaName, alderaan]
|
||||||
]]
|
]]
|
||||||
, testCase "Fragment for duplicate content" . testQuery
|
it "Fragment for duplicate content" $ testQuery
|
||||||
[r| query UseFragment {
|
[r| query UseFragment {
|
||||||
luke: human(id: "1000") {
|
luke: human(id: "1000") {
|
||||||
...HumanFragment
|
...HumanFragment
|
||||||
@ -229,13 +228,13 @@ test = testGroup "Star Wars Query Tests"
|
|||||||
homePlanet
|
homePlanet
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
$ object [ "data" .= object [
|
$ object [ "data" .= object [
|
||||||
"luke" .= object [lukeName, tatooine]
|
"luke" .= object [lukeName, tatooine]
|
||||||
, "leia" .= object [leiaName, alderaan]
|
, "leia" .= object [leiaName, alderaan]
|
||||||
]]
|
]]
|
||||||
]
|
|
||||||
, testGroup "__typename"
|
describe "__typename" $ do
|
||||||
[ testCase "R2D2 is a Droid" . testQuery
|
it "R2D2 is a Droid" $ testQuery
|
||||||
[r| query CheckTypeOfR2 {
|
[r| query CheckTypeOfR2 {
|
||||||
hero {
|
hero {
|
||||||
__typename
|
__typename
|
||||||
@ -243,10 +242,10 @@ test = testGroup "Star Wars Query Tests"
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
$ object ["data" .= object [
|
$ object ["data" .= object [
|
||||||
"hero" .= object ["__typename" .= ("Droid" :: Text), r2d2Name]
|
"hero" .= object ["__typename" .= ("Droid" :: Text), r2d2Name]
|
||||||
]]
|
]]
|
||||||
, testCase "Luke is a human" . testQuery
|
it "Luke is a human" $ testQuery
|
||||||
[r| query CheckTypeOfLuke {
|
[r| query CheckTypeOfLuke {
|
||||||
hero(episode: EMPIRE) {
|
hero(episode: EMPIRE) {
|
||||||
__typename
|
__typename
|
||||||
@ -254,12 +253,12 @@ test = testGroup "Star Wars Query Tests"
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
$ object ["data" .= object [
|
$ object ["data" .= object [
|
||||||
"hero" .= object ["__typename" .= ("Human" :: Text), lukeName]
|
"hero" .= object ["__typename" .= ("Human" :: Text), lukeName]
|
||||||
]]
|
]]
|
||||||
]
|
|
||||||
, testGroup "Errors in resolvers"
|
describe "Errors in resolvers" $ do
|
||||||
[ testCase "error on secretBackstory" . testQuery
|
it "error on secretBackstory" $ testQuery
|
||||||
[r|
|
[r|
|
||||||
query HeroNameQuery {
|
query HeroNameQuery {
|
||||||
hero {
|
hero {
|
||||||
@ -280,7 +279,7 @@ test = testGroup "Star Wars Query Tests"
|
|||||||
["message" .= ("secretBackstory is secret." :: Text)]
|
["message" .= ("secretBackstory is secret." :: Text)]
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
, testCase "Error in a list" . testQuery
|
it "Error in a list" $ testQuery
|
||||||
[r| query HeroNameQuery {
|
[r| query HeroNameQuery {
|
||||||
hero {
|
hero {
|
||||||
name
|
name
|
||||||
@ -291,32 +290,32 @@ test = testGroup "Star Wars Query Tests"
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
$ object ["data" .= object
|
$ object ["data" .= object
|
||||||
[ "hero" .= object
|
[ "hero" .= object
|
||||||
[ "name" .= ("R2-D2" :: Text)
|
[ "name" .= ("R2-D2" :: Text)
|
||||||
, "friends" .=
|
, "friends" .=
|
||||||
[ object
|
[ object
|
||||||
[ "name" .= ("Luke Skywalker" :: Text)
|
[ "name" .= ("Luke Skywalker" :: Text)
|
||||||
, "secretBackstory" .= Aeson.Null
|
, "secretBackstory" .= Aeson.Null
|
||||||
]
|
]
|
||||||
, object
|
, object
|
||||||
[ "name" .= ("Han Solo" :: Text)
|
[ "name" .= ("Han Solo" :: Text)
|
||||||
, "secretBackstory" .= Aeson.Null
|
, "secretBackstory" .= Aeson.Null
|
||||||
]
|
]
|
||||||
, object
|
, object
|
||||||
[ "name" .= ("Leia Organa" :: Text)
|
[ "name" .= ("Leia Organa" :: Text)
|
||||||
, "secretBackstory" .= Aeson.Null
|
, "secretBackstory" .= Aeson.Null
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
]
|
|
||||||
, "errors" .=
|
|
||||||
[ object ["message" .= ("secretBackstory is secret." :: Text)]
|
|
||||||
, object ["message" .= ("secretBackstory is secret." :: Text)]
|
|
||||||
, object ["message" .= ("secretBackstory is secret." :: Text)]
|
|
||||||
]
|
]
|
||||||
]
|
, "errors" .=
|
||||||
, testCase "error on secretBackstory with alias" . testQuery
|
[ object ["message" .= ("secretBackstory is secret." :: Text)]
|
||||||
|
, object ["message" .= ("secretBackstory is secret." :: Text)]
|
||||||
|
, object ["message" .= ("secretBackstory is secret." :: Text)]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
it "error on secretBackstory with alias" $ testQuery
|
||||||
[r| query HeroNameQuery {
|
[r| query HeroNameQuery {
|
||||||
mainHero: hero {
|
mainHero: hero {
|
||||||
name
|
name
|
||||||
@ -335,8 +334,7 @@ test = testGroup "Star Wars Query Tests"
|
|||||||
[ object ["message" .= ("secretBackstory is secret." :: Text)]
|
[ object ["message" .= ("secretBackstory is secret." :: Text)]
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
]
|
|
||||||
]
|
|
||||||
where
|
where
|
||||||
lukeName = "name" .= ("Luke Skywalker" :: Text)
|
lukeName = "name" .= ("Luke Skywalker" :: Text)
|
||||||
leiaName = "name" .= ("Leia Organa" :: Text)
|
leiaName = "name" .= ("Leia Organa" :: Text)
|
||||||
@ -346,8 +344,8 @@ test = testGroup "Star Wars Query Tests"
|
|||||||
tatooine = "homePlanet" .= ("Tatooine" :: Text)
|
tatooine = "homePlanet" .= ("Tatooine" :: Text)
|
||||||
alderaan = "homePlanet" .= ("Alderaan" :: Text)
|
alderaan = "homePlanet" .= ("Alderaan" :: Text)
|
||||||
|
|
||||||
testQuery :: Text -> Aeson.Value -> Assertion
|
testQuery :: Text -> Aeson.Value -> Expectation
|
||||||
testQuery q expected = graphql schema q >>= (@?= expected)
|
testQuery q expected = graphql schema q >>= flip shouldBe expected
|
||||||
|
|
||||||
testQueryParams :: Subs -> Text -> Aeson.Value -> Assertion
|
testQueryParams :: Subs -> Text -> Aeson.Value -> Expectation
|
||||||
testQueryParams f q expected = graphqlSubs schema f q >>= (@?= expected)
|
testQueryParams f q expected = graphqlSubs schema f q >>= flip shouldBe expected
|
@ -1,36 +0,0 @@
|
|||||||
module Main where
|
|
||||||
|
|
||||||
import qualified Data.Text.IO as T.IO
|
|
||||||
import qualified Language.GraphQL.Encoder as Encoder
|
|
||||||
import qualified Language.GraphQL.LexerTest as LexerTest
|
|
||||||
import qualified Language.GraphQL.Parser as Parser
|
|
||||||
import Text.Megaparsec ( errorBundlePretty
|
|
||||||
, parse
|
|
||||||
)
|
|
||||||
import Test.Tasty ( TestTree
|
|
||||||
, defaultMain
|
|
||||||
, testGroup
|
|
||||||
)
|
|
||||||
import Test.Tasty.HUnit ( assertEqual
|
|
||||||
, assertFailure
|
|
||||||
, testCase
|
|
||||||
)
|
|
||||||
import Paths_graphql (getDataFileName)
|
|
||||||
import qualified Test.StarWars.QueryTests as SW
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = defaultMain $ testGroup "Tests"
|
|
||||||
[ testGroup "Reference tests" [LexerTest.reference, SW.test]
|
|
||||||
, testGroup "Implementation tests" [LexerTest.implementation]
|
|
||||||
, kitchenTest
|
|
||||||
]
|
|
||||||
|
|
||||||
kitchenTest :: TestTree
|
|
||||||
kitchenTest = testCase "Kitchen Sink" $ do
|
|
||||||
dataFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql"
|
|
||||||
expected <- T.IO.readFile dataFileName
|
|
||||||
|
|
||||||
either
|
|
||||||
(assertFailure . errorBundlePretty)
|
|
||||||
(assertEqual "Encode" expected . Encoder.document)
|
|
||||||
$ parse Parser.document dataFileName expected
|
|
Loading…
Reference in New Issue
Block a user