diff --git a/graphql.cabal b/graphql.cabal index 337e397..abbfba6 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -4,7 +4,7 @@ cabal-version: 2.2 -- -- see: https://github.com/sol/hpack -- --- hash: ddb79ddbd13b917f320fff372b4a29b63b6eb0ed113ca732c1d779b4e6a296d8 +-- hash: c943c792ef9717e8305e22059e7244a0a471b6d26a53e6e4dc162e4f4a6110b4 name: graphql version: 0.10.0.0 @@ -74,7 +74,7 @@ library , unordered-containers default-language: Haskell2010 -test-suite tasty +test-suite graphql-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: @@ -89,9 +89,6 @@ test-suite tasty Test.DirectiveSpec Test.FragmentSpec Test.RootOperationSpec - Test.StarWars.Data - Test.StarWars.QuerySpec - Test.StarWars.Schema Paths_graphql hs-source-dirs: tests diff --git a/package.yaml b/package.yaml index b050492..8be36da 100644 --- a/package.yaml +++ b/package.yaml @@ -50,7 +50,7 @@ library: - Language.GraphQL.Validate.Rules tests: - tasty: + graphql-test: main: Spec.hs source-dirs: tests ghc-options: diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs deleted file mode 100644 index e3dd696..0000000 --- a/tests/Test/StarWars/Data.hs +++ /dev/null @@ -1,204 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Test.StarWars.Data - ( Character - , StarWarsException(..) - , appearsIn - , artoo - , getDroid - , getDroid' - , getEpisode - , getFriends - , getHero - , getHuman - , id_ - , homePlanet - , name_ - , secretBackstory - , typeName - ) where - -import Control.Monad.Catch (Exception(..), MonadThrow(..), SomeException) -import Control.Applicative (Alternative(..), liftA2) -import Data.Maybe (catMaybes) -import Data.Text (Text) -import Data.Typeable (cast) -import Language.GraphQL.Error -import Language.GraphQL.Type - --- * 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 - -data StarWarsException = SecretBackstory | InvalidArguments - -instance Show StarWarsException where - show SecretBackstory = "secretBackstory is secret." - show InvalidArguments = "Invalid arguments." - -instance Exception StarWarsException where - toException = toException . ResolverException - fromException e = do - ResolverException resolverException <- fromException e - cast resolverException - -secretBackstory :: Resolve (Either SomeException) -secretBackstory = throwM SecretBackstory - -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 - -getHuman :: ID -> Maybe Character -getHuman = fmap Right . getHuman' - -getHuman' :: ID -> Maybe Human -getHuman' "1000" = pure luke' -getHuman' "1001" = pure vader -getHuman' "1002" = pure han -getHuman' "1003" = pure leia -getHuman' "1004" = pure tarkin -getHuman' _ = empty - -getDroid :: ID -> Maybe Character -getDroid = fmap Left . getDroid' - -getDroid' :: ID -> Maybe Droid -getDroid' "2000" = pure threepio -getDroid' "2001" = pure artoo' -getDroid' _ = empty - -getFriends :: Character -> [Character] -getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char - -getEpisode :: Int -> Maybe Text -getEpisode 4 = pure "NEW_HOPE" -getEpisode 5 = pure "EMPIRE" -getEpisode 6 = pure "JEDI" -getEpisode _ = empty diff --git a/tests/Test/StarWars/QuerySpec.hs b/tests/Test/StarWars/QuerySpec.hs deleted file mode 100644 index f9b13d9..0000000 --- a/tests/Test/StarWars/QuerySpec.hs +++ /dev/null @@ -1,366 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -module Test.StarWars.QuerySpec - ( spec - ) where - -import qualified Data.Aeson as Aeson -import Data.Aeson ((.=)) -import qualified Data.HashMap.Strict as HashMap -import Data.Text (Text) -import Language.GraphQL -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 - } - } - |] - $ Aeson.object - [ "data" .= Aeson.object - [ "hero" .= Aeson.object ["id" .= ("2001" :: Text)] - ] - ] - it "R2-D2 ID and friends" $ testQuery - [r| query HeroNameAndFriendsQuery { - hero { - id - name - friends { - name - } - } - } - |] - $ Aeson.object [ "data" .= Aeson.object [ - "hero" .= Aeson.object - [ "id" .= ("2001" :: Text) - , r2d2Name - , "friends" .= - [ Aeson.object [lukeName] - , Aeson.object [hanName] - , Aeson.object [leiaName] - ] - ] - ]] - - describe "Nested Queries" $ do - it "R2-D2 friends" $ testQuery - [r| query NestedQuery { - hero { - name - friends { - name - appearsIn - friends { - name - } - } - } - } - |] - $ Aeson.object [ "data" .= Aeson.object [ - "hero" .= Aeson.object [ - "name" .= ("R2-D2" :: Text) - , "friends" .= [ - Aeson.object [ - "name" .= ("Luke Skywalker" :: Text) - , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text] - , "friends" .= [ - Aeson.object [hanName] - , Aeson.object [leiaName] - , Aeson.object [c3poName] - , Aeson.object [r2d2Name] - ] - ] - , Aeson.object [ - hanName - , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text] - , "friends" .= - [ Aeson.object [lukeName] - , Aeson.object [leiaName] - , Aeson.object [r2d2Name] - ] - ] - , Aeson.object [ - leiaName - , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text] - , "friends" .= - [ Aeson.object [lukeName] - , Aeson.object [hanName] - , Aeson.object [c3poName] - , Aeson.object [r2d2Name] - ] - ] - ] - ] - ]] - it "Luke ID" $ testQuery - [r| query FetchLukeQuery { - human(id: "1000") { - name - } - } - |] - $ Aeson.object [ "data" .= Aeson.object - [ "human" .= Aeson.object [lukeName] - ]] - - it "Luke ID with variable" $ testQueryParams - (HashMap.singleton "someId" "1000") - [r| query FetchSomeIDQuery($someId: String!) { - human(id: $someId) { - name - } - } - |] - $ Aeson.object [ "data" .= Aeson.object [ - "human" .= Aeson.object [lukeName] - ]] - it "Han ID with variable" $ testQueryParams - (HashMap.singleton "someId" "1002") - [r| query FetchSomeIDQuery($someId: String!) { - human(id: $someId) { - name - } - } - |] - $ Aeson.object [ "data" .= Aeson.object [ - "human" .= Aeson.object [hanName] - ]] - it "Invalid ID" $ testQueryParams - (HashMap.singleton "id" "Not a valid ID") - [r| query humanQuery($id: String!) { - human(id: $id) { - name - } - } - |] $ Aeson.object ["data" .= Aeson.object ["human" .= Aeson.Null]] - it "Luke aliased" $ testQuery - [r| query FetchLukeAliased { - luke: human(id: "1000") { - name - } - } - |] - $ Aeson.object [ "data" .= Aeson.object [ - "luke" .= Aeson.object [lukeName] - ]] - it "R2-D2 ID and friends aliased" $ testQuery - [r| query HeroNameAndFriendsQuery { - hero { - id - name - friends { - friendName: name - } - } - } - |] - $ Aeson.object [ "data" .= Aeson.object [ - "hero" .= Aeson.object [ - "id" .= ("2001" :: Text) - , r2d2Name - , "friends" .= - [ Aeson.object ["friendName" .= ("Luke Skywalker" :: Text)] - , Aeson.object ["friendName" .= ("Han Solo" :: Text)] - , Aeson.object ["friendName" .= ("Leia Organa" :: Text)] - ] - ] - ]] - it "Luke and Leia aliased" $ testQuery - [r| query FetchLukeAndLeiaAliased { - luke: human(id: "1000") { - name - } - leia: human(id: "1003") { - name - } - } - |] - $ Aeson.object [ "data" .= Aeson.object - [ "luke" .= Aeson.object [lukeName] - , "leia" .= Aeson.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 - } - } - |] - $ Aeson.object [ "data" .= Aeson.object [ - "luke" .= Aeson.object [lukeName, tatooine] - , "leia" .= Aeson.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 - } - |] - $ Aeson.object [ "data" .= Aeson.object [ - "luke" .= Aeson.object [lukeName, tatooine] - , "leia" .= Aeson.object [leiaName, alderaan] - ]] - - describe "__typename" $ do - it "R2D2 is a Droid" $ testQuery - [r| query CheckTypeOfR2 { - hero { - __typename - name - } - } - |] - $ Aeson.object ["data" .= Aeson.object [ - "hero" .= Aeson.object - [ "__typename" .= ("Droid" :: Text) - , r2d2Name - ] - ]] - it "Luke is a human" $ testQuery - [r| query CheckTypeOfLuke { - hero(episode: EMPIRE) { - __typename - name - } - } - |] - $ Aeson.object ["data" .= Aeson.object [ - "hero" .= Aeson.object - [ "__typename" .= ("Human" :: Text) - , lukeName - ] - ]] - - describe "Errors in resolvers" $ do - it "error on secretBackstory" $ testQuery - [r| - query HeroNameQuery { - hero { - name - secretBackstory - } - } - |] - $ Aeson.object - [ "data" .= Aeson.object - [ "hero" .= Aeson.object - [ "name" .= ("R2-D2" :: Text) - , "secretBackstory" .= Aeson.Null - ] - ] - , "errors" .= - [ Aeson.object - ["message" .= ("secretBackstory is secret." :: Text)] - ] - ] - it "Error in a list" $ testQuery - [r| query HeroNameQuery { - hero { - name - friends { - name - secretBackstory - } - } - } - |] - $ Aeson.object ["data" .= Aeson.object - [ "hero" .= Aeson.object - [ "name" .= ("R2-D2" :: Text) - , "friends" .= - [ Aeson.object - [ "name" .= ("Luke Skywalker" :: Text) - , "secretBackstory" .= Aeson.Null - ] - , Aeson.object - [ "name" .= ("Han Solo" :: Text) - , "secretBackstory" .= Aeson.Null - ] - , Aeson.object - [ "name" .= ("Leia Organa" :: Text) - , "secretBackstory" .= Aeson.Null - ] - ] - ] - ] - , "errors" .= - [ Aeson.object - [ "message" .= ("secretBackstory is secret." :: Text) - ] - , Aeson.object - [ "message" .= ("secretBackstory is secret." :: Text) - ] - , Aeson.object - [ "message" .= ("secretBackstory is secret." :: Text) - ] - ] - ] - it "error on secretBackstory with alias" $ testQuery - [r| query HeroNameQuery { - mainHero: hero { - name - story: secretBackstory - } - } - |] - $ Aeson.object - [ "data" .= Aeson.object - [ "mainHero" .= Aeson.object - [ "name" .= ("R2-D2" :: Text) - , "story" .= Aeson.Null - ] - ] - , "errors" .= - [ Aeson.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 = - let Right (Right actual) = graphql starWarsSchema q - in Aeson.Object actual `shouldBe` expected - -testQueryParams :: Aeson.Object -> Text -> Aeson.Value -> Expectation -testQueryParams f q expected = - let Right (Right actual) = graphqlSubs starWarsSchema Nothing f q - in Aeson.Object actual `shouldBe` expected diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs deleted file mode 100644 index 90ce9fc..0000000 --- a/tests/Test/StarWars/Schema.hs +++ /dev/null @@ -1,166 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -module Test.StarWars.Schema - ( starWarsSchema - ) where - -import Control.Monad.Catch (MonadThrow(..), SomeException) -import Control.Monad.Trans.Reader (asks) -import qualified Data.HashMap.Strict as HashMap -import Data.Maybe (catMaybes) -import Data.Text (Text) -import Language.GraphQL.Type -import qualified Language.GraphQL.Type.In as In -import qualified Language.GraphQL.Type.Out as Out -import Test.StarWars.Data -import Prelude hiding (id) - --- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js - -starWarsSchema :: Schema (Either SomeException) -starWarsSchema = schema queryType Nothing Nothing mempty - where - queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList - [ ("hero", heroFieldResolver) - , ("human", humanFieldResolver) - , ("droid", droidFieldResolver) - ] - heroField = Out.Field Nothing (Out.NamedObjectType heroObject) - $ HashMap.singleton "episode" - $ In.Argument Nothing (In.NamedEnumType episodeEnum) Nothing - heroFieldResolver = ValueResolver heroField hero - humanField = Out.Field Nothing (Out.NamedObjectType heroObject) - $ HashMap.singleton "id" - $ In.Argument Nothing (In.NonNullScalarType string) Nothing - humanFieldResolver = ValueResolver humanField human - droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty - droidFieldResolver = ValueResolver droidField droid - -heroObject :: Out.ObjectType (Either SomeException) -heroObject = Out.ObjectType "Human" Nothing [characterType] $ HashMap.fromList - [ ("id", idFieldType) - , ("name", nameFieldType) - , ("friends", friendsFieldResolver) - , ("appearsIn", appearsInFieldResolver) - , ("homePlanet", homePlanetFieldType) - , ("secretBackstory", secretBackstoryFieldResolver) - , ("__typename", typenameFieldResolver) - ] - where - homePlanetFieldType - = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty) - $ defaultResolver "homePlanet" - -droidObject :: Out.ObjectType (Either SomeException) -droidObject = Out.ObjectType "Droid" Nothing [characterType] $ HashMap.fromList - [ ("id", idFieldType) - , ("name", nameFieldType) - , ("friends", friendsFieldResolver) - , ("appearsIn", appearsInFieldResolver) - , ("primaryFunction", primaryFunctionFieldType) - , ("secretBackstory", secretBackstoryFieldResolver) - , ("__typename", typenameFieldResolver) - ] - where - primaryFunctionFieldType - = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty) - $ defaultResolver "primaryFunction" - -typenameFieldResolver :: Resolver (Either SomeException) -typenameFieldResolver - = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty) - $ defaultResolver "__typename" - -idFieldType :: Resolver (Either SomeException) -idFieldType = ValueResolver idField $ defaultResolver "id" - -nameFieldType :: Resolver (Either SomeException) -nameFieldType = ValueResolver nameField $ defaultResolver "name" - -friendsFieldResolver :: Resolver (Either SomeException) -friendsFieldResolver = ValueResolver friendsField $ defaultResolver "friends" - -characterType :: InterfaceType (Either SomeException) -characterType = InterfaceType "Character" Nothing [] $ HashMap.fromList - [ ("id", idField) - , ("name", nameField) - , ("friends", friendsField) - , ("appearsIn", appearsInField) - , ("secretBackstory", secretBackstoryField) - ] - -idField :: Field (Either SomeException) -idField = Field Nothing (Out.NonNullScalarType id) mempty - -nameField :: Field (Either SomeException) -nameField = Field Nothing (Out.NamedScalarType string) mempty - -friendsField :: Field (Either SomeException) -friendsField = Field Nothing friendsFieldType mempty - where - friendsFieldType = Out.ListType (Out.NamedInterfaceType characterType) - -appearsInField :: Field (Either SomeException) -appearsInField = Field appearsInDescription appearsInFieldType mempty - where - appearsInDescription = Just "Which movies they appear in." - appearsInFieldType = Out.ListType $ Out.NamedEnumType episodeEnum - -secretBackstoryField :: Field (Either SomeException) -secretBackstoryField = - Out.Field Nothing (Out.NamedScalarType string) mempty - -appearsInFieldResolver :: Resolver (Either SomeException) -appearsInFieldResolver = ValueResolver appearsInField - $ defaultResolver "appearsIn" - -secretBackstoryFieldResolver :: Resolver (Either SomeException) -secretBackstoryFieldResolver = ValueResolver secretBackstoryField secretBackstory - -defaultResolver :: Text -> Resolve (Either SomeException) -defaultResolver f = do - v <- asks values - let (Object v') = v - pure $ v' HashMap.! f - -episodeEnum :: EnumType -episodeEnum = EnumType "Episode" (Just description) - $ HashMap.fromList [newHope, empire, jedi] - where - description = "One of the films in the Star Wars Trilogy" - newHope = ("NEW_HOPE", EnumValue $ Just "Released in 1977.") - empire = ("EMPIRE", EnumValue $ Just "Released in 1980.") - jedi = ("JEDI", EnumValue $ Just "Released in 1983.") - -hero :: Resolve (Either SomeException) -hero = do - episode <- argument "episode" - pure $ character $ case episode of - Enum "NEW_HOPE" -> getHero 4 - Enum "EMPIRE" -> getHero 5 - Enum "JEDI" -> getHero 6 - _ -> artoo - -human :: Resolve (Either SomeException) -human = do - id' <- argument "id" - case id' of - String i -> pure $ maybe Null character $ getHuman i >>= Just - _ -> throwM InvalidArguments - -droid :: Resolve (Either SomeException) -droid = do - id' <- argument "id" - case id' of - String i -> pure $ maybe Null character $ getDroid i >>= Just - _ -> throwM InvalidArguments - -character :: Character -> Value -character char = Object $ HashMap.fromList - [ ("id", String $ id_ char) - , ("name", String $ name_ char) - , ("friends", List $ character <$> getFriends char) - , ("appearsIn", List $ Enum <$> catMaybes (getEpisode <$> appearsIn char)) - , ("homePlanet", String $ either mempty homePlanet char) - , ("__typename", String $ typeName char) - ]