diff options
| -rw-r--r-- | CHANGELOG.md | 5 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Encoder.hs | 54 | ||||
| -rw-r--r-- | tests/Language/GraphQL/AST/EncoderSpec.hs | 16 |
3 files changed, 63 insertions, 12 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md index 0ce7624..b9edb8c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,10 @@ The format is based on and this project adheres to [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [Unreleased] +### Added +- Partial schema printing: schema definition encoder. + ## [1.1.0.0] - 2022-12-24 ### Changed - Removed deprecated `Language.GraphQL.Error` functions: `addErr`, `addErrMsg`, @@ -490,6 +494,7 @@ and this project adheres to ### Added - Data types for the GraphQL language. +[Unreleased]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=master&rev_to=v1.1.0.0 [1.1.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.1.0.0&rev_to=v1.0.3.0 [1.0.3.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.3.0&rev_to=v1.0.2.0 [1.0.2.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.2.0&rev_to=v1.0.1.0 diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs index 54967ea..a58a161 100644 --- a/src/Language/GraphQL/AST/Encoder.hs +++ b/src/Language/GraphQL/AST/Encoder.hs @@ -14,6 +14,7 @@ module Language.GraphQL.AST.Encoder , operationType , pretty , type' + , typeSystemDefinition , value ) where @@ -54,7 +55,30 @@ document formatter defs encodeDocument = foldr executableDefinition [] defs executableDefinition (Full.ExecutableDefinition executableDefinition') acc = definition formatter executableDefinition' : acc - executableDefinition _ acc = acc + executableDefinition (Full.TypeSystemDefinition typeSystemDefinition' _location) acc = + typeSystemDefinition formatter typeSystemDefinition' : acc + executableDefinition _ acc = acc -- TODO: TypeSystemExtension missing. + +withLineBreak :: Formatter -> Lazy.Text.Text -> Lazy.Text.Text +withLineBreak formatter encodeDefinition + | Pretty _ <- formatter = Lazy.Text.snoc encodeDefinition '\n' + | Minified <- formatter = encodeDefinition + +-- | Converts a t'Full.TypeSystemDefinition' into a string. +typeSystemDefinition :: Formatter -> Full.TypeSystemDefinition -> Lazy.Text +typeSystemDefinition formatter = \case + Full.SchemaDefinition operationDirectives operationTypeDefinitions' -> + withLineBreak formatter + $ optempty (directives formatter) operationDirectives + <> "schema " + <> bracesList formatter operationTypeDefinition (NonEmpty.toList operationTypeDefinitions') + _ -> "" -- TODO: TypeDefinition and DerictiveDefinition missing. + where + operationTypeDefinition (Full.OperationTypeDefinition operationType' namedType') + = indentLine (incrementIndent formatter) + <> operationType formatter operationType' + <> colon formatter + <> Lazy.Text.fromStrict namedType' -- | Converts a t'Full.ExecutableDefinition' into a string. definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text @@ -100,7 +124,7 @@ variableDefinition formatter variableDefinition' = let Full.VariableDefinition variableName variableType defaultValue' _ = variableDefinition' in variable variableName - <> eitherFormat formatter ": " ":" + <> colon formatter <> type' variableType <> maybe mempty (defaultValue formatter . Full.node) defaultValue' @@ -127,20 +151,26 @@ indent :: (Integral a) => a -> Lazy.Text indent indentation = Lazy.Text.replicate (fromIntegral indentation) indentSymbol selection :: Formatter -> Full.Selection -> Lazy.Text -selection formatter = Lazy.Text.append indent' . encodeSelection +selection formatter = Lazy.Text.append (indentLine formatter') + . encodeSelection where encodeSelection (Full.FieldSelection fieldSelection) = - field incrementIndent fieldSelection + field formatter' fieldSelection encodeSelection (Full.InlineFragmentSelection fragmentSelection) = - inlineFragment incrementIndent fragmentSelection + inlineFragment formatter' fragmentSelection encodeSelection (Full.FragmentSpreadSelection fragmentSelection) = - fragmentSpread incrementIndent fragmentSelection - incrementIndent - | Pretty indentation <- formatter = Pretty $ indentation + 1 - | otherwise = Minified - indent' - | Pretty indentation <- formatter = indent $ indentation + 1 - | otherwise = "" + fragmentSpread formatter' fragmentSelection + formatter' = incrementIndent formatter + +indentLine :: Formatter -> Lazy.Text +indentLine formatter + | Pretty indentation <- formatter = indent indentation + | otherwise = "" + +incrementIndent :: Formatter -> Formatter +incrementIndent formatter + | Pretty indentation <- formatter = Pretty $ indentation + 1 + | otherwise = Minified colon :: Formatter -> Lazy.Text colon formatter = eitherFormat formatter ": " ":" diff --git a/tests/Language/GraphQL/AST/EncoderSpec.hs b/tests/Language/GraphQL/AST/EncoderSpec.hs index febd6fd..c654c0b 100644 --- a/tests/Language/GraphQL/AST/EncoderSpec.hs +++ b/tests/Language/GraphQL/AST/EncoderSpec.hs @@ -4,6 +4,7 @@ module Language.GraphQL.AST.EncoderSpec ( spec ) where +import Data.List.NonEmpty (NonEmpty(..)) import qualified Language.GraphQL.AST.Document as Full import Language.GraphQL.AST.Encoder import Language.GraphQL.TH @@ -178,3 +179,18 @@ spec = do it "produces lowercase mutation operation type" $ let actual = operationType pretty Full.Mutation in actual `shouldBe` "mutation" + + describe "typeSystemDefinition" $ + it "produces a schema with an indented operation type definition" $ + let queryType = Full.OperationTypeDefinition Full.Query "QueryRootType" + mutationType = Full.OperationTypeDefinition Full.Mutation "MutationType" + operations = queryType :| pure mutationType + definition' = Full.SchemaDefinition [] operations + expected = Text.Lazy.snoc [gql| + schema { + query: QueryRootType + mutation: MutationType + } + |] '\n' + actual = typeSystemDefinition pretty definition' + in actual `shouldBe` expected |