diff options
Diffstat (limited to 'tests/Test/FragmentSpec.hs')
| -rw-r--r-- | tests/Test/FragmentSpec.hs | 117 |
1 files changed, 80 insertions, 37 deletions
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 |