Encode interfaces (2018)

This commit is contained in:
Eugen Wissner 2023-01-02 10:30:37 +01:00
parent a96d4e6ef3
commit 70dedb6911
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
2 changed files with 54 additions and 2 deletions

View File

@ -81,6 +81,31 @@ typeSystemDefinition formatter = \case
<> colon formatter <> colon formatter
<> Lazy.Text.fromStrict namedType' <> Lazy.Text.fromStrict namedType'
fieldDefinition :: Formatter -> Full.FieldDefinition -> Lazy.Text.Text
fieldDefinition formatter fieldDefinition' =
let Full.FieldDefinition description' name' arguments' type'' directives' = fieldDefinition'
in optempty (description formatter) description'
<> indentLine formatter
<> Lazy.Text.fromStrict name'
<> argumentsDefinition formatter arguments'
<> colon formatter
<> type' type''
<> optempty (directives formatter) directives'
argumentsDefinition :: Formatter -> Full.ArgumentsDefinition -> Lazy.Text.Text
argumentsDefinition formatter (Full.ArgumentsDefinition arguments') =
parensCommas formatter (argumentDefinition formatter) arguments'
argumentDefinition :: Formatter -> Full.InputValueDefinition -> Lazy.Text.Text
argumentDefinition formatter definition' =
let Full.InputValueDefinition description' name' type'' defaultValue' directives' = definition'
in optempty (description formatter) description'
<> Lazy.Text.fromStrict name'
<> colon formatter
<> type' type''
<> maybe mempty (defaultValue formatter . Full.node) defaultValue'
<> directives formatter directives'
typeDefinition :: Formatter -> Full.TypeDefinition -> Lazy.Text.Text typeDefinition :: Formatter -> Full.TypeDefinition -> Lazy.Text.Text
typeDefinition formatter = \case typeDefinition formatter = \case
Full.ScalarTypeDefinition description' name' directives' Full.ScalarTypeDefinition description' name' directives'
@ -88,7 +113,16 @@ typeDefinition formatter = \case
<> "scalar " <> "scalar "
<> Lazy.Text.fromStrict name' <> Lazy.Text.fromStrict name'
<> optempty (directives formatter) directives' <> optempty (directives formatter) directives'
Full.InterfaceTypeDefinition description' name' directives' fields'
-> optempty (description formatter) description'
<> "interface "
<> Lazy.Text.fromStrict name'
<> optempty (directives formatter) directives'
<> eitherFormat formatter " " ""
<> bracesList formatter (fieldDefinition nextFormatter) fields'
_typeDefinition' -> "" -- TODO: Types missing. _typeDefinition' -> "" -- TODO: Types missing.
where
nextFormatter = incrementIndent formatter
description :: Formatter -> Full.Description -> Lazy.Text.Text description :: Formatter -> Full.Description -> Lazy.Text.Text
description _formatter (Full.Description Nothing) = "" description _formatter (Full.Description Nothing) = ""
@ -243,8 +277,10 @@ directive formatter (Full.Directive name args _)
= "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args = "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args
directives :: Formatter -> [Full.Directive] -> Lazy.Text directives :: Formatter -> [Full.Directive] -> Lazy.Text
directives Minified = spaces (directive Minified) directives Minified values = spaces (directive Minified) values
directives formatter = Lazy.Text.cons ' ' . spaces (directive formatter) directives formatter values
| null values = ""
| otherwise = Lazy.Text.cons ' ' $ spaces (directive formatter) values
-- | Converts a 'Full.Value' into a string. -- | Converts a 'Full.Value' into a string.
value :: Formatter -> Full.Value -> Lazy.Text value :: Formatter -> Full.Value -> Lazy.Text

View File

@ -201,3 +201,19 @@ spec = do
expected = "scalar UUID" expected = "scalar UUID"
actual = typeSystemDefinition pretty definition' actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected in actual `shouldBe` expected
it "encodes an interface definition" $
let someType = Full.TypeNamed "String"
argument = Full.InputValueDefinition mempty "arg" someType Nothing mempty
arguments = Full.ArgumentsDefinition [argument]
definition' = Full.TypeDefinition
$ Full.InterfaceTypeDefinition mempty "UUID" mempty
$ pure
$ Full.FieldDefinition mempty "value" arguments someType mempty
expected = [gql|
interface UUID {
value(arg: String): String
}
|]
actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected