4b54d7d · rowtype-yoga/purescript-graphql

git.iko.soy/rowtype-yoga/purescript-graphql

Add support for inline fragments

commit4b54d7df99a58e2829b39d8a75e9acb6e71cb0d8 authorhendrikniemann <h.neverman@web.de> dateSat 8 Jul 2023, 17:22 (3 years ago) parentd40be6e

4 files changed+79−15

compare with master

unifiedsplit

spago.dhall+1 src/GraphQL/Language/Parser.purs+13−9 test/Execution.purs+44−1 test/Language/Parser/Field.purs+21−5

spago.dhall+1

@@ -13,6 +13,7 @@ You can edit this file as you like.

1313 , "console"

1414 , "control"

1515 , "datetime"

16+ , "debug"

1617 , "effect"

1718 , "either"

1819 , "enums"

src/GraphQL/Language/Parser.purs+13−9

@@ -16,7 +16,7 @@ import Data.List (List(..), toUnfoldable)

1616import Data.Maybe (Maybe(..), fromMaybe)

1717import Data.String.CodeUnits (fromCharArray)

1818import GraphQL.Language.AST as AST

19−import StringParser (Parser, try, fail)

19+import StringParser (Parser, fail, try)

2020import StringParser.CodePoints (regex, string)

2121import StringParser.CodeUnits (char, noneOf)

2222import StringParser.Combinators (between, many, optionMaybe)

@@ -80,14 +80,14 @@ operationDefinition = do

8080

8181fragmentDefinition :: Parser AST.DefinitionNode

8282fragmentDefinition = do

83− n <- token "fragment" *> whiteSpace *> name <* whiteSpace

84− tn <- token "on" *> whiteSpace *> name <* whiteSpace

83+ n <- token "fragment" *> name

84+ typeCondition <- token "on" *> simpleNamedType <* whiteSpace

8585 s <- selectionSet <* whiteSpace

8686 pure $ AST.FragmentDefinitionNode

8787 { directives: mempty

8888 , name: n

8989 , selectionSet: s

90− , typeCondition: AST.SimpleNamedTypeNode { name: tn }

90+ , typeCondition

9191 }

9292

9393variableDefinition :: Parser AST.VariableDefinitionNode

@@ -116,16 +116,20 @@ selectionSet =

116116 braces $ AST.SelectionSetNode <<< {selections: _} <$> many (defer \_ -> selection)

117117

118118selection :: Parser AST.SelectionNode

119−selection =

120− try (whiteSpace *> defer \_ -> field <* whiteSpace)

121− <|> try (fragmentSpread <* whiteSpace)

122− <|> (whiteSpace *> inlineFragment <* whiteSpace)

119+selection = between whiteSpace whiteSpace $ try (defer \_ -> field) <|> try inlineFragment <|> fragmentSpread

123120 where

124121 fragmentSpread :: Parser AST.SelectionNode

125122 fragmentSpread = AST.FragmentSpreadNode <<< {name: _, directives: Nil } <$> (token "..." *> name)

126123

127124 inlineFragment :: Parser AST.SelectionNode

128− inlineFragment = fail "Inline Fragments not yet supported"

125+ inlineFragment = do

126+ typeCondition <- token "..." *> token "on" *> simpleNamedType <* whiteSpace

127+ s <- selectionSet <* whiteSpace

128+ pure $ AST.InlineFragmentNode

129+ { typeCondition

130+ , directives: mempty

131+ , selectionSet: s

132+ }

129133

130134 field :: Parser AST.SelectionNode

131135 field = do

test/Execution.purs+44−1

@@ -13,7 +13,8 @@ import Data.Map as Map

1313import Data.Maybe (Maybe(..), fromMaybe)

1414import Data.Newtype (class Newtype, unwrap)

1515import Data.String (trim)

16−import Effect.Aff (Aff, Error, throwError, error)

16+import Data.Variant (Variant, inj)

17+import Effect.Aff (Aff, Error, error, throwError)

