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:
		| @@ -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 | ||||||
|   ] |   ] | ||||||
|   | |||||||
		Reference in New Issue
	
	Block a user