diff --git a/graphql.cabal b/graphql.cabal index 0f9c866..606a834 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 20a76d38355648944315f3aa937e5cd72837bbd1b93037f53e2849906de3f2c0 +-- hash: 2ad18ce352b6b5324c5e8c4fa3e7c1dc39022b209696d162367d13300c4046fd name: graphql version: 0.4.0.0 @@ -65,11 +65,12 @@ library test-suite tasty type: exitcode-stdio-1.0 - main-is: tasty.hs + main-is: Spec.hs other-modules: - Language.GraphQL.LexerTest + Language.GraphQL.LexerSpec + Test.KitchenSinkSpec Test.StarWars.Data - Test.StarWars.QueryTests + Test.StarWars.QuerySpec Test.StarWars.Schema Paths_graphql hs-source-dirs: @@ -79,10 +80,10 @@ test-suite tasty aeson , base >=4.7 && <5 , graphql + , hspec + , hspec-expectations , megaparsec , raw-strings-qq - , tasty - , tasty-hunit , text , transformers default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 50f709a..f7dd238 100644 --- a/package.yaml +++ b/package.yaml @@ -41,7 +41,7 @@ library: tests: tasty: - main: tasty.hs + main: Spec.hs source-dirs: tests ghc-options: - -threaded @@ -49,6 +49,6 @@ tests: - -with-rtsopts=-N dependencies: - graphql + - hspec + - hspec-expectations - raw-strings-qq - - tasty - - tasty-hunit diff --git a/tests/Language/GraphQL/LexerSpec.hs b/tests/Language/GraphQL/LexerSpec.hs new file mode 100644 index 0000000..2a370ea --- /dev/null +++ b/tests/Language/GraphQL/LexerSpec.hs @@ -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 ()) "" diff --git a/tests/Language/GraphQL/LexerTest.hs b/tests/Language/GraphQL/LexerTest.hs deleted file mode 100644 index fdd12f4..0000000 --- a/tests/Language/GraphQL/LexerTest.hs +++ /dev/null @@ -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 ()) "" diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 index 0000000..a824f8c --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/tests/Test/KitchenSinkSpec.hs b/tests/Test/KitchenSinkSpec.hs new file mode 100644 index 0000000..99a00f7 --- /dev/null +++ b/tests/Test/KitchenSinkSpec.hs @@ -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 diff --git a/tests/Test/StarWars/QueryTests.hs b/tests/Test/StarWars/QuerySpec.hs similarity index 52% rename from tests/Test/StarWars/QueryTests.hs rename to tests/Test/StarWars/QuerySpec.hs index 3a6ca75..0f6a2ef 100644 --- a/tests/Test/StarWars/QueryTests.hs +++ b/tests/Test/StarWars/QuerySpec.hs @@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -module Test.StarWars.QueryTests (test) where +module Test.StarWars.QuerySpec + ( spec + ) where import qualified Data.Aeson as Aeson import Data.Aeson ( object @@ -10,52 +12,54 @@ import Data.Text (Text) import Language.GraphQL import Language.GraphQL.Schema (Subs) import Text.RawString.QQ (r) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit ( Assertion - , testCase - , (@?=) - ) +import Test.Hspec.Expectations ( Expectation + , shouldBe + ) +import Test.Hspec ( Spec + , describe + , it + ) import Test.StarWars.Schema -- * Test -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsQueryTests.js -test :: TestTree -test = testGroup "Star Wars Query Tests" - [ testGroup "Basic Queries" - [ testCase "R2-D2 hero" . testQuery +spec :: Spec +spec = describe "Star Wars Query Tests" $ do + describe "Basic Queries" $ do + it "R2-D2 hero" $ testQuery [r| query HeroNameQuery { - hero { + hero { id - } + } } |] - $ object [ "data" .= object ["hero" .= object ["id" .= ("2001" :: Text)]]] - , testCase "R2-D2 ID and friends" . testQuery + $ object [ "data" .= object ["hero" .= object ["id" .= ("2001" :: Text)]]] + it "R2-D2 ID and friends" $ testQuery [r| query HeroNameAndFriendsQuery { - hero { + hero { id name friends { - name + name } - } + } } |] - $ object [ "data" .= object [ - "hero" .= object [ - "id" .= ("2001" :: Text) - , r2d2Name - , "friends" .= [ - object [lukeName] - , object [hanName] - , object [leiaName] + $ object [ "data" .= object [ + "hero" .= object + [ "id" .= ("2001" :: Text) + , r2d2Name + , "friends" .= + [ object [lukeName] + , object [hanName] + , object [leiaName] + ] ] - ] ]] - ] - , testGroup "Nested Queries" - [ testCase "R2-D2 friends" . testQuery + + describe "Nested Queries" $ do + it "R2-D2 friends" $ testQuery [r| query NestedQuery { hero { name @@ -69,7 +73,7 @@ test = testGroup "Star Wars Query Tests" } } |] - $ object [ "data" .= object [ + $ object [ "data" .= object [ "hero" .= object [ "name" .= ("R2-D2" :: Text) , "friends" .= [ @@ -105,101 +109,96 @@ test = testGroup "Star Wars Query Tests" ] ] ]] - , testCase "Luke ID" . testQuery + it "Luke ID" $ testQuery [r| query FetchLukeQuery { human(id: "1000") { name } } |] - $ 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 [ + $ object [ "data" .= object [ "human" .= object [lukeName] ]] - , testCase "Han ID with variable" . testQueryParams - (\v -> if v == "someId" - then Just "1002" - else Nothing) - [r| query FetchSomeIDQuery($someId: String!) { - human(id: $someId) { - name - } + + it "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 [hanName] - ]] - , testCase "Invalid ID" . testQueryParams - (\v -> if v == "id" - then Just "Not a valid ID" - else Nothing) - [r| query humanQuery($id: String!) { - human(id: $id) { - name - } + "human" .= object [lukeName] + ]] + it "Han ID with variable" $ testQueryParams + (\v -> if v == "someId" then Just "1002" else Nothing) + [r| query FetchSomeIDQuery($someId: String!) { + human(id: $someId) { + name } - |] $ object ["data" .= object ["human" .= Aeson.Null]] - , testCase "Luke aliased" . testQuery - [r| query FetchLukeAliased { - luke: human(id: "1000") { - name - } - } - |] + } + |] $ object [ "data" .= object [ - "luke" .= object [lukeName] - ]] - , testCase "R2-D2 ID and friends aliased" . testQuery - [r| query HeroNameAndFriendsQuery { - hero { - id - name - friends { - friendName: name - } + "human" .= object [hanName] + ]] + it "Invalid ID" $ testQueryParams + (\v -> if v == "id" then Just "Not a valid ID" else Nothing) + [r| query humanQuery($id: String!) { + human(id: $id) { + 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 [ - "hero" .= object [ - "id" .= ("2001" :: Text) - , r2d2Name - , "friends" .= [ - object ["friendName" .= ("Luke Skywalker" :: Text)] - , object ["friendName" .= ("Han Solo" :: Text)] - , object ["friendName" .= ("Leia Organa" :: Text)] - ] - ] - ]] - , testCase "Luke and Leia aliased" . testQuery - [r| query FetchLukeAndLeiaAliased { - luke: human(id: "1000") { - name - } - leia: human(id: "1003") { - name - } + "hero" .= object [ + "id" .= ("2001" :: Text) + , r2d2Name + , "friends" .= [ + object ["friendName" .= ("Luke Skywalker" :: Text)] + , object ["friendName" .= ("Han Solo" :: Text)] + , object ["friendName" .= ("Leia Organa" :: Text)] + ] + ] + ]] + it "Luke and Leia aliased" $ testQuery + [r| query FetchLukeAndLeiaAliased { + luke: human(id: "1000") { + name } - |] + leia: human(id: "1003") { + name + } + } + |] $ object [ "data" .= object [ - "luke" .= object [lukeName] - , "leia" .= object [leiaName] - ]] - , testGroup "Fragments for complex queries" - [ testCase "Aliases to query for duplicate content" . testQuery + "luke" .= object [lukeName] + , "leia" .= object [leiaName] + ]] + + describe "Fragments for complex queries" $ do + it "Aliases to query for duplicate content" $ testQuery [r| query DuplicateFields { luke: human(id: "1000") { name @@ -211,11 +210,11 @@ test = testGroup "Star Wars Query Tests" } } |] - $ object [ "data" .= object [ + $ object [ "data" .= object [ "luke" .= object [lukeName, tatooine] , "leia" .= object [leiaName, alderaan] ]] - , testCase "Fragment for duplicate content" . testQuery + it "Fragment for duplicate content" $ testQuery [r| query UseFragment { luke: human(id: "1000") { ...HumanFragment @@ -229,13 +228,13 @@ test = testGroup "Star Wars Query Tests" homePlanet } |] - $ object [ "data" .= object [ + $ object [ "data" .= object [ "luke" .= object [lukeName, tatooine] , "leia" .= object [leiaName, alderaan] ]] - ] - , testGroup "__typename" - [ testCase "R2D2 is a Droid" . testQuery + + describe "__typename" $ do + it "R2D2 is a Droid" $ testQuery [r| query CheckTypeOfR2 { hero { __typename @@ -243,10 +242,10 @@ test = testGroup "Star Wars Query Tests" } } |] - $ object ["data" .= object [ - "hero" .= object ["__typename" .= ("Droid" :: Text), r2d2Name] - ]] - , testCase "Luke is a human" . testQuery + $ object ["data" .= object [ + "hero" .= object ["__typename" .= ("Droid" :: Text), r2d2Name] + ]] + it "Luke is a human" $ testQuery [r| query CheckTypeOfLuke { hero(episode: EMPIRE) { __typename @@ -254,12 +253,12 @@ test = testGroup "Star Wars Query Tests" } } |] - $ object ["data" .= object [ - "hero" .= object ["__typename" .= ("Human" :: Text), lukeName] - ]] - ] - , testGroup "Errors in resolvers" - [ testCase "error on secretBackstory" . testQuery + $ object ["data" .= object [ + "hero" .= object ["__typename" .= ("Human" :: Text), lukeName] + ]] + + describe "Errors in resolvers" $ do + it "error on secretBackstory" $ testQuery [r| query HeroNameQuery { hero { @@ -280,7 +279,7 @@ test = testGroup "Star Wars Query Tests" ["message" .= ("secretBackstory is secret." :: Text)] ] ] - , testCase "Error in a list" . testQuery + it "Error in a list" $ testQuery [r| query HeroNameQuery { hero { name @@ -291,32 +290,32 @@ test = testGroup "Star Wars Query Tests" } } |] - $ object ["data" .= object - [ "hero" .= object - [ "name" .= ("R2-D2" :: Text) - , "friends" .= - [ object - [ "name" .= ("Luke Skywalker" :: Text) - , "secretBackstory" .= Aeson.Null - ] - , object - [ "name" .= ("Han Solo" :: Text) - , "secretBackstory" .= Aeson.Null - ] - , object - [ "name" .= ("Leia Organa" :: Text) - , "secretBackstory" .= Aeson.Null - ] - ] - ] - ] - , "errors" .= - [ object ["message" .= ("secretBackstory is secret." :: Text)] - , object ["message" .= ("secretBackstory is secret." :: Text)] - , object ["message" .= ("secretBackstory is secret." :: Text)] + $ object ["data" .= object + [ "hero" .= object + [ "name" .= ("R2-D2" :: Text) + , "friends" .= + [ object + [ "name" .= ("Luke Skywalker" :: Text) + , "secretBackstory" .= Aeson.Null + ] + , object + [ "name" .= ("Han Solo" :: Text) + , "secretBackstory" .= Aeson.Null + ] + , object + [ "name" .= ("Leia Organa" :: Text) + , "secretBackstory" .= Aeson.Null + ] + ] + ] ] - ] - , testCase "error on secretBackstory with alias" . testQuery + , "errors" .= + [ 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 { mainHero: hero { name @@ -335,8 +334,7 @@ test = testGroup "Star Wars Query Tests" [ object ["message" .= ("secretBackstory is secret." :: Text)] ] ] - ] - ] + where lukeName = "name" .= ("Luke Skywalker" :: Text) leiaName = "name" .= ("Leia Organa" :: Text) @@ -346,8 +344,8 @@ test = testGroup "Star Wars Query Tests" tatooine = "homePlanet" .= ("Tatooine" :: Text) alderaan = "homePlanet" .= ("Alderaan" :: Text) -testQuery :: Text -> Aeson.Value -> Assertion -testQuery q expected = graphql schema q >>= (@?= expected) +testQuery :: Text -> Aeson.Value -> Expectation +testQuery q expected = graphql schema q >>= flip shouldBe expected -testQueryParams :: Subs -> Text -> Aeson.Value -> Assertion -testQueryParams f q expected = graphqlSubs schema f q >>= (@?= expected) +testQueryParams :: Subs -> Text -> Aeson.Value -> Expectation +testQueryParams f q expected = graphqlSubs schema f q >>= flip shouldBe expected diff --git a/tests/tasty.hs b/tests/tasty.hs deleted file mode 100644 index dd7e356..0000000 --- a/tests/tasty.hs +++ /dev/null @@ -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