Encode schema definitions

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

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 ": " ":"

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