aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/Language/GraphQL/AST/ParserSpec.hs11
-rw-r--r--tests/Language/GraphQL/Execute/CoerceSpec.hs122
-rw-r--r--tests/Language/GraphQL/ExecuteSpec.hs75
-rw-r--r--tests/Language/GraphQL/Type/OutSpec.hs14
-rw-r--r--tests/Test/DirectiveSpec.hs41
-rw-r--r--tests/Test/FragmentSpec.hs117
-rw-r--r--tests/Test/RootOperationSpec.hs68
-rw-r--r--tests/Test/StarWars/Data.hs21
-rw-r--r--tests/Test/StarWars/QuerySpec.hs17
-rw-r--r--tests/Test/StarWars/Schema.hs139
10 files changed, 511 insertions, 114 deletions
diff --git a/tests/Language/GraphQL/AST/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs
index 4fae5b1..2801b57 100644
--- a/tests/Language/GraphQL/AST/ParserSpec.hs
+++ b/tests/Language/GraphQL/AST/ParserSpec.hs
@@ -8,7 +8,7 @@ import Data.List.NonEmpty (NonEmpty(..))
import Language.GraphQL.AST.Document
import Language.GraphQL.AST.Parser
import Test.Hspec (Spec, describe, it)
-import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn)
+import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
import Text.Megaparsec (parse)
import Text.RawString.QQ (r)
@@ -141,4 +141,11 @@ spec = describe "Parser" $ do
extend type Story {
isHiddenLocally: Boolean
}
- |] \ No newline at end of file
+ |]
+
+ it "rejects variables in DefaultValue" $
+ parse document "" `shouldFailOn` [r|
+ query ($book: String = "Zarathustra", $author: String = $book) {
+ title
+ }
+ |]
diff --git a/tests/Language/GraphQL/Execute/CoerceSpec.hs b/tests/Language/GraphQL/Execute/CoerceSpec.hs
new file mode 100644
index 0000000..339c2e3
--- /dev/null
+++ b/tests/Language/GraphQL/Execute/CoerceSpec.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.GraphQL.Execute.CoerceSpec
+ ( spec
+ ) where
+
+import Data.Aeson as Aeson ((.=))
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Types as Aeson
+import qualified Data.HashMap.Strict as HashMap
+import Data.Maybe (isNothing)
+import Data.Scientific (scientific)
+import qualified Language.GraphQL.Execute.Coerce as Coerce
+import Language.GraphQL.Type
+import qualified Language.GraphQL.Type.In as In
+import Prelude hiding (id)
+import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
+
+direction :: EnumType
+direction = EnumType "Direction" Nothing $ HashMap.fromList
+ [ ("NORTH", EnumValue Nothing)
+ , ("EAST", EnumValue Nothing)
+ , ("SOUTH", EnumValue Nothing)
+ , ("WEST", EnumValue Nothing)
+ ]
+
+singletonInputObject :: In.Type
+singletonInputObject = In.NamedInputObjectType type'
+ where
+ type' = In.InputObjectType "ObjectName" Nothing inputFields
+ inputFields = HashMap.singleton "field" field
+ field = In.InputField Nothing (In.NamedScalarType string) Nothing
+
+namedIdType :: In.Type
+namedIdType = In.NamedScalarType id
+
+spec :: Spec
+spec = do
+ describe "VariableValue Aeson" $ do
+ it "coerces strings" $
+ let expected = Just (String "asdf")
+ actual = Coerce.coerceVariableValue
+ (In.NamedScalarType string) (Aeson.String "asdf")
+ in actual `shouldBe` expected
+ it "coerces non-null strings" $
+ let expected = Just (String "asdf")
+ actual = Coerce.coerceVariableValue
+ (In.NonNullScalarType string) (Aeson.String "asdf")
+ in actual `shouldBe` expected
+ it "coerces booleans" $
+ let expected = Just (Boolean True)
+ actual = Coerce.coerceVariableValue
+ (In.NamedScalarType boolean) (Aeson.Bool True)
+ in actual `shouldBe` expected
+ it "coerces zero to an integer" $
+ let expected = Just (Int 0)
+ actual = Coerce.coerceVariableValue
+ (In.NamedScalarType int) (Aeson.Number 0)
+ in actual `shouldBe` expected
+ it "rejects fractional if an integer is expected" $
+ let actual = Coerce.coerceVariableValue
+ (In.NamedScalarType int) (Aeson.Number $ scientific 14 (-1))
+ in actual `shouldSatisfy` isNothing
+ it "coerces float numbers" $
+ let expected = Just (Float 1.4)
+ actual = Coerce.coerceVariableValue
+ (In.NamedScalarType float) (Aeson.Number $ scientific 14 (-1))
+ in actual `shouldBe` expected
+ it "coerces IDs" $
+ let expected = Just (String "1234")
+ json = Aeson.String "1234"
+ actual = Coerce.coerceVariableValue namedIdType json
+ in actual `shouldBe` expected
+ it "coerces input objects" $
+ let actual = Coerce.coerceVariableValue singletonInputObject
+ $ Aeson.object ["field" .= ("asdf" :: Aeson.Value)]
+ expected = Just $ Object $ HashMap.singleton "field" "asdf"
+ in actual `shouldBe` expected
+ it "skips the field if it is missing in the variables" $
+ let actual = Coerce.coerceVariableValue
+ singletonInputObject Aeson.emptyObject
+ expected = Just $ Object HashMap.empty
+ in actual `shouldBe` expected
+ it "fails if input object value contains extra fields" $
+ let actual = Coerce.coerceVariableValue singletonInputObject
+ $ Aeson.object variableFields
+ variableFields =
+ [ "field" .= ("asdf" :: Aeson.Value)
+ , "extra" .= ("qwer" :: Aeson.Value)
+ ]
+ in actual `shouldSatisfy` isNothing
+ it "preserves null" $
+ let actual = Coerce.coerceVariableValue namedIdType Aeson.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 = Coerce.coerceVariableValue listType list
+ expected = Just $ List [String "asdf", String "qwer"]
+ in actual `shouldBe` expected
+
+ describe "coerceInputLiteral" $ do
+ it "coerces enums" $
+ let expected = Just (Enum "NORTH")
+ actual = Coerce.coerceInputLiteral
+ (In.NamedEnumType direction) (Enum "NORTH")
+ in actual `shouldBe` expected
+ it "fails with non-existing enum value" $
+ let actual = Coerce.coerceInputLiteral
+ (In.NamedEnumType direction) (Enum "NORTH_EAST")
+ in actual `shouldSatisfy` isNothing
+ it "coerces integers to IDs" $
+ let expected = Just (String "1234")
+ actual = Coerce.coerceInputLiteral namedIdType (Int 1234)
+ in actual `shouldBe` expected
+ it "coerces nulls" $ do
+ let actual = Coerce.coerceInputLiteral namedIdType Null
+ in actual `shouldBe` Just Null
+ it "wraps singleton lists" $ do
+ let expected = Just $ List [List [String "1"]]
+ embeddedType = In.ListType $ In.ListType namedIdType
+ actual = Coerce.coerceInputLiteral embeddedType (String "1")
+ in actual `shouldBe` expected
diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs
new file mode 100644
index 0000000..30568be
--- /dev/null
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.GraphQL.ExecuteSpec
+ ( spec
+ ) where
+
+import Data.Aeson ((.=))
+import qualified Data.Aeson as Aeson
+import Data.Functor.Identity (Identity(..))
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
+import Language.GraphQL.AST (Name)
+import Language.GraphQL.AST.Parser (document)
+import Language.GraphQL.Error
+import Language.GraphQL.Execute
+import Language.GraphQL.Type as Type
+import Language.GraphQL.Type.Out as Out
+import Test.Hspec (Spec, describe, it, shouldBe)
+import Text.Megaparsec (parse)
+
+schema :: Schema Identity
+schema = Schema {query = queryType, mutation = Nothing}
+
+queryType :: Out.ObjectType Identity
+queryType = Out.ObjectType "Query" Nothing []
+ $ HashMap.singleton "philosopher"
+ $ Out.Resolver philosopherField
+ $ pure
+ $ Type.Object mempty
+ where
+ philosopherField =
+ Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
+
+philosopherType :: Out.ObjectType Identity
+philosopherType = Out.ObjectType "Philosopher" Nothing []
+ $ HashMap.fromList resolvers
+ where
+ resolvers =
+ [ ("firstName", firstNameResolver)
+ , ("lastName", lastNameResolver)
+ ]
+ firstNameResolver = Out.Resolver firstNameField $ pure $ Type.String "Friedrich"
+ lastNameResolver = Out.Resolver lastNameField $ pure $ Type.String "Nietzsche"
+ firstNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+ lastNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+
+spec :: Spec
+spec =
+ describe "execute" $ do
+ it "skips unknown fields" $
+ let expected = Aeson.object
+ [ "data" .= Aeson.object
+ [ "philosopher" .= Aeson.object
+ [ "firstName" .= ("Friedrich" :: String)
+ ]
+ ]
+ ]
+ execute' = execute schema (mempty :: HashMap Name Aeson.Value)
+ actual = runIdentity
+ $ either parseError execute'
+ $ parse document "" "{ philosopher { firstName surname } }"
+ in actual `shouldBe` expected
+ it "merges selections" $
+ let expected = Aeson.object
+ [ "data" .= Aeson.object
+ [ "philosopher" .= Aeson.object
+ [ "firstName" .= ("Friedrich" :: String)
+ , "lastName" .= ("Nietzsche" :: String)
+ ]
+ ]
+ ]
+ execute' = execute schema (mempty :: HashMap Name Aeson.Value)
+ actual = runIdentity
+ $ either parseError execute'
+ $ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
+ in actual `shouldBe` expected
diff --git a/tests/Language/GraphQL/Type/OutSpec.hs b/tests/Language/GraphQL/Type/OutSpec.hs
new file mode 100644
index 0000000..eecc374
--- /dev/null
+++ b/tests/Language/GraphQL/Type/OutSpec.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.GraphQL.Type.OutSpec
+ ( spec
+ ) where
+
+import Language.GraphQL.Type
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+spec :: Spec
+spec =
+ describe "Value" $
+ it "supports overloaded strings" $
+ let nietzsche = "Goldstaub abblasen." :: Value
+ in nietzsche `shouldBe` String "Goldstaub abblasen."
diff --git a/tests/Test/DirectiveSpec.hs b/tests/Test/DirectiveSpec.hs
index 3b9da19..b147d77 100644
--- a/tests/Test/DirectiveSpec.hs
+++ b/tests/Test/DirectiveSpec.hs
@@ -4,21 +4,24 @@ module Test.DirectiveSpec
( spec
) where
-import Data.Aeson (Value, object, (.=))
-import Data.HashMap.Strict (HashMap)
+import Data.Aeson (object, (.=))
+import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap
-import Data.List.NonEmpty (NonEmpty(..))
-import Data.Text (Text)
import Language.GraphQL
-import qualified Language.GraphQL.Schema as Schema
+import Language.GraphQL.Type
+import qualified Language.GraphQL.Type.Out as Out
import Test.Hspec (Spec, describe, it, shouldBe)
import Text.RawString.QQ (r)
-experimentalResolver :: HashMap Text (NonEmpty (Schema.Resolver IO))
-experimentalResolver = HashMap.singleton "Query"
- $ Schema.scalar "experimentalField" (pure (5 :: Int)) :| []
+experimentalResolver :: Schema IO
+experimentalResolver = Schema { query = queryType, mutation = Nothing }
+ where
+ resolver = pure $ Int 5
+ queryType = Out.ObjectType "Query" Nothing []
+ $ HashMap.singleton "experimentalField"
+ $ Out.Resolver (Out.Field Nothing (Out.NamedScalarType int) mempty) resolver
-emptyObject :: Value
+emptyObject :: Aeson.Value
emptyObject = object
[ "data" .= object []
]
@@ -27,17 +30,17 @@ spec :: Spec
spec =
describe "Directive executor" $ do
it "should be able to @skip fields" $ do
- let query = [r|
+ let sourceQuery = [r|
{
experimentalField @skip(if: true)
}
|]
- actual <- graphql experimentalResolver query
+ actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
it "should not skip fields if @skip is false" $ do
- let query = [r|
+ let sourceQuery = [r|
{
experimentalField @skip(if: false)
}
@@ -48,21 +51,21 @@ spec =
]
]
- actual <- graphql experimentalResolver query
+ actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` expected
it "should skip fields if @include is false" $ do
- let query = [r|
+ let sourceQuery = [r|
{
experimentalField @include(if: false)
}
|]
- actual <- graphql experimentalResolver query
+ actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
it "should be able to @skip a fragment spread" $ do
- let query = [r|
+ let sourceQuery = [r|
{
...experimentalFragment @skip(if: true)
}
@@ -72,11 +75,11 @@ spec =
}
|]
- actual <- graphql experimentalResolver query
+ actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
it "should be able to @skip an inline fragment" $ do
- let query = [r|
+ let sourceQuery = [r|
{
... on ExperimentalType @skip(if: true) {
experimentalField
@@ -84,5 +87,5 @@ spec =
}
|]
- actual <- graphql experimentalResolver query
+ actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
diff --git a/tests/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs
index 74293a9..2924e63 100644
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@@ -4,32 +4,35 @@ 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.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import Language.GraphQL
-import qualified Language.GraphQL.Schema as Schema
-import Test.Hspec ( Spec
- , describe
- , it
- , shouldBe
- , shouldSatisfy
- , shouldNotSatisfy
- )
+import Language.GraphQL.Type
+import qualified Language.GraphQL.Type.Out as Out
+import Test.Hspec
+ ( Spec
+ , describe
+ , it
+ , shouldBe
+ , shouldNotSatisfy
+ )
import Text.RawString.QQ (r)
-size :: Schema.Resolver IO
-size = Schema.scalar "size" $ return ("L" :: Text)
+size :: (Text, Value)
+size = ("size", String "L")
-circumference :: Schema.Resolver IO
-circumference = Schema.scalar "circumference" $ return (60 :: Int)
+circumference :: (Text, Value)
+circumference = ("circumference", Int 60)
-garment :: Text -> Schema.Resolver IO
-garment typeName = Schema.object "garment" $ return
- [ if typeName == "Hat" then circumference else size
- , Schema.scalar "__typename" $ return 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|{
@@ -43,15 +46,52 @@ 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.fromList
+ [ ("size", Out.Resolver sizeFieldType $ pure $ snd size)
+ , ("circumference", Out.Resolver circumferenceFieldType $ pure $ snd circumference)
+ ]
+
+hatType :: Out.ObjectType IO
+hatType = Out.ObjectType "Hat" Nothing []
+ $ HashMap.fromList
+ [ ("size", Out.Resolver sizeFieldType $ pure $ snd size)
+ , ("circumference", Out.Resolver circumferenceFieldType $ pure $ snd circumference)
+ ]
+
+circumferenceFieldType :: Out.Field IO
+circumferenceFieldType = Out.Field Nothing (Out.NamedScalarType int) mempty
+
+sizeFieldType :: Out.Field IO
+sizeFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+
+toSchema :: Text -> (Text, Value) -> Schema IO
+toSchema t (_, resolve) = Schema
+ { query = queryType, mutation = Nothing }
+ where
+ unionMember = if t == "Hat" then hatType else shirtType
+ typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty
+ garmentField = Out.Field Nothing (Out.NamedObjectType unionMember) mempty
+ queryType =
+ case t of
+ "circumference" -> hatType
+ "size" -> shirtType
+ _ -> Out.ObjectType "Query" Nothing []
+ $ HashMap.fromList
+ [ ("garment", Out.Resolver garmentField $ pure resolve)
+ , ("__typename", Out.Resolver typeNameField $ pure $ String "Shirt")
+ ]
+
spec :: Spec
spec = do
describe "Inline fragment executor" $ do
it "chooses the first selection if the type matches" $ do
- actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) inlineQuery
+ actual <- graphql (toSchema "Hat" $ garment "Hat") inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -62,7 +102,7 @@ spec = do
in actual `shouldBe` expected
it "chooses the last selection if the type matches" $ do
- actual <- graphql (HashMap.singleton "Query" $ garment "Shirt" :| []) inlineQuery
+ actual <- graphql (toSchema "Shirt" $ garment "Shirt") inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -73,7 +113,7 @@ spec = do
in actual `shouldBe` expected
it "embeds inline fragments without type" $ do
- let query = [r|{
+ let sourceQuery = [r|{
garment {
circumference
... {
@@ -81,9 +121,9 @@ spec = do
}
}
}|]
- resolvers = Schema.object "garment" $ return [circumference, size]
+ resolvers = ("garment", Object $ HashMap.fromList [circumference, size])
- actual <- graphql (HashMap.singleton "Query" $ resolvers :| []) query
+ actual <- graphql (toSchema "garment" resolvers) sourceQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -95,18 +135,18 @@ spec = do
in actual `shouldBe` expected
it "evaluates fragments on Query" $ do
- let query = [r|{
+ let sourceQuery = [r|{
... {
size
}
}|]
- actual <- graphql (HashMap.singleton "Query" $ size :| []) query
+ actual <- graphql (toSchema "size" size) sourceQuery
actual `shouldNotSatisfy` hasErrors
describe "Fragment spread executor" $ do
it "evaluates fragment spreads" $ do
- let query = [r|
+ let sourceQuery = [r|
{
...circumferenceFragment
}
@@ -116,7 +156,7 @@ spec = do
}
|]
- actual <- graphql (HashMap.singleton "Query" $ circumference :| []) query
+ actual <- graphql (toSchema "circumference" circumference) sourceQuery
let expected = object
[ "data" .= object
[ "circumference" .= (60 :: Int)
@@ -125,7 +165,7 @@ spec = do
in actual `shouldBe` expected
it "evaluates nested fragments" $ do
- let query = [r|
+ let sourceQuery = [r|
{
garment {
...circumferenceFragment
@@ -141,7 +181,7 @@ spec = do
}
|]
- actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) query
+ actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -152,7 +192,10 @@ spec = do
in actual `shouldBe` expected
it "rejects recursive fragments" $ do
- let query = [r|
+ let expected = object
+ [ "data" .= object []
+ ]
+ sourceQuery = [r|
{
...circumferenceFragment
}
@@ -162,11 +205,11 @@ spec = do
}
|]
- actual <- graphql (HashMap.singleton "Query" $ circumference :| []) query
- actual `shouldSatisfy` hasErrors
+ actual <- graphql (toSchema "circumference" circumference) sourceQuery
+ actual `shouldBe` expected
it "considers type condition" $ do
- let query = [r|
+ let sourceQuery = [r|
{
garment {
...circumferenceFragment
@@ -187,5 +230,5 @@ spec = do
]
]
]
- actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) query
+ actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
actual `shouldBe` expected
diff --git a/tests/Test/RootOperationSpec.hs b/tests/Test/RootOperationSpec.hs
new file mode 100644
index 0000000..0e534fc
--- /dev/null
+++ b/tests/Test/RootOperationSpec.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+module Test.RootOperationSpec
+ ( spec
+ ) where
+
+import Data.Aeson ((.=), object)
+import qualified Data.HashMap.Strict as HashMap
+import Language.GraphQL
+import Test.Hspec (Spec, describe, it, shouldBe)
+import Text.RawString.QQ (r)
+import Language.GraphQL.Type
+import qualified Language.GraphQL.Type.Out as Out
+
+hatType :: Out.ObjectType IO
+hatType = Out.ObjectType "Hat" Nothing []
+ $ HashMap.singleton "circumference"
+ $ Out.Resolver (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 $ Object $ HashMap.fromList
+ [ ("circumference", Int 60)
+ ]
+ incrementField = HashMap.singleton "incrementCircumference"
+ $ Out.Resolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
+ $ pure $ Int 61
+ hatField = HashMap.singleton "garment"
+ $ Out.Resolver (Out.Field Nothing (Out.NamedObjectType hatType) mempty) garment
+
+spec :: Spec
+spec =
+ describe "Root operation type" $ do
+ it "returns objects from the root resolvers" $ do
+ let querySource = [r|
+ {
+ garment {
+ circumference
+ }
+ }
+ |]
+ expected = object
+ [ "data" .= object
+ [ "garment" .= object
+ [ "circumference" .= (60 :: Int)
+ ]
+ ]
+ ]
+ actual <- graphql schema querySource
+ actual `shouldBe` expected
+
+ it "chooses Mutation" $ do
+ let querySource = [r|
+ mutation {
+ incrementCircumference
+ }
+ |]
+ expected = object
+ [ "data" .= object
+ [ "incrementCircumference" .= (61 :: Int)
+ ]
+ ]
+ actual <- graphql schema querySource
+ actual `shouldBe` expected
diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs
index 9466991..427371b 100644
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@@ -11,7 +11,7 @@ module Test.StarWars.Data
, getHuman
, id_
, homePlanet
- , name
+ , name_
, secretBackstory
, typeName
) where
@@ -22,7 +22,6 @@ import Control.Monad.Trans.Except (throwE)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Language.GraphQL.Trans
-import qualified Language.GraphQL.Type as Type
-- * Data
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
@@ -55,9 +54,9 @@ id_ :: Character -> ID
id_ (Left x) = _id_ . _droidChar $ x
id_ (Right x) = _id_ . _humanChar $ x
-name :: Character -> Text
-name (Left x) = _name . _droidChar $ x
-name (Right x) = _name . _humanChar $ x
+name_ :: Character -> Text
+name_ (Left x) = _name . _droidChar $ x
+name_ (Right x) = _name . _humanChar $ x
friends :: Character -> [ID]
friends (Left x) = _friends . _droidChar $ x
@@ -67,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")
@@ -184,8 +183,8 @@ getDroid' _ = empty
getFriends :: Character -> [Character]
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
-getEpisode :: Int -> Maybe (Type.Wrapping Text)
-getEpisode 4 = pure $ Type.Named "NEWHOPE"
-getEpisode 5 = pure $ Type.Named "EMPIRE"
-getEpisode 6 = pure $ Type.Named "JEDI"
+getEpisode :: Int -> Maybe Text
+getEpisode 4 = pure "NEW_HOPE"
+getEpisode 5 = pure "EMPIRE"
+getEpisode 6 = pure "JEDI"
getEpisode _ = empty
diff --git a/tests/Test/StarWars/QuerySpec.hs b/tests/Test/StarWars/QuerySpec.hs
index 45fcf42..cf451f8 100644
--- a/tests/Test/StarWars/QuerySpec.hs
+++ b/tests/Test/StarWars/QuerySpec.hs
@@ -10,7 +10,6 @@ import Data.Functor.Identity (Identity(..))
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import Language.GraphQL
-import Language.GraphQL.Schema (Subs)
import Text.RawString.QQ (r)
import Test.Hspec.Expectations (Expectation, shouldBe)
import Test.Hspec (Spec, describe, it)
@@ -40,7 +39,7 @@ spec = describe "Star Wars Query Tests" $ do
id
name
friends {
- name
+ name
}
}
}
@@ -65,9 +64,9 @@ spec = describe "Star Wars Query Tests" $ do
friends {
name
appearsIn
- friends {
- name
- }
+ friends {
+ name
+ }
}
}
}
@@ -78,7 +77,7 @@ spec = describe "Star Wars Query Tests" $ do
, "friends" .= [
Aeson.object [
"name" .= ("Luke Skywalker" :: Text)
- , "appearsIn" .= ["NEWHOPE","EMPIRE","JEDI" :: Text]
+ , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
, "friends" .= [
Aeson.object [hanName]
, Aeson.object [leiaName]
@@ -88,7 +87,7 @@ spec = describe "Star Wars Query Tests" $ do
]
, Aeson.object [
hanName
- , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
+ , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
, "friends" .=
[ Aeson.object [lukeName]
, Aeson.object [leiaName]
@@ -97,7 +96,7 @@ spec = describe "Star Wars Query Tests" $ do
]
, Aeson.object [
leiaName
- , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
+ , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
, "friends" .=
[ Aeson.object [lukeName]
, Aeson.object [hanName]
@@ -360,6 +359,6 @@ spec = describe "Star Wars Query Tests" $ do
testQuery :: Text -> Aeson.Value -> Expectation
testQuery q expected = runIdentity (graphql schema q) `shouldBe` expected
-testQueryParams :: Subs -> Text -> Aeson.Value -> Expectation
+testQueryParams :: Aeson.Object -> Text -> Aeson.Value -> Expectation
testQueryParams f q expected =
runIdentity (graphqlSubs schema f q) `shouldBe` expected
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index cd25599..5fcdf3e 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -1,66 +1,133 @@
{-# 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 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
+import Language.GraphQL.Type
+import qualified Language.GraphQL.Type.In as In
+import qualified Language.GraphQL.Type.Out as Out
import Test.StarWars.Data
+import Prelude hiding (id)
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
-schema :: HashMap Text (NonEmpty (Schema.Resolver Identity))
-schema = HashMap.singleton "Query" $ hero :| [human, droid]
+schema :: Schema Identity
+schema = Schema { query = queryType, mutation = Nothing }
+ where
+ queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
+ [ ("hero", Out.Resolver heroField hero)
+ , ("human", Out.Resolver humanField human)
+ , ("droid", Out.Resolver droidField droid)
+ ]
+ heroField = Out.Field Nothing (Out.NamedObjectType heroObject)
+ $ HashMap.singleton "episode"
+ $ In.Argument Nothing (In.NamedEnumType episodeEnum) Nothing
+ humanField = Out.Field Nothing (Out.NamedObjectType heroObject)
+ $ HashMap.singleton "id"
+ $ In.Argument Nothing (In.NonNullScalarType string) Nothing
+ droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty
-hero :: Schema.Resolver Identity
-hero = Schema.object "hero" $ do
+heroObject :: Out.ObjectType Identity
+heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
+ [ ("id", Out.Resolver idFieldType (idField "id"))
+ , ("name", Out.Resolver nameFieldType (idField "name"))
+ , ("friends", Out.Resolver friendsFieldType (idField "friends"))
+ , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
+ , ("homePlanet", Out.Resolver homePlanetFieldType (idField "homePlanet"))
+ , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
+ , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
+ ]
+ where
+ homePlanetFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+
+droidObject :: Out.ObjectType Identity
+droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
+ [ ("id", Out.Resolver idFieldType (idField "id"))
+ , ("name", Out.Resolver nameFieldType (idField "name"))
+ , ("friends", Out.Resolver friendsFieldType (idField "friends"))
+ , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
+ , ("primaryFunction", Out.Resolver primaryFunctionFieldType (idField "primaryFunction"))
+ , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
+ , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
+ ]
+ where
+ primaryFunctionFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+
+idFieldType :: Out.Field Identity
+idFieldType = Out.Field Nothing (Out.NamedScalarType id) mempty
+
+nameFieldType :: Out.Field Identity
+nameFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+
+friendsFieldType :: Out.Field Identity
+friendsFieldType = Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty
+
+appearsInField :: Out.Field Identity
+appearsInField = Out.Field (Just description) fieldType mempty
+ where
+ fieldType = Out.ListType $ Out.NamedEnumType episodeEnum
+ description = "Which movies they appear in."
+
+secretBackstoryFieldType :: Out.Field Identity
+secretBackstoryFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+
+idField :: Text -> ActionT Identity Value
+idField f = do
+ v <- ActionT $ lift $ asks values
+ let (Object v') = v
+ pure $ v' HashMap.! f
+
+episodeEnum :: EnumType
+episodeEnum = EnumType "Episode" (Just description)
+ $ HashMap.fromList [newHope, empire, jedi]
+ where
+ description = "One of the films in the Star Wars Trilogy"
+ newHope = ("NEW_HOPE", EnumValue $ Just "Released in 1977.")
+ empire = ("EMPIRE", EnumValue $ Just "Released in 1980.")
+ jedi = ("JEDI", EnumValue $ Just "Released in 1983.")
+
+hero :: ActionT Identity Value
+hero = do
episode <- argument "episode"
- character $ case episode of
- Schema.Enum "NEWHOPE" -> getHero 4
- Schema.Enum "EMPIRE" -> getHero 5
- Schema.Enum "JEDI" -> getHero 6
+ pure $ character $ case episode of
+ Enum "NEW_HOPE" -> getHero 4
+ Enum "EMPIRE" -> getHero 5
+ Enum "JEDI" -> getHero 6
_ -> artoo
-human :: Schema.Resolver Identity
-human = Schema.wrappedObject "human" $ do
+human :: ActionT Identity Value
+human = do
id' <- argument "id"
case id' of
- Schema.String i -> do
+ String i -> do
humanCharacter <- lift $ return $ getHuman i >>= Just
case humanCharacter of
- Nothing -> return Type.Null
- Just e -> Type.Named <$> character e
+ Nothing -> pure Null
+ Just e -> pure $ character e
_ -> ActionT $ throwE "Invalid arguments."
-droid :: Schema.Resolver Identity
-droid = Schema.object "droid" $ do
+droid :: ActionT Identity Value
+droid = do
id' <- argument "id"
case id' of
- Schema.String i -> character =<< getDroid i
+ String i -> character <$> getDroid i
_ -> ActionT $ throwE "Invalid arguments."
-character :: Character -> ActionT Identity [Schema.Resolver Identity]
-character char = return
- [ Schema.scalar "id" $ return $ id_ char
- , Schema.scalar "name" $ return $ name char
- , Schema.wrappedObject "friends"
- $ traverse character $ Type.List $ Type.Named <$> getFriends char
- , Schema.wrappedScalar "appearsIn" $ return . Type.List
- $ catMaybes (getEpisode <$> appearsIn char)
- , Schema.scalar "secretBackstory" $ secretBackstory char
- , Schema.scalar "homePlanet" $ return $ either mempty homePlanet char
- , Schema.scalar "__typename" $ return $ 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)
]
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 08:52:54 +0000