Add Semigroup and Monoid instances for Description

This commit is contained in:
Eugen Wissner 2022-12-27 10:37:34 +01:00
parent 3ce6e7da46
commit a96d4e6ef3
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
5 changed files with 39 additions and 2 deletions

View File

@ -9,6 +9,7 @@ and this project adheres to
## [Unreleased] ## [Unreleased]
### Added ### Added
- Partial schema printing: schema definition encoder. - Partial schema printing: schema definition encoder.
- `Semigroup` and `Monoid` instances for `AST.Document.Description`.
## [1.1.0.0] - 2022-12-24 ## [1.1.0.0] - 2022-12-24
### Changed ### Changed

View File

@ -464,6 +464,14 @@ data SchemaExtension
newtype Description = Description (Maybe Text) newtype Description = Description (Maybe Text)
deriving (Eq, Show) deriving (Eq, Show)
instance Semigroup Description
where
Description lhs <> Description rhs = Description $ lhs <> rhs
instance Monoid Description
where
mempty = Description mempty
-- ** Types -- ** Types
-- | Type definitions describe various user-defined types. -- | Type definitions describe various user-defined types.

View File

@ -72,7 +72,8 @@ typeSystemDefinition formatter = \case
$ optempty (directives formatter) operationDirectives $ optempty (directives formatter) operationDirectives
<> "schema " <> "schema "
<> bracesList formatter operationTypeDefinition (NonEmpty.toList operationTypeDefinitions') <> bracesList formatter operationTypeDefinition (NonEmpty.toList operationTypeDefinitions')
_ -> "" -- TODO: TypeDefinition and DerictiveDefinition missing. Full.TypeDefinition typeDefinition' -> typeDefinition formatter typeDefinition'
_ -> "" -- TODO: DerictiveDefinition missing.
where where
operationTypeDefinition (Full.OperationTypeDefinition operationType' namedType') operationTypeDefinition (Full.OperationTypeDefinition operationType' namedType')
= indentLine (incrementIndent formatter) = indentLine (incrementIndent formatter)
@ -80,6 +81,20 @@ typeSystemDefinition formatter = \case
<> colon formatter <> colon formatter
<> Lazy.Text.fromStrict namedType' <> 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. -- | Converts a t'Full.ExecutableDefinition' into a string.
definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text
definition formatter x definition formatter x

View File

@ -18,3 +18,9 @@ spec = do
] ]
expected = "{ field1: 1.2, field2: null }" expected = "{ field1: 1.2, field2: null }"
in show object `shouldBe` expected 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

View File

@ -180,7 +180,7 @@ spec = do
let actual = operationType pretty Full.Mutation let actual = operationType pretty Full.Mutation
in actual `shouldBe` "mutation" in actual `shouldBe` "mutation"
describe "typeSystemDefinition" $ describe "typeSystemDefinition" $ do
it "produces a schema with an indented operation type definition" $ it "produces a schema with an indented operation type definition" $
let queryType = Full.OperationTypeDefinition Full.Query "QueryRootType" let queryType = Full.OperationTypeDefinition Full.Query "QueryRootType"
mutationType = Full.OperationTypeDefinition Full.Mutation "MutationType" mutationType = Full.OperationTypeDefinition Full.Mutation "MutationType"
@ -194,3 +194,10 @@ spec = do
|] '\n' |] '\n'
actual = typeSystemDefinition pretty definition' actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected 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