aboutsummaryrefslogtreecommitdiff
path: root/tests/Test/StarWars
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Test/StarWars')
-rw-r--r--tests/Test/StarWars/Data.hs21
-rw-r--r--tests/Test/StarWars/QuerySpec.hs17
-rw-r--r--tests/Test/StarWars/Schema.hs139
3 files changed, 121 insertions, 56 deletions
diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs
index 9466991..427371b 100644
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@@ -11,7 +11,7 @@ module Test.StarWars.Data
, getHuman
, id_
, homePlanet
- , name
+ , name_
, secretBackstory
, typeName
) where
@@ -22,7 +22,6 @@ import Control.Monad.Trans.Except (throwE)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Language.GraphQL.Trans
-import qualified Language.GraphQL.Type as Type
-- * Data
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
@@ -55,9 +54,9 @@ 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
+name_ :: Character -> Text
+name_ (Left x) = _name . _droidChar $ x
+name_ (Right x) = _name . _humanChar $ x
friends :: Character -> [ID]
friends (Left x) = _friends . _droidChar $ x
@@ -67,8 +66,8 @@ appearsIn :: Character -> [Int]
appearsIn (Left x) = _appearsIn . _droidChar $ x
appearsIn (Right x) = _appearsIn . _humanChar $ x
-secretBackstory :: Character -> ActionT Identity Text
-secretBackstory = const $ ActionT $ throwE "secretBackstory is secret."
+secretBackstory :: ActionT Identity Text
+secretBackstory = ActionT $ throwE "secretBackstory is secret."
typeName :: Character -> Text
typeName = either (const "Droid") (const "Human")
@@ -184,8 +183,8 @@ getDroid' _ = empty
getFriends :: Character -> [Character]
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
-getEpisode :: Int -> Maybe (Type.Wrapping Text)
-getEpisode 4 = pure $ Type.Named "NEWHOPE"
-getEpisode 5 = pure $ Type.Named "EMPIRE"
-getEpisode 6 = pure $ Type.Named "JEDI"
+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
index 45fcf42..cf451f8 100644
--- a/tests/Test/StarWars/QuerySpec.hs
+++ b/tests/Test/StarWars/QuerySpec.hs
@@ -10,7 +10,6 @@ import Data.Functor.Identity (Identity(..))
import qualified Data.HashMap.Strict as HashMap
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)
@@ -40,7 +39,7 @@ spec = describe "Star Wars Query Tests" $ do
id
name
friends {
- name
+ name
}
}
}
@@ -65,9 +64,9 @@ spec = describe "Star Wars Query Tests" $ do
friends {
name
appearsIn
- friends {
- name
- }
+ friends {
+ name
+ }
}
}
}
@@ -78,7 +77,7 @@ spec = describe "Star Wars Query Tests" $ do
, "friends" .= [
Aeson.object [
"name" .= ("Luke Skywalker" :: Text)
- , "appearsIn" .= ["NEWHOPE","EMPIRE","JEDI" :: Text]
+ , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
, "friends" .= [
Aeson.object [hanName]
, Aeson.object [leiaName]
@@ -88,7 +87,7 @@ spec = describe "Star Wars Query Tests" $ do
]
, Aeson.object [
hanName
- , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
+ , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
, "friends" .=
[ Aeson.object [lukeName]
, Aeson.object [leiaName]
@@ -97,7 +96,7 @@ spec = describe "Star Wars Query Tests" $ do
]
, Aeson.object [
leiaName
- , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
+ , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
, "friends" .=
[ Aeson.object [lukeName]
, Aeson.object [hanName]
@@ -360,6 +359,6 @@ spec = describe "Star Wars Query Tests" $ do
testQuery :: Text -> Aeson.Value -> Expectation
testQuery q expected = runIdentity (graphql schema q) `shouldBe` expected
-testQueryParams :: Subs -> Text -> Aeson.Value -> Expectation
+testQueryParams :: Aeson.Object -> Text -> Aeson.Value -> Expectation
testQueryParams f q expected =
runIdentity (graphqlSubs schema f q) `shouldBe` expected
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index cd25599..5fcdf3e 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -1,66 +1,133 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Test.StarWars.Schema
- ( character
- , droid
- , hero
- , human
- , schema
+ ( schema
) where
+import Control.Monad.Trans.Reader (asks)
import Control.Monad.Trans.Except (throwE)
import Control.Monad.Trans.Class (lift)
import Data.Functor.Identity (Identity)
-import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
-import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (catMaybes)
import Data.Text (Text)
-import qualified Language.GraphQL.Schema as Schema
import Language.GraphQL.Trans
-import qualified Language.GraphQL.Type as Type
+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
-schema :: HashMap Text (NonEmpty (Schema.Resolver Identity))
-schema = HashMap.singleton "Query" $ hero :| [human, droid]
+schema :: Schema Identity
+schema = Schema { query = queryType, mutation = Nothing }
+ where
+ queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
+ [ ("hero", Out.Resolver heroField hero)
+ , ("human", Out.Resolver humanField human)
+ , ("droid", Out.Resolver droidField droid)
+ ]
+ heroField = Out.Field Nothing (Out.NamedObjectType heroObject)
+ $ HashMap.singleton "episode"
+ $ In.Argument Nothing (In.NamedEnumType episodeEnum) Nothing
+ humanField = Out.Field Nothing (Out.NamedObjectType heroObject)
+ $ HashMap.singleton "id"
+ $ In.Argument Nothing (In.NonNullScalarType string) Nothing
+ droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty
-hero :: Schema.Resolver Identity
-hero = Schema.object "hero" $ do
+heroObject :: Out.ObjectType Identity
+heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
+ [ ("id", Out.Resolver idFieldType (idField "id"))
+ , ("name", Out.Resolver nameFieldType (idField "name"))
+ , ("friends", Out.Resolver friendsFieldType (idField "friends"))
+ , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
+ , ("homePlanet", Out.Resolver homePlanetFieldType (idField "homePlanet"))
+ , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
+ , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
+ ]
+ where
+ homePlanetFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+
+droidObject :: Out.ObjectType Identity
+droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
+ [ ("id", Out.Resolver idFieldType (idField "id"))
+ , ("name", Out.Resolver nameFieldType (idField "name"))
+ , ("friends", Out.Resolver friendsFieldType (idField "friends"))
+ , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
+ , ("primaryFunction", Out.Resolver primaryFunctionFieldType (idField "primaryFunction"))
+ , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
+ , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
+ ]
+ where
+ primaryFunctionFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+
+idFieldType :: Out.Field Identity
+idFieldType = Out.Field Nothing (Out.NamedScalarType id) mempty
+
+nameFieldType :: Out.Field Identity
+nameFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+
+friendsFieldType :: Out.Field Identity
+friendsFieldType = Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty
+
+appearsInField :: Out.Field Identity
+appearsInField = Out.Field (Just description) fieldType mempty
+ where
+ fieldType = Out.ListType $ Out.NamedEnumType episodeEnum
+ description = "Which movies they appear in."
+
+secretBackstoryFieldType :: Out.Field Identity
+secretBackstoryFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+
+idField :: Text -> ActionT Identity Value
+idField f = do
+ v <- ActionT $ lift $ 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 :: ActionT Identity Value
+hero = do
episode <- argument "episode"
- character $ case episode of
- Schema.Enum "NEWHOPE" -> getHero 4
- Schema.Enum "EMPIRE" -> getHero 5
- Schema.Enum "JEDI" -> getHero 6
+ pure $ character $ case episode of
+ Enum "NEW_HOPE" -> getHero 4
+ Enum "EMPIRE" -> getHero 5
+ Enum "JEDI" -> getHero 6
_ -> artoo
-human :: Schema.Resolver Identity
-human = Schema.wrappedObject "human" $ do
+human :: ActionT Identity Value
+human = do
id' <- argument "id"
case id' of
- Schema.String i -> do
+ String i -> do
humanCharacter <- lift $ return $ getHuman i >>= Just
case humanCharacter of
- Nothing -> return Type.Null
- Just e -> Type.Named <$> character e
+ Nothing -> pure Null
+ Just e -> pure $ character e
_ -> ActionT $ throwE "Invalid arguments."
-droid :: Schema.Resolver Identity
-droid = Schema.object "droid" $ do
+droid :: ActionT Identity Value
+droid = do
id' <- argument "id"
case id' of
- Schema.String i -> character =<< getDroid i
+ String i -> character <$> getDroid i
_ -> ActionT $ throwE "Invalid arguments."
-character :: Character -> ActionT Identity [Schema.Resolver Identity]
-character char = return
- [ Schema.scalar "id" $ return $ id_ char
- , Schema.scalar "name" $ return $ name char
- , Schema.wrappedObject "friends"
- $ traverse character $ Type.List $ Type.Named <$> getFriends char
- , Schema.wrappedScalar "appearsIn" $ return . Type.List
- $ catMaybes (getEpisode <$> appearsIn char)
- , Schema.scalar "secretBackstory" $ secretBackstory char
- , Schema.scalar "homePlanet" $ return $ either mempty homePlanet char
- , Schema.scalar "__typename" $ return $ typeName char
+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)
]
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 10:30:31 +0000