diff --git a/CHANGELOG.md b/CHANGELOG.md index b9edb8c..4f62859 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ and this project adheres to ## [Unreleased] ### Added - Partial schema printing: schema definition encoder. +- `Semigroup` and `Monoid` instances for `AST.Document.Description`. ## [1.1.0.0] - 2022-12-24 ### Changed diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index ea640df..131285d 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -464,6 +464,14 @@ data SchemaExtension newtype Description = Description (Maybe Text) deriving (Eq, Show) +instance Semigroup Description + where + Description lhs <> Description rhs = Description $ lhs <> rhs + +instance Monoid Description + where + mempty = Description mempty + -- ** Types -- | Type definitions describe various user-defined types. diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs index a58a161..d19b9e6 100644 --- a/src/Language/GraphQL/AST/Encoder.hs +++ b/src/Language/GraphQL/AST/Encoder.hs @@ -72,7 +72,8 @@ typeSystemDefinition formatter = \case $ optempty (directives formatter) operationDirectives <> "schema " <> bracesList formatter operationTypeDefinition (NonEmpty.toList operationTypeDefinitions') - _ -> "" -- TODO: TypeDefinition and DerictiveDefinition missing. + Full.TypeDefinition typeDefinition' -> typeDefinition formatter typeDefinition' + _ -> "" -- TODO: DerictiveDefinition missing. where operationTypeDefinition (Full.OperationTypeDefinition operationType' namedType') = indentLine (incrementIndent formatter) @@ -80,6 +81,20 @@ typeSystemDefinition formatter = \case <> colon formatter <> Lazy.Text.fromStrict namedType' +typeDefinition :: Formatter -> Full.TypeDefinition -> Lazy.Text.Text +typeDefinition formatter = \case + Full.ScalarTypeDefinition description' name' directives' + -> optempty (description formatter) description' + <> "scalar " + <> Lazy.Text.fromStrict name' + <> optempty (directives formatter) directives' + _typeDefinition' -> "" -- TODO: Types missing. + +description :: Formatter -> Full.Description -> Lazy.Text.Text +description _formatter (Full.Description Nothing) = "" +description formatter (Full.Description (Just description')) = + stringValue formatter description' + -- | Converts a t'Full.ExecutableDefinition' into a string. definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text definition formatter x diff --git a/tests/Language/GraphQL/AST/DocumentSpec.hs b/tests/Language/GraphQL/AST/DocumentSpec.hs index ca13e17..d09d6b1 100644 --- a/tests/Language/GraphQL/AST/DocumentSpec.hs +++ b/tests/Language/GraphQL/AST/DocumentSpec.hs @@ -18,3 +18,9 @@ spec = do ] expected = "{ field1: 1.2, field2: null }" in show object `shouldBe` expected + + describe "Description" $ + it "keeps content when merging with no description" $ + let expected = Description $ Just "Left description" + actual = expected <> Description Nothing + in actual `shouldBe` expected diff --git a/tests/Language/GraphQL/AST/EncoderSpec.hs b/tests/Language/GraphQL/AST/EncoderSpec.hs index c654c0b..6b424d5 100644 --- a/tests/Language/GraphQL/AST/EncoderSpec.hs +++ b/tests/Language/GraphQL/AST/EncoderSpec.hs @@ -180,7 +180,7 @@ spec = do let actual = operationType pretty Full.Mutation in actual `shouldBe` "mutation" - describe "typeSystemDefinition" $ + describe "typeSystemDefinition" $ do it "produces a schema with an indented operation type definition" $ let queryType = Full.OperationTypeDefinition Full.Query "QueryRootType" mutationType = Full.OperationTypeDefinition Full.Mutation "MutationType" @@ -194,3 +194,10 @@ spec = do |] '\n' actual = typeSystemDefinition pretty definition' in actual `shouldBe` expected + + it "encodes a scalar type definition" $ + let uuidType = Full.ScalarTypeDefinition mempty "UUID" mempty + definition' = Full.TypeDefinition uuidType + expected = "scalar UUID" + actual = typeSystemDefinition pretty definition' + in actual `shouldBe` expected