diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/Language/GraphQL/ErrorSpec.hs | 24 | ||||
| -rw-r--r-- | tests/Language/GraphQL/LexerSpec.hs | 104 | ||||
| -rw-r--r-- | tests/Language/GraphQL/ParserSpec.hs | 18 | ||||
| -rw-r--r-- | tests/Spec.hs | 1 | ||||
| -rw-r--r-- | tests/Test/KitchenSinkSpec.hs | 29 | ||||
| -rw-r--r-- | tests/Test/StarWars/Data.hs | 197 | ||||
| -rw-r--r-- | tests/Test/StarWars/QuerySpec.hs | 351 | ||||
| -rw-r--r-- | tests/Test/StarWars/Schema.hs | 63 | ||||
| -rw-r--r-- | tests/tasty.hs | 28 |
9 files changed, 787 insertions, 28 deletions
diff --git a/tests/Language/GraphQL/ErrorSpec.hs b/tests/Language/GraphQL/ErrorSpec.hs new file mode 100644 index 0000000..8bb39ed --- /dev/null +++ b/tests/Language/GraphQL/ErrorSpec.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedStrings #-} +module Language.GraphQL.ErrorSpec + ( spec + ) where + +import qualified Data.Aeson as Aeson +import Language.GraphQL.Error +import Test.Hspec ( Spec + , describe + , it + , shouldBe + ) + +spec :: Spec +spec = describe "singleError" $ + it "constructs an error with the given message" $ + let expected = Aeson.object + [ + ("errors", Aeson.toJSON + [ Aeson.object [("message", "Message.")] + ] + ) + ] + in singleError "Message." `shouldBe` expected diff --git a/tests/Language/GraphQL/LexerSpec.hs b/tests/Language/GraphQL/LexerSpec.hs new file mode 100644 index 0000000..b5b605d --- /dev/null +++ b/tests/Language/GraphQL/LexerSpec.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Language.GraphQL.LexerSpec + ( spec + ) where + +import Data.Either (isRight) +import Data.Text (Text) +import Data.Void (Void) +import Language.GraphQL.Lexer +import Test.Hspec ( Spec + , context + , describe + , it + , shouldBe + , shouldSatisfy + ) +import Text.Megaparsec ( ParseErrorBundle + , parse + ) +import Text.RawString.QQ (r) + +spec :: Spec +spec = describe "Lexer" $ do + context "Reference tests" $ do + it "accepts BOM header" $ + runParser unicodeBOM "\xfeff" `shouldSatisfy` isRight + + 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 "()" `shouldSatisfy` isRight + runParser spread "..." `shouldBe` Right "..." + runParser colon ":" `shouldBe` Right ":" + runParser equals "=" `shouldBe` Right "=" + runParser at "@" `shouldBe` Right '@' + runBetween brackets "[]" `shouldSatisfy` isRight + runBetween braces "{}" `shouldSatisfy` isRight + 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 -> Text -> Either (ParseErrorBundle Text Void) a +runParser = flip parse "" + +runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) () +runBetween parser = parse (parser $ pure ()) "" diff --git a/tests/Language/GraphQL/ParserSpec.hs b/tests/Language/GraphQL/ParserSpec.hs new file mode 100644 index 0000000..c412c85 --- /dev/null +++ b/tests/Language/GraphQL/ParserSpec.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE OverloadedStrings #-} +module Language.GraphQL.ParserSpec + ( spec + ) where + +import Data.Either (isRight) +import Language.GraphQL.Parser (document) +import Test.Hspec ( Spec + , describe + , it + , shouldSatisfy + ) +import Text.Megaparsec (parse) + +spec :: Spec +spec = describe "Parser" $ + it "accepts BOM header" $ + parse document "" "\xfeff{foo}" `shouldSatisfy` isRight 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/Data.hs b/tests/Test/StarWars/Data.hs new file mode 100644 index 0000000..55ff207 --- /dev/null +++ b/tests/Test/StarWars/Data.hs @@ -0,0 +1,197 @@ +{-# LANGUAGE OverloadedStrings #-} +module Test.StarWars.Data + ( Character + , appearsIn + , artoo + , getDroid + , getDroid' + , getEpisode + , getFriends + , getHero + , getHeroIO + , getHuman + , id_ + , homePlanet + , name + , secretBackstory + , typeName + ) where + +import Data.Monoid (mempty) +import Control.Applicative ( Alternative(..) + , liftA2 + ) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.Trans.Except (throwE) +import Data.Maybe (catMaybes) +import Data.Text (Text) +import Language.GraphQL.Trans + +-- * Data +-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js + +-- ** Characters + +type ID = Text + +data CharCommon = CharCommon + { _id_ :: ID + , _name :: Text + , _friends :: [ID] + , _appearsIn :: [Int] + } deriving (Show) + + +data Human = Human + { _humanChar :: CharCommon + , homePlanet :: Text + } + +data Droid = Droid + { _droidChar :: CharCommon + , primaryFunction :: Text + } + +type Character = Either Droid Human + +id_ :: Character -> ID +id_ (Left x) = _id_ . _droidChar $ x +id_ (Right x) = _id_ . _humanChar $ x + +name :: Character -> Text +name (Left x) = _name . _droidChar $ x +name (Right x) = _name . _humanChar $ x + +friends :: Character -> [ID] +friends (Left x) = _friends . _droidChar $ x +friends (Right x) = _friends . _humanChar $ x + +appearsIn :: Character -> [Int] +appearsIn (Left x) = _appearsIn . _droidChar $ x +appearsIn (Right x) = _appearsIn . _humanChar $ x + +secretBackstory :: MonadIO m => Character -> ActionT m Text +secretBackstory = const $ ActionT $ throwE "secretBackstory is secret." + +typeName :: Character -> Text +typeName = either (const "Droid") (const "Human") + +luke :: Character +luke = Right luke' + +luke' :: Human +luke' = Human + { _humanChar = CharCommon + { _id_ = "1000" + , _name = "Luke Skywalker" + , _friends = ["1002","1003","2000","2001"] + , _appearsIn = [4,5,6] + } + , homePlanet = "Tatooine" + } + +vader :: Human +vader = Human + { _humanChar = CharCommon + { _id_ = "1001" + , _name = "Darth Vader" + , _friends = ["1004"] + , _appearsIn = [4,5,6] + } + , homePlanet = "Tatooine" + } + +han :: Human +han = Human + { _humanChar = CharCommon + { _id_ = "1002" + , _name = "Han Solo" + , _friends = ["1000","1003","2001" ] + , _appearsIn = [4,5,6] + } + , homePlanet = mempty + } + +leia :: Human +leia = Human + { _humanChar = CharCommon + { _id_ = "1003" + , _name = "Leia Organa" + , _friends = ["1000","1002","2000","2001"] + , _appearsIn = [4,5,6] + } + , homePlanet = "Alderaan" + } + +tarkin :: Human +tarkin = Human + { _humanChar = CharCommon + { _id_ = "1004" + , _name = "Wilhuff Tarkin" + , _friends = ["1001"] + , _appearsIn = [4] + } + , homePlanet = mempty + } + +threepio :: Droid +threepio = Droid + { _droidChar = CharCommon + { _id_ = "2000" + , _name = "C-3PO" + , _friends = ["1000","1002","1003","2001" ] + , _appearsIn = [ 4, 5, 6 ] + } + , primaryFunction = "Protocol" + } + +artoo :: Character +artoo = Left artoo' + +artoo' :: Droid +artoo' = Droid + { _droidChar = CharCommon + { _id_ = "2001" + , _name = "R2-D2" + , _friends = ["1000","1002","1003"] + , _appearsIn = [4,5,6] + } + , primaryFunction = "Astrometch" + } + +-- ** Helper functions + +getHero :: Int -> Character +getHero 5 = luke +getHero _ = artoo + +getHeroIO :: Int -> IO Character +getHeroIO = pure . getHero + +getHuman :: Alternative f => ID -> f Character +getHuman = fmap Right . getHuman' + +getHuman' :: Alternative f => ID -> f Human +getHuman' "1000" = pure luke' +getHuman' "1001" = pure vader +getHuman' "1002" = pure han +getHuman' "1003" = pure leia +getHuman' "1004" = pure tarkin +getHuman' _ = empty + +getDroid :: Alternative f => ID -> f Character +getDroid = fmap Left . getDroid' + +getDroid' :: Alternative f => ID -> f Droid +getDroid' "2000" = pure threepio +getDroid' "2001" = pure artoo' +getDroid' _ = empty + +getFriends :: Character -> [Character] +getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char + +getEpisode :: Alternative f => Int -> f Text +getEpisode 4 = pure "NEWHOPE" +getEpisode 5 = pure "EMPIRE" +getEpisode 6 = pure "JEDI" +getEpisode _ = empty diff --git a/tests/Test/StarWars/QuerySpec.hs b/tests/Test/StarWars/QuerySpec.hs new file mode 100644 index 0000000..0f6a2ef --- /dev/null +++ b/tests/Test/StarWars/QuerySpec.hs @@ -0,0 +1,351 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Test.StarWars.QuerySpec + ( spec + ) where + +import qualified Data.Aeson as Aeson +import Data.Aeson ( object + , (.=) + ) +import Data.Text (Text) +import Language.GraphQL +import Language.GraphQL.Schema (Subs) +import Text.RawString.QQ (r) +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 + +spec :: Spec +spec = describe "Star Wars Query Tests" $ do + describe "Basic Queries" $ do + it "R2-D2 hero" $ testQuery + [r| query HeroNameQuery { + hero { + id + } + } + |] + $ object [ "data" .= object ["hero" .= object ["id" .= ("2001" :: Text)]]] + it "R2-D2 ID and friends" $ testQuery + [r| query HeroNameAndFriendsQuery { + hero { + id + name + friends { + name + } + } + } + |] + $ object [ "data" .= object [ + "hero" .= object + [ "id" .= ("2001" :: Text) + , r2d2Name + , "friends" .= + [ object [lukeName] + , object [hanName] + , object [leiaName] + ] + ] + ]] + + describe "Nested Queries" $ do + it "R2-D2 friends" $ testQuery + [r| query NestedQuery { + hero { + name + friends { + name + appearsIn + friends { + name + } + } + } + } + |] + $ object [ "data" .= object [ + "hero" .= object [ + "name" .= ("R2-D2" :: Text) + , "friends" .= [ + object [ + "name" .= ("Luke Skywalker" :: Text) + , "appearsIn" .= ["NEWHOPE","EMPIRE","JEDI" :: Text] + , "friends" .= [ + object [hanName] + , object [leiaName] + , object [c3poName] + , object [r2d2Name] + ] + ] + , object [ + hanName + , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text] + , "friends" .= [ + object [lukeName] + , object [leiaName] + , object [r2d2Name] + ] + ] + , object [ + leiaName + , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text] + , "friends" .= [ + object [lukeName] + , object [hanName] + , object [c3poName] + , object [r2d2Name] + ] + ] + ] + ] + ]] + it "Luke ID" $ testQuery + [r| query FetchLukeQuery { + human(id: "1000") { + name + } + } + |] + $ object [ "data" .= object [ + "human" .= object [lukeName] + ]] + + 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 [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" .= 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)] + ] + ] + ]] + 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] + ]] + + describe "Fragments for complex queries" $ do + it "Aliases to query for duplicate content" $ testQuery + [r| query DuplicateFields { + luke: human(id: "1000") { + name + homePlanet + } + leia: human(id: "1003") { + name + homePlanet + } + } + |] + $ object [ "data" .= object [ + "luke" .= object [lukeName, tatooine] + , "leia" .= object [leiaName, alderaan] + ]] + it "Fragment for duplicate content" $ testQuery + [r| query UseFragment { + luke: human(id: "1000") { + ...HumanFragment + } + leia: human(id: "1003") { + ...HumanFragment + } + } + fragment HumanFragment on Human { + name + homePlanet + } + |] + $ object [ "data" .= object [ + "luke" .= object [lukeName, tatooine] + , "leia" .= object [leiaName, alderaan] + ]] + + describe "__typename" $ do + it "R2D2 is a Droid" $ testQuery + [r| query CheckTypeOfR2 { + hero { + __typename + name + } + } + |] + $ object ["data" .= object [ + "hero" .= object ["__typename" .= ("Droid" :: Text), r2d2Name] + ]] + it "Luke is a human" $ testQuery + [r| query CheckTypeOfLuke { + hero(episode: EMPIRE) { + __typename + name + } + } + |] + $ object ["data" .= object [ + "hero" .= object ["__typename" .= ("Human" :: Text), lukeName] + ]] + + describe "Errors in resolvers" $ do + it "error on secretBackstory" $ testQuery + [r| + query HeroNameQuery { + hero { + name + secretBackstory + } + } + |] + $ object + [ "data" .= object + [ "hero" .= object + [ "name" .= ("R2-D2" :: Text) + , "secretBackstory" .= Aeson.Null + ] + ] + , "errors" .= + [ object + ["message" .= ("secretBackstory is secret." :: Text)] + ] + ] + it "Error in a list" $ testQuery + [r| query HeroNameQuery { + hero { + name + friends { + name + secretBackstory + } + } + } + |] + $ 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)] + ] + ] + it "error on secretBackstory with alias" $ testQuery + [r| query HeroNameQuery { + mainHero: hero { + name + story: secretBackstory + } + } + |] + $ object + [ "data" .= object + [ "mainHero" .= object + [ "name" .= ("R2-D2" :: Text) + , "story" .= Aeson.Null + ] + ] + , "errors" .= + [ object ["message" .= ("secretBackstory is secret." :: Text)] + ] + ] + + where + lukeName = "name" .= ("Luke Skywalker" :: Text) + leiaName = "name" .= ("Leia Organa" :: Text) + hanName = "name" .= ("Han Solo" :: Text) + r2d2Name = "name" .= ("R2-D2" :: Text) + c3poName = "name" .= ("C-3PO" :: Text) + tatooine = "homePlanet" .= ("Tatooine" :: Text) + alderaan = "homePlanet" .= ("Alderaan" :: Text) + +testQuery :: Text -> Aeson.Value -> Expectation +testQuery q expected = graphql schema q >>= flip shouldBe expected + +testQueryParams :: Subs -> Text -> Aeson.Value -> Expectation +testQueryParams f q expected = graphqlSubs schema f q >>= flip shouldBe expected diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs new file mode 100644 index 0000000..101bbdf --- /dev/null +++ b/tests/Test/StarWars/Schema.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +module Test.StarWars.Schema + ( character + , droid + , hero + , human + , schema + ) where + +import Control.Monad.Trans.Except (throwE) +import Control.Monad.Trans.Class (lift) +import Control.Monad.IO.Class (MonadIO(..)) +import Data.List.NonEmpty (NonEmpty((:|))) +import Language.GraphQL.Schema ( Schema + , Resolver + , Argument(..) + , Value(..) + ) +import qualified Language.GraphQL.Schema as Schema +import Language.GraphQL.Trans +import Language.GraphQL.Type +import Test.StarWars.Data + +-- * Schema +-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js + +schema :: MonadIO m => Schema m +schema = hero :| [human, droid] + +hero :: MonadIO m => Resolver m +hero = Schema.objectA "hero" $ \case + [] -> character artoo + [Argument "episode" (ValueEnum "NEWHOPE")] -> character $ getHero 4 + [Argument "episode" (ValueEnum "EMPIRE" )] -> character $ getHero 5 + [Argument "episode" (ValueEnum "JEDI" )] -> character $ getHero 6 + _ -> ActionT $ throwE "Invalid arguments." + +human :: MonadIO m => Resolver m +human = Schema.wrappedObjectA "human" $ \case + [Argument "id" (ValueString i)] -> do + humanCharacter <- lift $ return $ getHuman i >>= Just + case humanCharacter of + Nothing -> return Null + Just e -> Named <$> character e + _ -> ActionT $ throwE "Invalid arguments." + +droid :: MonadIO m => Resolver m +droid = Schema.objectA "droid" $ \case + [Argument "id" (ValueString i)] -> character =<< liftIO (getDroid i) + _ -> ActionT $ throwE "Invalid arguments." + +character :: MonadIO m => Character -> ActionT m [Resolver m] +character char = return + [ Schema.scalar "id" $ return $ id_ char + , Schema.scalar "name" $ return $ name char + , Schema.wrappedObject "friends" + $ traverse character $ List $ Named <$> getFriends char + , Schema.enum "appearsIn" $ return $ foldMap getEpisode $ appearsIn char + , Schema.scalar "secretBackstory" $ secretBackstory char + , Schema.scalar "homePlanet" $ return $ either mempty homePlanet char + , Schema.scalar "__typename" $ return $ typeName char + ] diff --git a/tests/tasty.hs b/tests/tasty.hs deleted file mode 100644 index a034a79..0000000 --- a/tests/tasty.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -module Main where - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>), (<*>)) -#endif - -import Data.Attoparsec.Text (parseOnly) -import qualified Data.Text.IO as Text -import Test.Tasty (defaultMain) -import Test.Tasty.HUnit - -import qualified Data.GraphQL.Parser as Parser -import qualified Data.GraphQL.Encoder as Encoder - -import Paths_graphql (getDataFileName) - -main :: IO () -main = defaultMain =<< testCase "Kitchen Sink" - <$> (assertEqual "Encode" <$> expected <*> actual) - where - expected = Text.readFile - =<< getDataFileName "tests/data/kitchen-sink.min.graphql" - - actual = either (error "Parsing error!") Encoder.document - <$> parseOnly Parser.document - <$> expected |