596 lines
24 KiB
Haskell
596 lines
24 KiB
Haskell
{-# LANGUAGE ExplicitForAll #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE Safe #-}
|
|
|
|
-- | This module defines a minifier and a printer for the @GraphQL@ language.
|
|
module Language.GraphQL.AST.Encoder
|
|
( Formatter
|
|
, definition
|
|
, directive
|
|
, document
|
|
, minified
|
|
, operationType
|
|
, pretty
|
|
, type'
|
|
, typeSystemDefinition
|
|
, value
|
|
) where
|
|
|
|
import Data.Foldable (fold, Foldable (..))
|
|
import qualified Data.List.NonEmpty as NonEmpty
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as Text
|
|
import qualified Data.Text.Lazy as Lazy (Text)
|
|
import qualified Data.Text.Lazy as Lazy.Text
|
|
import Data.Text.Lazy.Builder (Builder)
|
|
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.
|
|
--
|
|
-- Use 'pretty' or 'minified' to construct the formatter.
|
|
data Formatter
|
|
= Minified
|
|
| Pretty !Word
|
|
|
|
-- | Constructs a formatter for pretty printing.
|
|
pretty :: Formatter
|
|
pretty = Pretty 0
|
|
|
|
-- | Constructs a formatter for minifying.
|
|
minified :: Formatter
|
|
minified = Minified
|
|
|
|
-- | Converts a Document' into a string.
|
|
document :: Formatter -> Full.Document -> Lazy.Text
|
|
document formatter defs
|
|
| Pretty _ <- formatter = Lazy.Text.intercalate "\n" encodeDocument
|
|
| Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'
|
|
where
|
|
encodeDocument = foldr executableDefinition [] defs
|
|
executableDefinition (Full.ExecutableDefinition executableDefinition') acc =
|
|
definition formatter executableDefinition' : 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
|
|
definition formatter x
|
|
| Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n'
|
|
| Minified <- formatter = encodeDefinition x
|
|
where
|
|
encodeDefinition (Full.DefinitionOperation operation)
|
|
= operationDefinition formatter operation
|
|
encodeDefinition (Full.DefinitionFragment fragment)
|
|
= fragmentDefinition formatter fragment
|
|
|
|
-- | Converts a 'Full.OperationDefinition into a string.
|
|
operationDefinition :: Formatter -> Full.OperationDefinition -> Lazy.Text
|
|
operationDefinition formatter = \case
|
|
Full.SelectionSet sels _ -> selectionSet formatter sels
|
|
Full.OperationDefinition Full.Query name vars dirs sels _ ->
|
|
"query " <> root name vars dirs sels
|
|
Full.OperationDefinition Full.Mutation name vars dirs sels _ ->
|
|
"mutation " <> root name vars dirs sels
|
|
Full.OperationDefinition Full.Subscription name vars dirs sels _ ->
|
|
"subscription " <> root name vars dirs sels
|
|
where
|
|
-- | Converts a Query or Mutation into a string.
|
|
root :: Maybe Full.Name ->
|
|
[Full.VariableDefinition] ->
|
|
[Full.Directive] ->
|
|
Full.SelectionSet ->
|
|
Lazy.Text
|
|
root name vars dirs sels
|
|
= Lazy.Text.fromStrict (fold name)
|
|
<> optempty (variableDefinitions formatter) vars
|
|
<> optempty (directives formatter) dirs
|
|
<> eitherFormat formatter " " mempty
|
|
<> selectionSet formatter sels
|
|
|
|
variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Lazy.Text
|
|
variableDefinitions formatter
|
|
= parensCommas formatter $ variableDefinition formatter
|
|
|
|
variableDefinition :: Formatter -> Full.VariableDefinition -> Lazy.Text
|
|
variableDefinition formatter variableDefinition' =
|
|
let Full.VariableDefinition variableName variableType defaultValue' _ =
|
|
variableDefinition'
|
|
in variable variableName
|
|
<> colon formatter
|
|
<> type' variableType
|
|
<> maybe mempty (defaultValue formatter . Full.node) defaultValue'
|
|
|
|
defaultValue :: Formatter -> Full.ConstValue -> Lazy.Text
|
|
defaultValue formatter val
|
|
= eitherFormat formatter " = " "="
|
|
<> value formatter (fromConstValue val)
|
|
|
|
variable :: Full.Name -> Lazy.Text
|
|
variable var = "$" <> Lazy.Text.fromStrict var
|
|
|
|
selectionSet :: Formatter -> Full.SelectionSet -> Lazy.Text
|
|
selectionSet formatter
|
|
= bracesList formatter (selection formatter)
|
|
. NonEmpty.toList
|
|
|
|
selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text
|
|
selectionSetOpt formatter = bracesList formatter $ selection formatter
|
|
|
|
indentSymbol :: Lazy.Text
|
|
indentSymbol = " "
|
|
|
|
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 (indentLine formatter')
|
|
. encodeSelection
|
|
where
|
|
encodeSelection (Full.FieldSelection fieldSelection) =
|
|
field formatter' fieldSelection
|
|
encodeSelection (Full.InlineFragmentSelection fragmentSelection) =
|
|
inlineFragment formatter' fragmentSelection
|
|
encodeSelection (Full.FragmentSpreadSelection fragmentSelection) =
|
|
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 ": " ":"
|
|
|
|
-- | Converts Field into a string.
|
|
field :: Formatter -> Full.Field -> Lazy.Text
|
|
field formatter (Full.Field alias name args dirs set _)
|
|
= optempty prependAlias (fold alias)
|
|
<> Lazy.Text.fromStrict name
|
|
<> optempty (arguments formatter) args
|
|
<> optempty (directives formatter) dirs
|
|
<> optempty selectionSetOpt' set
|
|
where
|
|
prependAlias aliasName = Lazy.Text.fromStrict aliasName <> colon formatter
|
|
selectionSetOpt' = (eitherFormat formatter " " "" <>)
|
|
. selectionSetOpt formatter
|
|
|
|
arguments :: Formatter -> [Full.Argument] -> Lazy.Text
|
|
arguments formatter = parensCommas formatter $ argument formatter
|
|
|
|
argument :: Formatter -> Full.Argument -> Lazy.Text
|
|
argument formatter (Full.Argument name value' _)
|
|
= Lazy.Text.fromStrict name
|
|
<> colon formatter
|
|
<> value formatter (Full.node value')
|
|
|
|
-- * Fragments
|
|
|
|
fragmentSpread :: Formatter -> Full.FragmentSpread -> Lazy.Text
|
|
fragmentSpread formatter (Full.FragmentSpread name directives' _)
|
|
= "..." <> Lazy.Text.fromStrict name
|
|
<> optempty (directives formatter) directives'
|
|
|
|
inlineFragment :: Formatter -> Full.InlineFragment -> Lazy.Text
|
|
inlineFragment formatter (Full.InlineFragment typeCondition directives' selections _)
|
|
= "... on "
|
|
<> Lazy.Text.fromStrict (fold typeCondition)
|
|
<> directives formatter directives'
|
|
<> eitherFormat formatter " " mempty
|
|
<> selectionSet formatter selections
|
|
|
|
fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Lazy.Text
|
|
fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels _)
|
|
= "fragment " <> Lazy.Text.fromStrict name
|
|
<> " on " <> Lazy.Text.fromStrict tc
|
|
<> optempty (directives formatter) dirs
|
|
<> eitherFormat formatter " " mempty
|
|
<> selectionSet formatter sels
|
|
|
|
-- * Miscellaneous
|
|
|
|
-- | Converts a 'Full.Directive' into a string.
|
|
directive :: Formatter -> Full.Directive -> Lazy.Text
|
|
directive formatter (Full.Directive name args _)
|
|
= "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args
|
|
|
|
directives :: Formatter -> [Full.Directive] -> Lazy.Text
|
|
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
|
|
value _ (Full.Variable x) = variable x
|
|
value _ (Full.Int x) = Builder.toLazyText $ decimal x
|
|
value _ (Full.Float x) = Builder.toLazyText $ realFloat x
|
|
value _ (Full.Boolean x) = booleanValue x
|
|
value _ Full.Null = "null"
|
|
value formatter (Full.String string) = stringValue formatter string
|
|
value _ (Full.Enum x) = Lazy.Text.fromStrict x
|
|
value formatter (Full.List x) = listValue formatter x
|
|
value formatter (Full.Object x) = objectValue formatter x
|
|
|
|
fromConstValue :: Full.ConstValue -> Full.Value
|
|
fromConstValue (Full.ConstInt x) = Full.Int x
|
|
fromConstValue (Full.ConstFloat x) = Full.Float x
|
|
fromConstValue (Full.ConstBoolean x) = Full.Boolean x
|
|
fromConstValue Full.ConstNull = Full.Null
|
|
fromConstValue (Full.ConstString string) = Full.String string
|
|
fromConstValue (Full.ConstEnum x) = Full.Enum x
|
|
fromConstValue (Full.ConstList x) = Full.List $ fmap fromConstValue <$> x
|
|
fromConstValue (Full.ConstObject x) = Full.Object $ fromConstObjectField <$> x
|
|
where
|
|
fromConstObjectField Full.ObjectField{value = value', ..} =
|
|
Full.ObjectField name (fromConstValue <$> value') location
|
|
|
|
booleanValue :: Bool -> Lazy.Text
|
|
booleanValue True = "true"
|
|
booleanValue False = "false"
|
|
|
|
quote :: Builder.Builder
|
|
quote = Builder.singleton '\"'
|
|
|
|
oneLine :: Text -> Builder
|
|
oneLine string = quote <> Text.foldr merge quote string
|
|
where
|
|
merge = mappend . Builder.fromString . Full.escape
|
|
|
|
stringValue :: Formatter -> Text -> Lazy.Text
|
|
stringValue Minified string = Builder.toLazyText $ oneLine string
|
|
stringValue (Pretty indentation) string =
|
|
if hasEscaped string
|
|
then stringValue Minified string
|
|
else Builder.toLazyText $ encoded lines'
|
|
where
|
|
isWhiteSpace char = char == ' ' || char == '\t'
|
|
isNewline char = char == '\n' || char == '\r'
|
|
hasEscaped = Text.any (not . isAllowed)
|
|
isAllowed char =
|
|
char == '\t' || isNewline char || (char >= '\x0020' && char /= '\x007F')
|
|
|
|
tripleQuote = Builder.fromText "\"\"\""
|
|
newline = Builder.singleton '\n'
|
|
|
|
strip = Text.dropWhile isWhiteSpace . Text.dropWhileEnd isWhiteSpace
|
|
lines' = map Builder.fromText $ Text.split isNewline (Text.replace "\r\n" "\n" $ strip string)
|
|
encoded [] = oneLine string
|
|
encoded [_] = oneLine string
|
|
encoded lines'' = tripleQuote <> newline
|
|
<> transformLines lines''
|
|
<> Builder.fromLazyText (indent indentation) <> tripleQuote
|
|
transformLines = foldr transformLine mempty
|
|
transformLine "" acc = newline <> acc
|
|
transformLine line' acc
|
|
= Builder.fromLazyText (indent (indentation + 1))
|
|
<> line' <> newline <> acc
|
|
|
|
listValue :: Formatter -> [Full.Node Full.Value] -> Lazy.Text
|
|
listValue formatter = bracketsCommas formatter $ value formatter . Full.node
|
|
|
|
objectValue :: Formatter -> [Full.ObjectField Full.Value] -> Lazy.Text
|
|
objectValue formatter = intercalate $ objectField formatter
|
|
where
|
|
intercalate f
|
|
= braces
|
|
. Lazy.Text.intercalate (eitherFormat formatter ", " ",")
|
|
. fmap f
|
|
|
|
objectField :: Formatter -> Full.ObjectField Full.Value -> Lazy.Text
|
|
objectField formatter (Full.ObjectField name (Full.Node value' _) _) =
|
|
Lazy.Text.fromStrict name <> colon formatter <> value formatter value'
|
|
|
|
-- | Converts a 'Full.Type' a type into a string.
|
|
type' :: Full.Type -> Lazy.Text
|
|
type' (Full.TypeNamed x) = Lazy.Text.fromStrict x
|
|
type' (Full.TypeList x) = listType x
|
|
type' (Full.TypeNonNull x) = nonNullType x
|
|
|
|
listType :: Full.Type -> Lazy.Text
|
|
listType x = brackets (type' x)
|
|
|
|
nonNullType :: Full.NonNullType -> Lazy.Text
|
|
nonNullType (Full.NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
|
|
nonNullType (Full.NonNullTypeList x) = listType x <> "!"
|
|
|
|
-- | Produces lowercase operation type: query, mutation or subscription.
|
|
operationType :: Formatter -> Full.OperationType -> Lazy.Text
|
|
operationType _formatter Full.Query = "query"
|
|
operationType _formatter Full.Mutation = "mutation"
|
|
operationType _formatter Full.Subscription = "subscription"
|
|
|
|
-- * Internal
|
|
|
|
between :: Char -> Char -> Lazy.Text -> Lazy.Text
|
|
between open close = Lazy.Text.cons open . (`Lazy.Text.snoc` close)
|
|
|
|
parens :: Lazy.Text -> Lazy.Text
|
|
parens = between '(' ')'
|
|
|
|
brackets :: Lazy.Text -> Lazy.Text
|
|
brackets = between '[' ']'
|
|
|
|
braces :: Lazy.Text -> Lazy.Text
|
|
braces = between '{' '}'
|
|
|
|
spaces :: forall a. (a -> Lazy.Text) -> [a] -> Lazy.Text
|
|
spaces f = Lazy.Text.intercalate "\SP" . fmap f
|
|
|
|
parensCommas :: forall a. Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
|
|
parensCommas formatter f
|
|
= parens
|
|
. Lazy.Text.intercalate (eitherFormat formatter ", " ",")
|
|
. fmap f
|
|
|
|
bracketsCommas :: Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
|
|
bracketsCommas formatter f
|
|
= brackets
|
|
. Lazy.Text.intercalate (eitherFormat formatter ", " ",")
|
|
. fmap f
|
|
|
|
bracesList :: forall a. Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
|
|
bracesList (Pretty intendation) f xs
|
|
= Lazy.Text.snoc (Lazy.Text.intercalate "\n" content) '\n'
|
|
<> (Lazy.Text.snoc $ Lazy.Text.replicate (fromIntegral intendation) " ") '}'
|
|
where
|
|
content = "{" : fmap f xs
|
|
bracesList Minified f xs = braces $ Lazy.Text.intercalate "," $ fmap f xs
|
|
|
|
optempty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
|
|
optempty f xs = if xs == mempty then mempty else f xs
|
|
|
|
eitherFormat :: forall a. Formatter -> a -> a -> a
|
|
eitherFormat (Pretty _) x _ = x
|
|
eitherFormat Minified _ x = x
|