aboutsummaryrefslogtreecommitdiff
path: root/src/Language/GraphQL/AST
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/GraphQL/AST')
-rw-r--r--src/Language/GraphQL/AST/Document.hs8
-rw-r--r--src/Language/GraphQL/AST/Encoder.hs279
2 files changed, 272 insertions, 15 deletions
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 54967ea..120fb64 100644
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@@ -14,10 +14,11 @@ module Language.GraphQL.AST.Encoder
, operationType
, pretty
, type'
+ , typeSystemDefinition
, value
) where
-import Data.Foldable (fold)
+import Data.Foldable (fold, Foldable (..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Text (Text)
import qualified Data.Text as Text
@@ -28,6 +29,7 @@ import qualified Data.Text.Lazy.Builder as Builder
import Data.Text.Lazy.Builder.Int (decimal)
import Data.Text.Lazy.Builder.RealFloat (realFloat)
import qualified Language.GraphQL.AST.Document as Full
+import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
-- | Instructs the encoder whether the GraphQL document should be minified or
-- pretty printed.
@@ -54,7 +56,246 @@ 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 (Full.TypeSystemExtension typeSystemExtension' _location) acc =
+ typeSystemExtension formatter typeSystemExtension' : acc
+
+directiveLocation :: DirectiveLocation.DirectiveLocation -> Lazy.Text
+directiveLocation = Lazy.Text.pack . show
+
+withLineBreak :: Formatter -> Lazy.Text.Text -> Lazy.Text.Text
+withLineBreak formatter encodeDefinition
+ | Pretty _ <- formatter = Lazy.Text.snoc encodeDefinition '\n'
+ | Minified <- formatter = encodeDefinition
+
+typeSystemExtension :: Formatter -> Full.TypeSystemExtension -> Lazy.Text
+typeSystemExtension formatter = \case
+ Full.SchemaExtension schemaExtension' ->
+ schemaExtension formatter schemaExtension'
+ Full.TypeExtension typeExtension' -> typeExtension formatter typeExtension'
+
+schemaExtension :: Formatter -> Full.SchemaExtension -> Lazy.Text
+schemaExtension formatter = \case
+ Full.SchemaOperationExtension operationDirectives operationTypeDefinitions' ->
+ withLineBreak formatter
+ $ "extend schema "
+ <> optempty (directives formatter) operationDirectives
+ <> bracesList formatter (operationTypeDefinition formatter) (NonEmpty.toList operationTypeDefinitions')
+ Full.SchemaDirectivesExtension operationDirectives -> "extend schema "
+ <> optempty (directives formatter) (NonEmpty.toList operationDirectives)
+
+typeExtension :: Formatter -> Full.TypeExtension -> Lazy.Text
+typeExtension formatter = \case
+ Full.ScalarTypeExtension name' directives'
+ -> "extend scalar "
+ <> Lazy.Text.fromStrict name'
+ <> directives formatter (NonEmpty.toList directives')
+ Full.ObjectTypeFieldsDefinitionExtension name' ifaces' directives' fields'
+ -> "extend type "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (" " <>) (implementsInterfaces ifaces')
+ <> optempty (directives formatter) directives'
+ <> eitherFormat formatter " " ""
+ <> bracesList formatter (fieldDefinition nextFormatter) (NonEmpty.toList fields')
+ Full.ObjectTypeDirectivesExtension name' ifaces' directives'
+ -> "extend type "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (" " <>) (implementsInterfaces ifaces')
+ <> optempty (directives formatter) (NonEmpty.toList directives')
+ Full.ObjectTypeImplementsInterfacesExtension name' ifaces'
+ -> "extend type "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (" " <>) (implementsInterfaces ifaces')
+ Full.InterfaceTypeFieldsDefinitionExtension name' directives' fields'
+ -> "extend interface "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (directives formatter) directives'
+ <> eitherFormat formatter " " ""
+ <> bracesList formatter (fieldDefinition nextFormatter) (NonEmpty.toList fields')
+ Full.InterfaceTypeDirectivesExtension name' directives'
+ -> "extend interface "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (directives formatter) (NonEmpty.toList directives')
+ Full.UnionTypeUnionMemberTypesExtension name' directives' members'
+ -> "extend union "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (directives formatter) directives'
+ <> eitherFormat formatter " " ""
+ <> unionMemberTypes formatter members'
+ Full.UnionTypeDirectivesExtension name' directives'
+ -> "extend union "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (directives formatter) (NonEmpty.toList directives')
+ Full.EnumTypeEnumValuesDefinitionExtension name' directives' members'
+ -> "extend enum "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (directives formatter) directives'
+ <> eitherFormat formatter " " ""
+ <> bracesList formatter (enumValueDefinition formatter) (NonEmpty.toList members')
+ Full.EnumTypeDirectivesExtension name' directives'
+ -> "extend enum "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (directives formatter) (NonEmpty.toList directives')
+ Full.InputObjectTypeInputFieldsDefinitionExtension name' directives' fields'
+ -> "extend input "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (directives formatter) directives'
+ <> eitherFormat formatter " " ""
+ <> bracesList formatter (inputValueDefinition nextFormatter) (NonEmpty.toList fields')
+ Full.InputObjectTypeDirectivesExtension name' directives'
+ -> "extend input "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (directives formatter) (NonEmpty.toList directives')
+ where
+ nextFormatter = incrementIndent formatter
+
+-- | Converts a t'Full.TypeSystemDefinition' into a string.
+typeSystemDefinition :: Formatter -> Full.TypeSystemDefinition -> Lazy.Text
+typeSystemDefinition formatter = \case
+ Full.SchemaDefinition operationDirectives operationTypeDefinitions' ->
+ withLineBreak formatter
+ $ "schema "
+ <> optempty (directives formatter) operationDirectives
+ <> bracesList formatter (operationTypeDefinition formatter) (NonEmpty.toList operationTypeDefinitions')
+ Full.TypeDefinition typeDefinition' -> typeDefinition formatter typeDefinition'
+ Full.DirectiveDefinition description' name' arguments' locations
+ -> description formatter description'
+ <> "@"
+ <> Lazy.Text.fromStrict name'
+ <> argumentsDefinition formatter arguments'
+ <> " on"
+ <> pipeList formatter (directiveLocation <$> locations)
+
+operationTypeDefinition :: Formatter -> Full.OperationTypeDefinition -> Lazy.Text.Text
+operationTypeDefinition formatter (Full.OperationTypeDefinition operationType' namedType')
+ = indentLine (incrementIndent formatter)
+ <> operationType formatter operationType'
+ <> colon formatter
+ <> Lazy.Text.fromStrict namedType'
+
+fieldDefinition :: Formatter -> Full.FieldDefinition -> Lazy.Text.Text
+fieldDefinition formatter fieldDefinition' =
+ let Full.FieldDefinition description' name' arguments' type'' directives' = fieldDefinition'
+ in optempty (description formatter) description'
+ <> indentLine formatter
+ <> Lazy.Text.fromStrict name'
+ <> argumentsDefinition formatter arguments'
+ <> colon formatter
+ <> type' type''
+ <> optempty (directives formatter) directives'
+
+argumentsDefinition :: Formatter -> Full.ArgumentsDefinition -> Lazy.Text.Text
+argumentsDefinition formatter (Full.ArgumentsDefinition arguments') =
+ parensCommas formatter (argumentDefinition formatter) arguments'
+
+argumentDefinition :: Formatter -> Full.InputValueDefinition -> Lazy.Text.Text
+argumentDefinition formatter definition' =
+ let Full.InputValueDefinition description' name' type'' defaultValue' directives' = definition'
+ in optempty (description formatter) description'
+ <> Lazy.Text.fromStrict name'
+ <> colon formatter
+ <> type' type''
+ <> maybe mempty (defaultValue formatter . Full.node) defaultValue'
+ <> directives formatter directives'
+
+inputValueDefinition :: Formatter -> Full.InputValueDefinition -> Lazy.Text.Text
+inputValueDefinition formatter definition' =
+ let Full.InputValueDefinition description' name' type'' defaultValue' directives' = definition'
+ in optempty (description formatter) description'
+ <> indentLine formatter
+ <> Lazy.Text.fromStrict name'
+ <> colon formatter
+ <> type' type''
+ <> maybe mempty (defaultValue formatter . Full.node) defaultValue'
+ <> directives formatter directives'
+
+typeDefinition :: Formatter -> Full.TypeDefinition -> Lazy.Text
+typeDefinition formatter = \case
+ Full.ScalarTypeDefinition description' name' directives'
+ -> optempty (description formatter) description'
+ <> "scalar "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (directives formatter) directives'
+ Full.ObjectTypeDefinition description' name' ifaces' directives' fields'
+ -> optempty (description formatter) description'
+ <> "type "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (" " <>) (implementsInterfaces ifaces')
+ <> optempty (directives formatter) directives'
+ <> eitherFormat formatter " " ""
+ <> bracesList formatter (fieldDefinition nextFormatter) fields'
+ Full.InterfaceTypeDefinition description' name' directives' fields'
+ -> optempty (description formatter) description'
+ <> "interface "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (directives formatter) directives'
+ <> eitherFormat formatter " " ""
+ <> bracesList formatter (fieldDefinition nextFormatter) fields'
+ Full.UnionTypeDefinition description' name' directives' members'
+ -> optempty (description formatter) description'
+ <> "union "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (directives formatter) directives'
+ <> eitherFormat formatter " " ""
+ <> unionMemberTypes formatter members'
+ Full.EnumTypeDefinition description' name' directives' members'
+ -> optempty (description formatter) description'
+ <> "enum "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (directives formatter) directives'
+ <> eitherFormat formatter " " ""
+ <> bracesList formatter (enumValueDefinition formatter) members'
+ Full.InputObjectTypeDefinition description' name' directives' fields'
+ -> optempty (description formatter) description'
+ <> "input "
+ <> Lazy.Text.fromStrict name'
+ <> optempty (directives formatter) directives'
+ <> eitherFormat formatter " " ""
+ <> bracesList formatter (inputValueDefinition nextFormatter) fields'
+ where
+ nextFormatter = incrementIndent formatter
+
+implementsInterfaces :: Foldable t => Full.ImplementsInterfaces t -> Lazy.Text
+implementsInterfaces (Full.ImplementsInterfaces interfaces)
+ | null interfaces = mempty
+ | otherwise = Lazy.Text.fromStrict
+ $ Text.append "implements "
+ $ Text.intercalate " & "
+ $ toList interfaces
+
+unionMemberTypes :: Foldable t => Formatter -> Full.UnionMemberTypes t -> Lazy.Text
+unionMemberTypes formatter (Full.UnionMemberTypes memberTypes)
+ | null memberTypes = mempty
+ | otherwise = Lazy.Text.append "="
+ $ pipeList formatter
+ $ Lazy.Text.fromStrict
+ <$> toList memberTypes
+
+pipeList :: Foldable t => Formatter -> t Lazy.Text -> Lazy.Text
+pipeList Minified = (" " <>) . Lazy.Text.intercalate " | " . toList
+pipeList (Pretty _) = Lazy.Text.concat
+ . fmap (("\n" <> indentSymbol <> "| ") <>)
+ . toList
+
+enumValueDefinition :: Formatter -> Full.EnumValueDefinition -> Lazy.Text
+enumValueDefinition (Pretty _) enumValue =
+ let Full.EnumValueDefinition description' name' directives' = enumValue
+ formatter = Pretty 1
+ in description formatter description'
+ <> indentLine formatter
+ <> Lazy.Text.fromStrict name'
+ <> directives formatter directives'
+enumValueDefinition Minified enumValue =
+ let Full.EnumValueDefinition description' name' directives' = enumValue
+ in description Minified description'
+ <> Lazy.Text.fromStrict name'
+ <> directives Minified directives'
+
+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
@@ -100,7 +341,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 +368,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 ": " ":"
@@ -198,8 +445,10 @@ directive formatter (Full.Directive name args _)
= "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args
directives :: Formatter -> [Full.Directive] -> Lazy.Text
-directives Minified = spaces (directive Minified)
-directives formatter = Lazy.Text.cons ' ' . spaces (directive formatter)
+directives Minified values = spaces (directive Minified) values
+directives formatter values
+ | null values = ""
+ | otherwise = Lazy.Text.cons ' ' $ spaces (directive formatter) values
-- | Converts a 'Full.Value' into a string.
value :: Formatter -> Full.Value -> Lazy.Text
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 08:51:27 +0000