forked from OSS/graphql
Implement type instrospection tests
The main intention with this commit is to show a poor's man way to support type instrospection.
This commit is contained in:
parent
6a10e28ba8
commit
285ccb0af9
@ -1,11 +1,7 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module Test.StarWars.Data where
|
module Test.StarWars.Data where
|
||||||
|
|
||||||
#if !MIN_VERSION_base(4,8,0)
|
|
||||||
import Control.Applicative ((<$>), pure)
|
|
||||||
import Data.Monoid (mempty)
|
import Data.Monoid (mempty)
|
||||||
#endif
|
|
||||||
import Control.Applicative (Alternative, (<|>), empty, liftA2)
|
import Control.Applicative (Alternative, (<|>), empty, liftA2)
|
||||||
import Data.Maybe (catMaybes)
|
import Data.Maybe (catMaybes)
|
||||||
|
|
||||||
@ -38,8 +34,6 @@ data Droid = Droid
|
|||||||
|
|
||||||
type Character = Either Droid Human
|
type Character = Either Droid Human
|
||||||
|
|
||||||
-- I still don't think this is cumbersome enough to bring lens
|
|
||||||
|
|
||||||
id_ :: Character -> ID
|
id_ :: Character -> ID
|
||||||
id_ (Left x) = _id_ . _droidChar $ x
|
id_ (Left x) = _id_ . _droidChar $ x
|
||||||
id_ (Right x) = _id_ . _humanChar $ x
|
id_ (Right x) = _id_ . _humanChar $ x
|
||||||
@ -59,6 +53,9 @@ appearsIn (Right x) = _appearsIn . _humanChar $ x
|
|||||||
secretBackstory :: Character -> Text
|
secretBackstory :: Character -> Text
|
||||||
secretBackstory = error "secretBackstory is secret."
|
secretBackstory = error "secretBackstory is secret."
|
||||||
|
|
||||||
|
typeName :: Character -> Text
|
||||||
|
typeName = either (const "Droid") (const "Human")
|
||||||
|
|
||||||
luke :: Character
|
luke :: Character
|
||||||
luke = Right luke'
|
luke = Right luke'
|
||||||
|
|
||||||
|
@ -250,7 +250,7 @@ test = testGroup "Star Wars Query Tests"
|
|||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
$ object ["data" .= object [
|
$ object ["data" .= object [
|
||||||
"hero" .= ["__typename" .= ("Droid" :: Text), r2d2Name]
|
"hero" .= object ["__typename" .= ("Droid" :: Text), r2d2Name]
|
||||||
]]
|
]]
|
||||||
, testCase "Luke is a human" . testQuery
|
, testCase "Luke is a human" . testQuery
|
||||||
[r| query CheckTypeOfLuke {
|
[r| query CheckTypeOfLuke {
|
||||||
@ -261,7 +261,7 @@ test = testGroup "Star Wars Query Tests"
|
|||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
$ object ["data" .= object [
|
$ object ["data" .= object [
|
||||||
"hero" .= ["__typename" .= ("Human" :: Text), lukeName]
|
"hero" .= object ["__typename" .= ("Human" :: Text), lukeName]
|
||||||
]]
|
]]
|
||||||
]
|
]
|
||||||
, testGroup "Errors in resolvers"
|
, testGroup "Errors in resolvers"
|
||||||
|
@ -20,6 +20,9 @@ hero :: Alternative f => Resolver f
|
|||||||
hero = Schema.objectA "hero" $ \case
|
hero = Schema.objectA "hero" $ \case
|
||||||
[] -> character artoo
|
[] -> character artoo
|
||||||
[Argument "episode" (ValueInt n)] -> character . getHero $ fromIntegral n
|
[Argument "episode" (ValueInt n)] -> character . getHero $ fromIntegral n
|
||||||
|
[Argument "episode" (ValueEnum "NEWHOPE")] -> character $ getHero 4
|
||||||
|
[Argument "episode" (ValueEnum "EMPIRE" )] -> character $ getHero 5
|
||||||
|
[Argument "episode" (ValueEnum "JEDI" )] -> character $ getHero 6
|
||||||
_ -> empty
|
_ -> empty
|
||||||
|
|
||||||
human :: Alternative f => Resolver f
|
human :: Alternative f => Resolver f
|
||||||
@ -40,4 +43,5 @@ character char =
|
|||||||
, Schema.enum "appearsIn" . traverse getEpisode $ appearsIn char
|
, Schema.enum "appearsIn" . traverse getEpisode $ appearsIn char
|
||||||
, Schema.scalar "secretBackstory" $ secretBackstory char
|
, Schema.scalar "secretBackstory" $ secretBackstory char
|
||||||
, Schema.scalar "homePlanet" $ either mempty homePlanet char
|
, Schema.scalar "homePlanet" $ either mempty homePlanet char
|
||||||
|
, Schema.scalar "__typename" $ typeName char
|
||||||
]
|
]
|
||||||
|
Loading…
Reference in New Issue
Block a user