aboutsummaryrefslogtreecommitdiff
path: root/tests/Test/StarWars/Schema.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Test/StarWars/Schema.hs')
-rw-r--r--tests/Test/StarWars/Schema.hs55
1 files changed, 31 insertions, 24 deletions
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index 7b98747..cd25599 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Test.StarWars.Schema
( character
@@ -10,9 +9,12 @@ module Test.StarWars.Schema
import Control.Monad.Trans.Except (throwE)
import Control.Monad.Trans.Class (lift)
-import Control.Monad.IO.Class (MonadIO(..))
+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
@@ -20,32 +22,37 @@ import Test.StarWars.Data
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
-schema :: MonadIO m => NonEmpty (Schema.Resolver m)
-schema = hero :| [human, droid]
+schema :: HashMap Text (NonEmpty (Schema.Resolver Identity))
+schema = HashMap.singleton "Query" $ hero :| [human, droid]
-hero :: MonadIO m => Schema.Resolver m
-hero = Schema.objectA "hero" $ \case
- [] -> character artoo
- [Schema.Argument "episode" (Schema.Enum "NEWHOPE")] -> character $ getHero 4
- [Schema.Argument "episode" (Schema.Enum "EMPIRE" )] -> character $ getHero 5
- [Schema.Argument "episode" (Schema.Enum "JEDI" )] -> character $ getHero 6
- _ -> ActionT $ throwE "Invalid arguments."
+hero :: Schema.Resolver Identity
+hero = Schema.object "hero" $ do
+ episode <- argument "episode"
+ character $ case episode of
+ Schema.Enum "NEWHOPE" -> getHero 4
+ Schema.Enum "EMPIRE" -> getHero 5
+ Schema.Enum "JEDI" -> getHero 6
+ _ -> artoo
-human :: MonadIO m => Schema.Resolver m
-human = Schema.wrappedObjectA "human" $ \case
- [Schema.Argument "id" (Schema.String i)] -> do
- humanCharacter <- lift $ return $ getHuman i >>= Just
- case humanCharacter of
- Nothing -> return Type.Null
- Just e -> Type.Named <$> character e
- _ -> ActionT $ throwE "Invalid arguments."
+human :: Schema.Resolver Identity
+human = Schema.wrappedObject "human" $ do
+ id' <- argument "id"
+ case id' of
+ Schema.String i -> do
+ humanCharacter <- lift $ return $ getHuman i >>= Just
+ case humanCharacter of
+ Nothing -> return Type.Null
+ Just e -> Type.Named <$> character e
+ _ -> ActionT $ throwE "Invalid arguments."
-droid :: MonadIO m => Schema.Resolver m
-droid = Schema.objectA "droid" $ \case
- [Schema.Argument "id" (Schema.String i)] -> character =<< liftIO (getDroid i)
- _ -> ActionT $ throwE "Invalid arguments."
+droid :: Schema.Resolver Identity
+droid = Schema.object "droid" $ do
+ id' <- argument "id"
+ case id' of
+ Schema.String i -> character =<< getDroid i
+ _ -> ActionT $ throwE "Invalid arguments."
-character :: MonadIO m => Character -> ActionT m [Schema.Resolver m]
+character :: Character -> ActionT Identity [Schema.Resolver Identity]
character char = return
[ Schema.scalar "id" $ return $ id_ char
, Schema.scalar "name" $ return $ name char