forked from OSS/graphql
Split input/output types and values into 2 modules
This commit is contained in:
@ -23,7 +23,7 @@ direction :: EnumType
|
||||
direction = EnumType "Direction" Nothing
|
||||
$ Set.fromList ["NORTH", "EAST", "SOUTH", "WEST"]
|
||||
|
||||
coerceInputLiteral :: InputType -> In.Value -> Maybe Subs
|
||||
coerceInputLiteral :: In.Type -> In.Value -> Maybe Subs
|
||||
coerceInputLiteral input value = coerceInputLiterals
|
||||
(HashMap.singleton "variableName" input)
|
||||
(HashMap.singleton "variableName" value)
|
||||
@ -31,12 +31,12 @@ coerceInputLiteral input value = coerceInputLiterals
|
||||
lookupActual :: Maybe (HashMap Name In.Value) -> Maybe In.Value
|
||||
lookupActual = (HashMap.lookup "variableName" =<<)
|
||||
|
||||
singletonInputObject :: InputType
|
||||
singletonInputObject = ObjectInputType type'
|
||||
singletonInputObject :: In.Type
|
||||
singletonInputObject = In.NamedInputObjectType type'
|
||||
where
|
||||
type' = InputObjectType "ObjectName" Nothing inputFields
|
||||
type' = In.InputObjectType "ObjectName" Nothing inputFields
|
||||
inputFields = HashMap.singleton "field" field
|
||||
field = InputField Nothing (ScalarInputType string) Nothing
|
||||
field = In.InputField Nothing (In.NamedScalarType string) Nothing
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
@ -44,36 +44,36 @@ spec = do
|
||||
it "coerces strings" $
|
||||
let expected = Just (In.String "asdf")
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType string) (Aeson.String "asdf")
|
||||
(In.NamedScalarType string) (Aeson.String "asdf")
|
||||
in actual `shouldBe` expected
|
||||
it "coerces non-null strings" $
|
||||
let expected = Just (In.String "asdf")
|
||||
actual = coerceVariableValue
|
||||
(NonNullScalarInputType string) (Aeson.String "asdf")
|
||||
(In.NonNullScalarType string) (Aeson.String "asdf")
|
||||
in actual `shouldBe` expected
|
||||
it "coerces booleans" $
|
||||
let expected = Just (In.Boolean True)
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType boolean) (Aeson.Bool True)
|
||||
(In.NamedScalarType boolean) (Aeson.Bool True)
|
||||
in actual `shouldBe` expected
|
||||
it "coerces zero to an integer" $
|
||||
let expected = Just (In.Int 0)
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType int) (Aeson.Number 0)
|
||||
(In.NamedScalarType int) (Aeson.Number 0)
|
||||
in actual `shouldBe` expected
|
||||
it "rejects fractional if an integer is expected" $
|
||||
let actual = coerceVariableValue
|
||||
(ScalarInputType int) (Aeson.Number $ scientific 14 (-1))
|
||||
(In.NamedScalarType int) (Aeson.Number $ scientific 14 (-1))
|
||||
in actual `shouldSatisfy` isNothing
|
||||
it "coerces float numbers" $
|
||||
let expected = Just (In.Float 1.4)
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType float) (Aeson.Number $ scientific 14 (-1))
|
||||
(In.NamedScalarType float) (Aeson.Number $ scientific 14 (-1))
|
||||
in actual `shouldBe` expected
|
||||
it "coerces IDs" $
|
||||
let expected = Just (In.String "1234")
|
||||
actual = coerceVariableValue
|
||||
(ScalarInputType id) (Aeson.String "1234")
|
||||
(In.NamedScalarType id) (Aeson.String "1234")
|
||||
in actual `shouldBe` expected
|
||||
it "coerces input objects" $
|
||||
let actual = coerceVariableValue singletonInputObject
|
||||
@ -94,11 +94,11 @@ spec = do
|
||||
]
|
||||
in actual `shouldSatisfy` isNothing
|
||||
it "preserves null" $
|
||||
let actual = coerceVariableValue (ScalarInputType id) Aeson.Null
|
||||
let actual = coerceVariableValue (In.NamedScalarType id) Aeson.Null
|
||||
in actual `shouldBe` Just In.Null
|
||||
it "preserves list order" $
|
||||
let list = Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"]
|
||||
listType = (ListInputType $ ScalarInputType string)
|
||||
listType = (In.ListType $ In.NamedScalarType string)
|
||||
actual = coerceVariableValue listType list
|
||||
expected = Just $ In.List [In.String "asdf", In.String "qwer"]
|
||||
in actual `shouldBe` expected
|
||||
@ -107,13 +107,13 @@ spec = do
|
||||
it "coerces enums" $
|
||||
let expected = Just (In.Enum "NORTH")
|
||||
actual = coerceInputLiteral
|
||||
(EnumInputType direction) (In.Enum "NORTH")
|
||||
(In.NamedEnumType direction) (In.Enum "NORTH")
|
||||
in lookupActual actual `shouldBe` expected
|
||||
it "fails with non-existing enum value" $
|
||||
let actual = coerceInputLiteral
|
||||
(EnumInputType direction) (In.Enum "NORTH_EAST")
|
||||
(In.NamedEnumType direction) (In.Enum "NORTH_EAST")
|
||||
in actual `shouldSatisfy` isNothing
|
||||
it "coerces integers to IDs" $
|
||||
let expected = Just (In.String "1234")
|
||||
actual = coerceInputLiteral (ScalarInputType id) (In.Int 1234)
|
||||
actual = coerceInputLiteral (In.NamedScalarType id) (In.Int 1234)
|
||||
in lookupActual actual `shouldBe` expected
|
||||
|
@ -17,9 +17,9 @@ experimentalResolver :: Schema IO
|
||||
experimentalResolver = Schema { query = queryType, mutation = Nothing }
|
||||
where
|
||||
resolver = pure $ Out.Int 5
|
||||
queryType = ObjectType "Query" Nothing
|
||||
queryType = Out.ObjectType "Query" Nothing
|
||||
$ HashMap.singleton "experimentalField"
|
||||
$ Field Nothing (ScalarOutputType int) mempty resolver
|
||||
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolver
|
||||
|
||||
emptyObject :: Value
|
||||
emptyObject = object
|
||||
|
@ -50,17 +50,17 @@ hasErrors :: Value -> Bool
|
||||
hasErrors (Object object') = HashMap.member "errors" object'
|
||||
hasErrors _ = True
|
||||
|
||||
shirtType :: ObjectType IO
|
||||
shirtType = ObjectType "Shirt" Nothing
|
||||
shirtType :: Out.ObjectType IO
|
||||
shirtType = Out.ObjectType "Shirt" Nothing
|
||||
$ HashMap.singleton resolverName
|
||||
$ Field Nothing (ScalarOutputType string) mempty resolve
|
||||
$ Out.Field Nothing (Out.NamedScalarType string) mempty resolve
|
||||
where
|
||||
(Schema.Resolver resolverName resolve) = size
|
||||
|
||||
hatType :: ObjectType IO
|
||||
hatType = ObjectType "Hat" Nothing
|
||||
hatType :: Out.ObjectType IO
|
||||
hatType = Out.ObjectType "Hat" Nothing
|
||||
$ HashMap.singleton resolverName
|
||||
$ Field Nothing (ScalarOutputType int) mempty resolve
|
||||
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
|
||||
where
|
||||
(Schema.Resolver resolverName resolve) = circumference
|
||||
|
||||
@ -69,9 +69,9 @@ toSchema (Schema.Resolver resolverName resolve) = Schema
|
||||
{ query = queryType, mutation = Nothing }
|
||||
where
|
||||
unionMember = if resolverName == "Hat" then hatType else shirtType
|
||||
queryType = ObjectType "Query" Nothing
|
||||
queryType = Out.ObjectType "Query" Nothing
|
||||
$ HashMap.singleton resolverName
|
||||
$ Field Nothing (ObjectOutputType unionMember) mempty resolve
|
||||
$ Out.Field Nothing (Out.NamedObjectType unionMember) mempty resolve
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
|
@ -14,27 +14,27 @@ import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Language.GraphQL.Type.Schema
|
||||
|
||||
hatType :: ObjectType IO
|
||||
hatType = ObjectType "Hat" Nothing
|
||||
hatType :: Out.ObjectType IO
|
||||
hatType = Out.ObjectType "Hat" Nothing
|
||||
$ HashMap.singleton resolverName
|
||||
$ Field Nothing (ScalarOutputType int) mempty resolve
|
||||
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
|
||||
where
|
||||
(Schema.Resolver resolverName resolve) =
|
||||
Schema.Resolver "circumference" $ pure $ Out.Int 60
|
||||
|
||||
schema :: Schema IO
|
||||
schema = Schema
|
||||
(ObjectType "Query" Nothing hatField)
|
||||
(Just $ ObjectType "Mutation" Nothing incrementField)
|
||||
(Out.ObjectType "Query" Nothing hatField)
|
||||
(Just $ Out.ObjectType "Mutation" Nothing incrementField)
|
||||
where
|
||||
garment = pure $ Schema.object
|
||||
[ Schema.Resolver "circumference" $ pure $ Out.Int 60
|
||||
]
|
||||
incrementField = HashMap.singleton "incrementCircumference"
|
||||
$ Field Nothing (ScalarOutputType int) mempty
|
||||
$ Out.Field Nothing (Out.NamedScalarType int) mempty
|
||||
$ pure $ Out.Int 61
|
||||
hatField = HashMap.singleton "garment"
|
||||
$ Field Nothing (ObjectOutputType hatType) mempty garment
|
||||
$ Out.Field Nothing (Out.NamedObjectType hatType) mempty garment
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
|
@ -184,7 +184,7 @@ getFriends :: Character -> [Character]
|
||||
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
|
||||
|
||||
getEpisode :: Int -> Maybe Text
|
||||
getEpisode 4 = pure $ "NEWHOPE"
|
||||
getEpisode 5 = pure $ "EMPIRE"
|
||||
getEpisode 6 = pure $ "JEDI"
|
||||
getEpisode 4 = pure "NEWHOPE"
|
||||
getEpisode 5 = pure "EMPIRE"
|
||||
getEpisode 6 = pure "JEDI"
|
||||
getEpisode _ = empty
|
||||
|
@ -25,10 +25,10 @@ import Test.StarWars.Data
|
||||
schema :: Schema Identity
|
||||
schema = Schema { query = queryType, mutation = Nothing }
|
||||
where
|
||||
queryType = ObjectType "Query" Nothing $ HashMap.fromList
|
||||
[ ("hero", Field Nothing (ScalarOutputType string) mempty hero)
|
||||
, ("human", Field Nothing (ScalarOutputType string) mempty human)
|
||||
, ("droid", Field Nothing (ScalarOutputType string) mempty droid)
|
||||
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 :: ActionT Identity (Out.Value Identity)
|
||||
@ -55,7 +55,7 @@ droid :: ActionT Identity (Out.Value Identity)
|
||||
droid = do
|
||||
id' <- argument "id"
|
||||
case id' of
|
||||
In.String i -> getDroid i >>= pure . character
|
||||
In.String i -> character <$> getDroid i
|
||||
_ -> ActionT $ throwE "Invalid arguments."
|
||||
|
||||
character :: Character -> Out.Value Identity
|
||||
@ -63,7 +63,7 @@ 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 $ fmap character $ getFriends char
|
||||
$ pure $ Out.List $ character <$> getFriends char
|
||||
, Schema.Resolver "appearsIn" $ pure
|
||||
$ Out.List $ Out.Enum <$> catMaybes (getEpisode <$> appearsIn char)
|
||||
, Schema.Resolver "secretBackstory" $ Out.String
|
||||
|
Reference in New Issue
Block a user