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:
Danny Navarro 2017-03-01 22:04:13 -03:00
parent 6a10e28ba8
commit 285ccb0af9
No known key found for this signature in database
GPG Key ID: 81E5F99780FA6A32
3 changed files with 11 additions and 10 deletions

View File

@ -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'

View File

@ -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"
@ -293,7 +293,7 @@ test = testGroup "Star Wars Query Tests"
|] |]
$ object ["data" .= object [ $ object ["data" .= object [
"hero" .= [r2d2Name, "friends" .= [ "hero" .= [r2d2Name, "friends" .= [
object [lukeName, secretBackstory] object [lukeName, secretBackstory]
, object [hanName, secretBackstory] , object [hanName, secretBackstory]
, object [leiaName, secretBackstory] , object [leiaName, secretBackstory]
]] ]]

View File

@ -19,7 +19,10 @@ schema = hero :| [human, droid]
hero :: Alternative f => Resolver f 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
] ]