aboutsummaryrefslogtreecommitdiff
path: root/tests/Test/StarWars
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Test/StarWars')
-rw-r--r--tests/Test/StarWars/Data.hs9
-rw-r--r--tests/Test/StarWars/Schema.hs32
2 files changed, 19 insertions, 22 deletions
diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs
index 55ff207..6a514c5 100644
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@@ -26,6 +26,7 @@ import Control.Monad.Trans.Except (throwE)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Language.GraphQL.Trans
+import Language.GraphQL.Type
-- * Data
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
@@ -190,8 +191,8 @@ getDroid' _ = empty
getFriends :: Character -> [Character]
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
-getEpisode :: Alternative f => Int -> f Text
-getEpisode 4 = pure "NEWHOPE"
-getEpisode 5 = pure "EMPIRE"
-getEpisode 6 = pure "JEDI"
+getEpisode :: Int -> Maybe (Wrapping Text)
+getEpisode 4 = pure $ Named "NEWHOPE"
+getEpisode 5 = pure $ Named "EMPIRE"
+getEpisode 6 = pure $ Named "JEDI"
getEpisode _ = empty
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index 101bbdf..f516f2a 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -11,52 +11,48 @@ module Test.StarWars.Schema
import Control.Monad.Trans.Except (throwE)
import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Class (MonadIO(..))
-import Data.List.NonEmpty (NonEmpty((:|)))
-import Language.GraphQL.Schema ( Schema
- , Resolver
- , Argument(..)
- , Value(..)
- )
+import Data.List.NonEmpty (NonEmpty(..))
+import Data.Maybe (catMaybes)
import qualified Language.GraphQL.Schema as Schema
import Language.GraphQL.Trans
import Language.GraphQL.Type
import Test.StarWars.Data
--- * Schema
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
-schema :: MonadIO m => Schema m
+schema :: MonadIO m => NonEmpty (Schema.Resolver m)
schema = hero :| [human, droid]
-hero :: MonadIO m => Resolver m
+hero :: MonadIO m => Schema.Resolver m
hero = Schema.objectA "hero" $ \case
[] -> character artoo
- [Argument "episode" (ValueEnum "NEWHOPE")] -> character $ getHero 4
- [Argument "episode" (ValueEnum "EMPIRE" )] -> character $ getHero 5
- [Argument "episode" (ValueEnum "JEDI" )] -> character $ getHero 6
+ [Schema.Argument "episode" (Schema.ValueEnum "NEWHOPE")] -> character $ getHero 4
+ [Schema.Argument "episode" (Schema.ValueEnum "EMPIRE" )] -> character $ getHero 5
+ [Schema.Argument "episode" (Schema.ValueEnum "JEDI" )] -> character $ getHero 6
_ -> ActionT $ throwE "Invalid arguments."
-human :: MonadIO m => Resolver m
+human :: MonadIO m => Schema.Resolver m
human = Schema.wrappedObjectA "human" $ \case
- [Argument "id" (ValueString i)] -> do
+ [Schema.Argument "id" (Schema.ValueString i)] -> do
humanCharacter <- lift $ return $ getHuman i >>= Just
case humanCharacter of
Nothing -> return Null
Just e -> Named <$> character e
_ -> ActionT $ throwE "Invalid arguments."
-droid :: MonadIO m => Resolver m
+droid :: MonadIO m => Schema.Resolver m
droid = Schema.objectA "droid" $ \case
- [Argument "id" (ValueString i)] -> character =<< liftIO (getDroid i)
+ [Schema.Argument "id" (Schema.ValueString i)] -> character =<< liftIO (getDroid i)
_ -> ActionT $ throwE "Invalid arguments."
-character :: MonadIO m => Character -> ActionT m [Resolver m]
+character :: MonadIO m => Character -> ActionT m [Schema.Resolver m]
character char = return
[ Schema.scalar "id" $ return $ id_ char
, Schema.scalar "name" $ return $ name char
, Schema.wrappedObject "friends"
$ traverse character $ List $ Named <$> getFriends char
- , Schema.enum "appearsIn" $ return $ foldMap getEpisode $ appearsIn char
+ , Schema.wrappedScalar "appearsIn" $ return . List
+ $ catMaybes (getEpisode <$> appearsIn char)
, Schema.scalar "secretBackstory" $ secretBackstory char
, Schema.scalar "homePlanet" $ return $ either mempty homePlanet char
, Schema.scalar "__typename" $ return $ typeName char