summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2020-05-27 23:18:35 +0200
committerEugen Wissner <belka@caraus.de>2020-05-29 13:53:51 +0200
commitd12577ae717512979c7654191ca65f25fc877907 (patch)
tree17eda8d92d92ef2773c439d614f00ea0e74ea969 /tests
parentc06d0b8e95ea4b87eab69da085cb32dbd052c1f0 (diff)
downloadgraphql-d12577ae717512979c7654191ca65f25fc877907.tar.gz
Define resolvers on type fields
Returning resolvers from other resolvers isn't supported anymore. Since we have a type system now, we define the resolvers in the object type fields and pass an object with the previous result to them.
Diffstat (limited to 'tests')
-rw-r--r--tests/Language/GraphQL/Execute/CoerceSpec.hs37
-rw-r--r--tests/Language/GraphQL/SchemaSpec.hs32
-rw-r--r--tests/Language/GraphQL/Type/OutSpec.hs7
-rw-r--r--tests/Test/DirectiveSpec.hs7
-rw-r--r--tests/Test/FragmentSpec.hs86
-rw-r--r--tests/Test/RootOperationSpec.hs15
-rw-r--r--tests/Test/StarWars/Data.hs4
-rw-r--r--tests/Test/StarWars/Schema.hs86
8 files changed, 133 insertions, 141 deletions
diff --git a/tests/Language/GraphQL/Execute/CoerceSpec.hs b/tests/Language/GraphQL/Execute/CoerceSpec.hs
index c44c6c4..ed8fd63 100644
--- a/tests/Language/GraphQL/Execute/CoerceSpec.hs
+++ b/tests/Language/GraphQL/Execute/CoerceSpec.hs
@@ -11,9 +11,8 @@ import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (isNothing)
import Data.Scientific (scientific)
import qualified Data.Set as Set
-import Language.GraphQL.AST.Core
+import Language.GraphQL.AST.Document (Name)
import Language.GraphQL.Execute.Coerce
-import Language.GraphQL.Schema
import Language.GraphQL.Type.Definition
import qualified Language.GraphQL.Type.In as In
import Prelude hiding (id)
@@ -23,12 +22,12 @@ direction :: EnumType
direction = EnumType "Direction" Nothing
$ Set.fromList ["NORTH", "EAST", "SOUTH", "WEST"]
-coerceInputLiteral :: In.Type -> In.Value -> Maybe Subs
+coerceInputLiteral :: In.Type -> Value -> Maybe Subs
coerceInputLiteral input value = coerceInputLiterals
(HashMap.singleton "variableName" input)
(HashMap.singleton "variableName" value)
-lookupActual :: Maybe (HashMap Name In.Value) -> Maybe In.Value
+lookupActual :: Maybe (HashMap Name Value) -> Maybe Value
lookupActual = (HashMap.lookup "variableName" =<<)
singletonInputObject :: In.Type
@@ -42,22 +41,22 @@ spec :: Spec
spec = do
describe "ToGraphQL Aeson" $ do
it "coerces strings" $
- let expected = Just (In.String "asdf")
+ let expected = Just (String "asdf")
actual = coerceVariableValue
(In.NamedScalarType string) (Aeson.String "asdf")
in actual `shouldBe` expected
it "coerces non-null strings" $
- let expected = Just (In.String "asdf")
+ let expected = Just (String "asdf")
actual = coerceVariableValue
(In.NonNullScalarType string) (Aeson.String "asdf")
in actual `shouldBe` expected
it "coerces booleans" $
- let expected = Just (In.Boolean True)
+ let expected = Just (Boolean True)
actual = coerceVariableValue
(In.NamedScalarType boolean) (Aeson.Bool True)
in actual `shouldBe` expected
it "coerces zero to an integer" $
- let expected = Just (In.Int 0)
+ let expected = Just (Int 0)
actual = coerceVariableValue
(In.NamedScalarType int) (Aeson.Number 0)
in actual `shouldBe` expected
@@ -66,24 +65,24 @@ spec = do
(In.NamedScalarType int) (Aeson.Number $ scientific 14 (-1))
in actual `shouldSatisfy` isNothing
it "coerces float numbers" $
- let expected = Just (In.Float 1.4)
+ let expected = Just (Float 1.4)
actual = coerceVariableValue
(In.NamedScalarType float) (Aeson.Number $ scientific 14 (-1))
in actual `shouldBe` expected
it "coerces IDs" $
- let expected = Just (In.String "1234")
+ let expected = Just (String "1234")
actual = coerceVariableValue
(In.NamedScalarType id) (Aeson.String "1234")
in actual `shouldBe` expected
it "coerces input objects" $
let actual = coerceVariableValue singletonInputObject
$ Aeson.object ["field" .= ("asdf" :: Aeson.Value)]
- expected = Just $ In.Object $ HashMap.singleton "field" "asdf"
+ expected = Just $ Object $ HashMap.singleton "field" "asdf"
in actual `shouldBe` expected
it "skips the field if it is missing in the variables" $
let actual = coerceVariableValue
singletonInputObject Aeson.emptyObject
- expected = Just $ In.Object HashMap.empty
+ expected = Just $ Object HashMap.empty
in actual `shouldBe` expected
it "fails if input object value contains extra fields" $
let actual = coerceVariableValue singletonInputObject
@@ -95,25 +94,25 @@ spec = do
in actual `shouldSatisfy` isNothing
it "preserves null" $
let actual = coerceVariableValue (In.NamedScalarType id) Aeson.Null
- in actual `shouldBe` Just In.Null
+ in actual `shouldBe` Just Null
it "preserves list order" $
let list = Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"]
listType = (In.ListType $ In.NamedScalarType string)
actual = coerceVariableValue listType list
- expected = Just $ In.List [In.String "asdf", In.String "qwer"]
+ expected = Just $ List [String "asdf", String "qwer"]
in actual `shouldBe` expected
describe "coerceInputLiterals" $ do
it "coerces enums" $
- let expected = Just (In.Enum "NORTH")
+ let expected = Just (Enum "NORTH")
actual = coerceInputLiteral
- (In.NamedEnumType direction) (In.Enum "NORTH")
+ (In.NamedEnumType direction) (Enum "NORTH")
in lookupActual actual `shouldBe` expected
it "fails with non-existing enum value" $
let actual = coerceInputLiteral
- (In.NamedEnumType direction) (In.Enum "NORTH_EAST")
+ (In.NamedEnumType direction) (Enum "NORTH_EAST")
in actual `shouldSatisfy` isNothing
it "coerces integers to IDs" $
- let expected = Just (In.String "1234")
- actual = coerceInputLiteral (In.NamedScalarType id) (In.Int 1234)
+ let expected = Just (String "1234")
+ actual = coerceInputLiteral (In.NamedScalarType id) (Int 1234)
in lookupActual actual `shouldBe` expected
diff --git a/tests/Language/GraphQL/SchemaSpec.hs b/tests/Language/GraphQL/SchemaSpec.hs
deleted file mode 100644
index 9bc5530..0000000
--- a/tests/Language/GraphQL/SchemaSpec.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Language.GraphQL.SchemaSpec
- ( spec
- ) where
-
-import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Types as Aeson
-import qualified Data.HashMap.Strict as HashMap
-import qualified Data.Sequence as Sequence
-import Language.GraphQL.AST.Core
-import Language.GraphQL.Error
-import Language.GraphQL.Schema
-import qualified Language.GraphQL.Type.Out as Out
-import Test.Hspec (Spec, describe, it, shouldBe)
-
-spec :: Spec
-spec =
- describe "resolve" $
- it "ignores invalid __typename" $ do
- let resolver = pure $ object
- [ Resolver "field" $ pure $ Out.String "T"
- ]
- schema = HashMap.singleton "__typename" resolver
- fields = Sequence.singleton
- $ SelectionFragment
- $ Fragment "T" Sequence.empty
- expected = Aeson.object
- [ ("data" , Aeson.emptyObject)
- ]
-
- actual <- runCollectErrs (resolve schema fields)
- actual `shouldBe` expected
diff --git a/tests/Language/GraphQL/Type/OutSpec.hs b/tests/Language/GraphQL/Type/OutSpec.hs
index 48b7fa4..bdc2094 100644
--- a/tests/Language/GraphQL/Type/OutSpec.hs
+++ b/tests/Language/GraphQL/Type/OutSpec.hs
@@ -3,13 +3,12 @@ module Language.GraphQL.Type.OutSpec
( spec
) where
-import Data.Functor.Identity (Identity)
-import qualified Language.GraphQL.Type.Out as Out
+import Language.GraphQL.Type.Definition
import Test.Hspec (Spec, describe, it, shouldBe)
spec :: Spec
spec =
describe "Value" $
it "supports overloaded strings" $
- let string = "Goldstaub abblasen." :: (Out.Value Identity)
- in string `shouldBe` Out.String "Goldstaub abblasen."
+ let nietzsche = "Goldstaub abblasen." :: Value
+ in nietzsche `shouldBe` String "Goldstaub abblasen."
diff --git a/tests/Test/DirectiveSpec.hs b/tests/Test/DirectiveSpec.hs
index 67264c2..55a5277 100644
--- a/tests/Test/DirectiveSpec.hs
+++ b/tests/Test/DirectiveSpec.hs
@@ -4,7 +4,8 @@ module Test.DirectiveSpec
( spec
) where
-import Data.Aeson (Value(..), object, (.=))
+import Data.Aeson (object, (.=))
+import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap
import Language.GraphQL
import Language.GraphQL.Type.Definition
@@ -16,12 +17,12 @@ import Text.RawString.QQ (r)
experimentalResolver :: Schema IO
experimentalResolver = Schema { query = queryType, mutation = Nothing }
where
- resolver = pure $ Out.Int 5
+ resolver = pure $ Int 5
queryType = Out.ObjectType "Query" Nothing []
$ HashMap.singleton "experimentalField"
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolver
-emptyObject :: Value
+emptyObject :: Aeson.Value
emptyObject = object
[ "data" .= object []
]
diff --git a/tests/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs
index 1f765a4..36e88b1 100644
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@@ -4,11 +4,11 @@ module Test.FragmentSpec
( spec
) where
-import Data.Aeson (Value(..), object, (.=))
+import Data.Aeson (object, (.=))
+import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import Language.GraphQL
-import qualified Language.GraphQL.Schema as Schema
import Language.GraphQL.Type.Definition
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema
@@ -21,18 +21,19 @@ import Test.Hspec
)
import Text.RawString.QQ (r)
-size :: Schema.Resolver IO
-size = Schema.Resolver "size" $ pure $ Out.String "L"
+size :: (Text, Value)
+size = ("size", String "L")
-circumference :: Schema.Resolver IO
-circumference = Schema.Resolver "circumference" $ pure $ Out.Int 60
+circumference :: (Text, Value)
+circumference = ("circumference", Int 60)
-garment :: Text -> Schema.Resolver IO
-garment typeName = Schema.Resolver "garment"
- $ pure $ Schema.object
- [ if typeName == "Hat" then circumference else size
- , Schema.Resolver "__typename" $ pure $ Out.String typeName
- ]
+garment :: Text -> (Text, Value)
+garment typeName =
+ ("garment", Object $ HashMap.fromList
+ [ if typeName == "Hat" then circumference else size
+ , ("__typename", String typeName)
+ ]
+ )
inlineQuery :: Text
inlineQuery = [r|{
@@ -46,38 +47,46 @@ inlineQuery = [r|{
}
}|]
-hasErrors :: Value -> Bool
-hasErrors (Object object') = HashMap.member "errors" object'
+hasErrors :: Aeson.Value -> Bool
+hasErrors (Aeson.Object object') = HashMap.member "errors" object'
hasErrors _ = True
shirtType :: Out.ObjectType IO
shirtType = Out.ObjectType "Shirt" Nothing []
- $ HashMap.singleton resolverName
- $ Out.Field Nothing (Out.NamedScalarType string) mempty resolve
- where
- (Schema.Resolver resolverName resolve) = size
+ $ HashMap.fromList
+ [ ("size", Out.Field Nothing (Out.NamedScalarType string) mempty $ pure $ snd size)
+ , ("circumference", Out.Field Nothing (Out.NamedScalarType int) mempty $ pure $ snd circumference)
+ , ("__typename", Out.Field Nothing (Out.NamedScalarType string) mempty $ pure $ String "Shirt")
+ ]
hatType :: Out.ObjectType IO
hatType = Out.ObjectType "Hat" Nothing []
- $ HashMap.singleton resolverName
- $ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
- where
- (Schema.Resolver resolverName resolve) = circumference
-
-toSchema :: Schema.Resolver IO -> Schema IO
-toSchema (Schema.Resolver resolverName resolve) = Schema
+ $ HashMap.fromList
+ [ ("size", Out.Field Nothing (Out.NamedScalarType string) mempty $ pure $ snd size)
+ , ("circumference", Out.Field Nothing (Out.NamedScalarType int) mempty $ pure $ snd circumference)
+ , ("__typename", Out.Field Nothing (Out.NamedScalarType string) mempty $ pure $ String "Hat")
+ ]
+
+toSchema :: Text -> (Text, Value) -> Schema IO
+toSchema t (_, resolve) = Schema
{ query = queryType, mutation = Nothing }
where
- unionMember = if resolverName == "Hat" then hatType else shirtType
- queryType = Out.ObjectType "Query" Nothing []
- $ HashMap.singleton resolverName
- $ Out.Field Nothing (Out.NamedObjectType unionMember) mempty resolve
+ unionMember = if t == "Hat" then hatType else shirtType
+ queryType =
+ case t of
+ "circumference" -> hatType
+ "size" -> shirtType
+ _ -> Out.ObjectType "Query" Nothing []
+ $ HashMap.fromList
+ [ ("garment", Out.Field Nothing (Out.NamedObjectType unionMember) mempty $ pure resolve)
+ , ("__typename", Out.Field Nothing (Out.NamedScalarType string) mempty $ pure $ String "Shirt")
+ ]
spec :: Spec
spec = do
describe "Inline fragment executor" $ do
it "chooses the first selection if the type matches" $ do
- actual <- graphql (toSchema $ garment "Hat") inlineQuery
+ actual <- graphql (toSchema "Hat" $ garment "Hat") inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -88,7 +97,7 @@ spec = do
in actual `shouldBe` expected
it "chooses the last selection if the type matches" $ do
- actual <- graphql (toSchema $ garment "Shirt") inlineQuery
+ actual <- graphql (toSchema "Shirt" $ garment "Shirt") inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -107,10 +116,9 @@ spec = do
}
}
}|]
- resolvers = Schema.Resolver "garment"
- $ pure $ Schema.object [circumference, size]
+ resolvers = ("garment", Object $ HashMap.fromList [circumference, size])
- actual <- graphql (toSchema resolvers) sourceQuery
+ actual <- graphql (toSchema "garment" resolvers) sourceQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -128,7 +136,7 @@ spec = do
}
}|]
- actual <- graphql (toSchema size) sourceQuery
+ actual <- graphql (toSchema "size" size) sourceQuery
actual `shouldNotSatisfy` hasErrors
describe "Fragment spread executor" $ do
@@ -143,7 +151,7 @@ spec = do
}
|]
- actual <- graphql (toSchema circumference) sourceQuery
+ actual <- graphql (toSchema "circumference" circumference) sourceQuery
let expected = object
[ "data" .= object
[ "circumference" .= (60 :: Int)
@@ -168,7 +176,7 @@ spec = do
}
|]
- actual <- graphql (toSchema $ garment "Hat") sourceQuery
+ actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -192,7 +200,7 @@ spec = do
}
|]
- actual <- graphql (toSchema circumference) sourceQuery
+ actual <- graphql (toSchema "circumference" circumference) sourceQuery
actual `shouldBe` expected
it "considers type condition" $ do
@@ -217,5 +225,5 @@ spec = do
]
]
]
- actual <- graphql (toSchema $ garment "Hat") sourceQuery
+ actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
actual `shouldBe` expected
diff --git a/tests/Test/RootOperationSpec.hs b/tests/Test/RootOperationSpec.hs
index 291b5f2..3b21788 100644
--- a/tests/Test/RootOperationSpec.hs
+++ b/tests/Test/RootOperationSpec.hs
@@ -7,7 +7,6 @@ module Test.RootOperationSpec
import Data.Aeson ((.=), object)
import qualified Data.HashMap.Strict as HashMap
import Language.GraphQL
-import qualified Language.GraphQL.Schema as Schema
import Test.Hspec (Spec, describe, it, shouldBe)
import Text.RawString.QQ (r)
import Language.GraphQL.Type.Definition
@@ -16,23 +15,21 @@ import Language.GraphQL.Type.Schema
hatType :: Out.ObjectType IO
hatType = Out.ObjectType "Hat" Nothing []
- $ HashMap.singleton resolverName
- $ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
- where
- (Schema.Resolver resolverName resolve) =
- Schema.Resolver "circumference" $ pure $ Out.Int 60
+ $ HashMap.singleton "circumference"
+ $ Out.Field Nothing (Out.NamedScalarType int) mempty
+ $ pure $ Int 60
schema :: Schema IO
schema = Schema
(Out.ObjectType "Query" Nothing [] hatField)
(Just $ Out.ObjectType "Mutation" Nothing [] incrementField)
where
- garment = pure $ Schema.object
- [ Schema.Resolver "circumference" $ pure $ Out.Int 60
+ garment = pure $ Object $ HashMap.fromList
+ [ ("circumference", Int 60)
]
incrementField = HashMap.singleton "incrementCircumference"
$ Out.Field Nothing (Out.NamedScalarType int) mempty
- $ pure $ Out.Int 61
+ $ pure $ Int 61
hatField = HashMap.singleton "garment"
$ Out.Field Nothing (Out.NamedObjectType hatType) mempty garment
diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs
index 67a74cd..bfbe836 100644
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@@ -66,8 +66,8 @@ appearsIn :: Character -> [Int]
appearsIn (Left x) = _appearsIn . _droidChar $ x
appearsIn (Right x) = _appearsIn . _humanChar $ x
-secretBackstory :: Character -> ActionT Identity Text
-secretBackstory = const $ ActionT $ throwE "secretBackstory is secret."
+secretBackstory :: ActionT Identity Text
+secretBackstory = ActionT $ throwE "secretBackstory is secret."
typeName :: Character -> Text
typeName = either (const "Droid") (const "Human")
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index e58d33b..0ab10ec 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -1,24 +1,22 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Test.StarWars.Schema
- ( character
- , droid
- , hero
- , human
- , schema
+ ( schema
) where
+import Control.Monad.Trans.Reader (asks)
import Control.Monad.Trans.Except (throwE)
import Control.Monad.Trans.Class (lift)
import Data.Functor.Identity (Identity)
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (catMaybes)
-import qualified Language.GraphQL.Schema as Schema
+import Data.Text (Text)
import Language.GraphQL.Trans
import Language.GraphQL.Type.Definition
-import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema
import Test.StarWars.Data
+import Prelude hiding (id)
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
@@ -26,50 +24,72 @@ schema :: Schema Identity
schema = Schema { query = queryType, mutation = Nothing }
where
queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
- [ ("hero", Out.Field Nothing (Out.NamedScalarType string) mempty hero)
- , ("human", Out.Field Nothing (Out.NamedScalarType string) mempty human)
- , ("droid", Out.Field Nothing (Out.NamedScalarType string) mempty droid)
+ [ ("hero", Out.Field Nothing (Out.NamedObjectType heroObject) mempty hero)
+ , ("human", Out.Field Nothing (Out.NamedObjectType heroObject) mempty human)
+ , ("droid", Out.Field Nothing (Out.NamedObjectType droidObject) mempty droid)
]
-hero :: ActionT Identity (Out.Value Identity)
+heroObject :: Out.ObjectType Identity
+heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
+ [ ("id", Out.Field Nothing (Out.NamedScalarType id) mempty (idField "id"))
+ , ("name", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "name"))
+ , ("friends", Out.Field Nothing (Out.ListType $ Out.NamedObjectType heroObject) mempty (idField "friends"))
+ , ("appearsIn", Out.Field Nothing (Out.ListType $ Out.NamedScalarType int) mempty (idField "appearsIn"))
+ , ("homePlanet", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "homePlanet"))
+ , ("secretBackstory", Out.Field Nothing (Out.NamedScalarType string) mempty (String <$> secretBackstory))
+ , ("__typename", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "__typename"))
+ ]
+
+droidObject :: Out.ObjectType Identity
+droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
+ [ ("id", Out.Field Nothing (Out.NamedScalarType id) mempty (idField "id"))
+ , ("name", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "name"))
+ , ("friends", Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty (idField "friends"))
+ , ("appearsIn", Out.Field Nothing (Out.ListType $ Out.NamedScalarType int) mempty (idField "appearsIn"))
+ , ("primaryFunction", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "primaryFunction"))
+ , ("secretBackstory", Out.Field Nothing (Out.NamedScalarType string) mempty (String <$> secretBackstory))
+ , ("__typename", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "__typename"))
+ ]
+
+idField :: Text -> ActionT Identity Value
+idField f = do
+ v <- ActionT $ lift $ asks values
+ let (Object v') = v
+ pure $ v' HashMap.! f
+
+hero :: ActionT Identity Value
hero = do
episode <- argument "episode"
pure $ character $ case episode of
- In.Enum "NEWHOPE" -> getHero 4
- In.Enum "EMPIRE" -> getHero 5
- In.Enum "JEDI" -> getHero 6
+ Enum "NEWHOPE" -> getHero 4
+ Enum "EMPIRE" -> getHero 5
+ Enum "JEDI" -> getHero 6
_ -> artoo
-human :: ActionT Identity (Out.Value Identity)
+human :: ActionT Identity Value
human = do
id' <- argument "id"
case id' of
- In.String i -> do
+ String i -> do
humanCharacter <- lift $ return $ getHuman i >>= Just
case humanCharacter of
- Nothing -> pure Out.Null
+ Nothing -> pure Null
Just e -> pure $ character e
_ -> ActionT $ throwE "Invalid arguments."
-droid :: ActionT Identity (Out.Value Identity)
+droid :: ActionT Identity Value
droid = do
id' <- argument "id"
case id' of
- In.String i -> character <$> getDroid i
+ String i -> character <$> getDroid i
_ -> ActionT $ throwE "Invalid arguments."
-character :: Character -> Out.Value Identity
-character char = Schema.object
- [ Schema.Resolver "id" $ pure $ Out.String $ id_ char
- , Schema.Resolver "name" $ pure $ Out.String $ name_ char
- , Schema.Resolver "friends"
- $ pure $ Out.List $ character <$> getFriends char
- , Schema.Resolver "appearsIn" $ pure
- $ Out.List $ Out.Enum <$> catMaybes (getEpisode <$> appearsIn char)
- , Schema.Resolver "secretBackstory" $ Out.String
- <$> secretBackstory char
- , Schema.Resolver "homePlanet" $ pure $ Out.String
- $ either mempty homePlanet char
- , Schema.Resolver "__typename" $ pure $ Out.String
- $ typeName char
+character :: Character -> Value
+character char = Object $ HashMap.fromList
+ [ ("id", String $ id_ char)
+ , ("name", String $ name_ char)
+ , ("friends", List $ character <$> getFriends char)
+ , ("appearsIn", List $ Enum <$> catMaybes (getEpisode <$> appearsIn char))
+ , ("homePlanet", String $ either mempty homePlanet char)
+ , ("__typename", String $ typeName char)
]