Encode schema definitions

This commit is contained in:
Eugen Wissner 2022-12-25 16:38:00 +01:00
parent a5cf0a32e8
commit 3ce6e7da46
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
3 changed files with 63 additions and 12 deletions

View File

@ -6,6 +6,10 @@ The format is based on
and this project adheres to and this project adheres to
[Haskell Package Versioning Policy](https://pvp.haskell.org/). [Haskell Package Versioning Policy](https://pvp.haskell.org/).
## [Unreleased]
### Added
- Partial schema printing: schema definition encoder.
## [1.1.0.0] - 2022-12-24 ## [1.1.0.0] - 2022-12-24
### Changed ### Changed
- Removed deprecated `Language.GraphQL.Error` functions: `addErr`, `addErrMsg`, - Removed deprecated `Language.GraphQL.Error` functions: `addErr`, `addErrMsg`,
@ -490,6 +494,7 @@ and this project adheres to
### Added ### Added
- Data types for the GraphQL language. - 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.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.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 [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

View File

@ -14,6 +14,7 @@ module Language.GraphQL.AST.Encoder
, operationType , operationType
, pretty , pretty
, type' , type'
, typeSystemDefinition
, value , value
) where ) where
@ -54,7 +55,30 @@ document formatter defs
encodeDocument = foldr executableDefinition [] defs encodeDocument = foldr executableDefinition [] defs
executableDefinition (Full.ExecutableDefinition executableDefinition') acc = executableDefinition (Full.ExecutableDefinition executableDefinition') acc =
definition formatter 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. -- | Converts a t'Full.ExecutableDefinition' into a string.
definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text
@ -100,7 +124,7 @@ variableDefinition formatter variableDefinition' =
let Full.VariableDefinition variableName variableType defaultValue' _ = let Full.VariableDefinition variableName variableType defaultValue' _ =
variableDefinition' variableDefinition'
in variable variableName in variable variableName
<> eitherFormat formatter ": " ":" <> colon formatter
<> type' variableType <> type' variableType
<> maybe mempty (defaultValue formatter . Full.node) defaultValue' <> 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 indent indentation = Lazy.Text.replicate (fromIntegral indentation) indentSymbol
selection :: Formatter -> Full.Selection -> Lazy.Text selection :: Formatter -> Full.Selection -> Lazy.Text
selection formatter = Lazy.Text.append indent' . encodeSelection selection formatter = Lazy.Text.append (indentLine formatter')
. encodeSelection
where where
encodeSelection (Full.FieldSelection fieldSelection) = encodeSelection (Full.FieldSelection fieldSelection) =
field incrementIndent fieldSelection field formatter' fieldSelection
encodeSelection (Full.InlineFragmentSelection fragmentSelection) = encodeSelection (Full.InlineFragmentSelection fragmentSelection) =
inlineFragment incrementIndent fragmentSelection inlineFragment formatter' fragmentSelection
encodeSelection (Full.FragmentSpreadSelection fragmentSelection) = encodeSelection (Full.FragmentSpreadSelection fragmentSelection) =
fragmentSpread incrementIndent fragmentSelection fragmentSpread formatter' fragmentSelection
incrementIndent 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 | Pretty indentation <- formatter = Pretty $ indentation + 1
| otherwise = Minified | otherwise = Minified
indent'
| Pretty indentation <- formatter = indent $ indentation + 1
| otherwise = ""
colon :: Formatter -> Lazy.Text colon :: Formatter -> Lazy.Text
colon formatter = eitherFormat formatter ": " ":" colon formatter = eitherFormat formatter ": " ":"

View File

@ -4,6 +4,7 @@ module Language.GraphQL.AST.EncoderSpec
( spec ( spec
) where ) where
import Data.List.NonEmpty (NonEmpty(..))
import qualified Language.GraphQL.AST.Document as Full import qualified Language.GraphQL.AST.Document as Full
import Language.GraphQL.AST.Encoder import Language.GraphQL.AST.Encoder
import Language.GraphQL.TH import Language.GraphQL.TH
@ -178,3 +179,18 @@ spec = do
it "produces lowercase mutation operation type" $ it "produces lowercase mutation operation type" $
let actual = operationType pretty Full.Mutation let actual = operationType pretty Full.Mutation
in actual `shouldBe` "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