1718import GraphQL ((!!>), (!#>), (!>), (.>), (:>), (?>))

1819import GraphQL as GQL

1920import Test.Spec (Spec, describe, it)

@@ -82,6 +83,32 @@ queryType =

8283 !> (\{ on: onArg } _ -> pure $ not onArg)

8384 :> GQL.nullableField "fail" GQL.boolean

8485 !!> (\_ -> throwError $ error "Always fails at runtime.")

86+ :> GQL.field "unionField" exampleUnionType

87+ ?> GQL.arg GQL.string (Proxy :: _ "type")

88+ !> resolveUnion

89+

90+

91+resolveUnion :: { "type" :: String } -> String -> (Either Error) ExampleVariant

92+resolveUnion args _ = case args.type of

93+ "user" -> pure $ inj (Proxy :: _ "user") $ User { id: "user1", name: "Hendrik", age: 25, level: NormalUser }

94+ "test" -> pure $ inj (Proxy :: _ "test") "test"

95+ _ -> throwError $ error "Unknown type"

96+

97+

98+type ExampleVariant = Variant (user :: User, test :: String)

99+

100+

101+exampleUnionType :: GQL.UnionType (Either Error) ExampleVariant

102+exampleUnionType = GQL.union "ExampleUnion" { user: userType, test: testType }

103+

104+

105+testType :: GQL.ObjectType (Either Error) String

106+testType =

107+ GQL.objectType "Test"

108+ .> "A test type"

109+ :> GQL.field "test" GQL.string

110+ !#> const "test"

111+

85112

86113

87114userType :: GQL.ObjectType (Either Error) User

@@ -209,6 +236,22 @@ executionSpec =

209236 res <- GQL.graphql testSchema query (Map.insert "arg" Json.jsonNull Map.empty) Nothing ""

210237 stringify res `shouldEqual` """{"data":{"reflectStringOptional":"default"}}"""

211238

239+ it "returns the right type name on union types" do

240+ testQuery

241+ """{ unionField(type: "user") { __typename } }"""

242+ """{"data":{"unionField":{"__typename":"User"}}}"""

243+ testQuery

244+ """{ unionField(type: "test") { __typename } }"""

245+ """{"data":{"unionField":{"__typename":"Test"}}}"""

246+

247+ it "resolves union type data correctly" do

248+ testQuery

249+ """{ unionField(type: "user") { ... on User { id } } }"""

250+ """{"data":{"unionField":{"id":"user1"}}}"""

251+ testQuery

252+ """{ unionField(type: "test") { ... on Test { test } } }"""

253+ """{"data":{"unionField":{"test":"test"}}}"""

254+

212255

213256introspectionSpec :: Spec Unit

214257introspectionSpec =

test/Language/Parser/Field.purs+21−5

@@ -3,13 +3,13 @@ module Test.GraphQL.Language.Parser.Field where

33import Prelude

55import Data.Either (Either(..))

6−import Data.List (List(..))

6+import Data.List (List(..), singleton)

77import Data.Maybe (Maybe(..))

8−import GraphQL.Language.AST (ArgumentNode(..), DirectiveNode, NameNode(..), SelectionNode(..), SelectionSetNode, ValueNode(..))

8+import GraphQL.Language.AST (ArgumentNode(..), DirectiveNode, NameNode(..), SelectionNode(..), SelectionSetNode(..), SimpleNamedTypeNode(..), ValueNode(..))

99import GraphQL.Language.Parser (selection)

10+import StringParser (runParser)

1011import Test.Spec (Spec, describe, it)

1112import Test.Spec.Assertions (shouldEqual)

12−import StringParser (runParser)

1313

1414baseField ::

1515 { alias :: Maybe NameNode

@@ -27,14 +27,16 @@ baseField =

2727 }

2828

2929fieldSpec :: Spec Unit

30−fieldSpec =

30+fieldSpec = do

3131 describe "SelectionNode" do

3232 it "parses a simple field selection" $

3333 runParser selection " hello " `shouldEqual` Right (FieldNode baseField)

34+

3435 it "parses a field with an alias" $

3536 runParser selection " alias: hello "

3637 `shouldEqual`

3738 Right (FieldNode (baseField { alias = Just (NameNode { value: "alias" })}))

39+

3840 it "parses a field with arguments" do

3941 let args =

4042 (Cons

@@ -46,4 +48,18 @@ fieldSpec =

4648 )

4749 runParser selection "hello(arg1: 1, arg2: null)"

4850 `shouldEqual`

49− Right (FieldNode (baseField { arguments = args }))

51+ Right (FieldNode (baseField { arguments = args }))

52+

53+ it "parses a simple fragment spread" do

54+ runParser selection "...hello" `shouldEqual` Right (FragmentSpreadNode { name: NameNode { value: "hello" }, directives: Nil })

55+ runParser selection "...Hello" `shouldEqual` Right (FragmentSpreadNode { name: NameNode { value: "Hello" }, directives: Nil })

56+

57+ it "parses an inline fragment spread" do

58+ let result = runParser selection "...on Test { hello }"

59+ let expected = Right $

60+ InlineFragmentNode

61+ { typeCondition: SimpleNamedTypeNode { name: NameNode { value: "Test" } }

62+ , directives: Nil

63+ , selectionSet: SelectionSetNode { selections: singleton (FieldNode baseField) }

64+ }

65+ result `shouldEqual` expected