diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/Language/GraphQL/Execute/CoerceSpec.hs | 37 | ||||
| -rw-r--r-- | tests/Language/GraphQL/SchemaSpec.hs | 32 | ||||
| -rw-r--r-- | tests/Language/GraphQL/Type/OutSpec.hs | 7 | ||||
| -rw-r--r-- | tests/Test/DirectiveSpec.hs | 7 | ||||
| -rw-r--r-- | tests/Test/FragmentSpec.hs | 86 | ||||
| -rw-r--r-- | tests/Test/RootOperationSpec.hs | 15 | ||||
| -rw-r--r-- | tests/Test/StarWars/Data.hs | 4 | ||||
| -rw-r--r-- | tests/Test/StarWars/Schema.hs | 86 |
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) ] |
