{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
{-# 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 :: Formatter
pretty = Word -> Formatter
Pretty Word
0

-- | Constructs a formatter for minifying.
minified :: Formatter
minified :: Formatter
minified = Formatter
Minified

-- | Converts a Document' into a string.
document :: Formatter -> Full.Document -> Lazy.Text
document :: Formatter -> Document -> Text
document Formatter
formatter Document
defs
    | Pretty Word
_ <- Formatter
formatter = Text -> [Text] -> Text
Lazy.Text.intercalate Text
"\n" [Text]
encodeDocument
    | Formatter
Minified <-Formatter
formatter = Text -> Char -> Text
Lazy.Text.snoc ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text]
encodeDocument) Char
'\n'
  where
    encodeDocument :: [Text]
encodeDocument = (Definition -> [Text] -> [Text]) -> [Text] -> Document -> [Text]
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Definition -> [Text] -> [Text]
executableDefinition [] Document
defs
    executableDefinition :: Definition -> [Text] -> [Text]
executableDefinition (Full.ExecutableDefinition ExecutableDefinition
executableDefinition') [Text]
acc =
        Formatter -> ExecutableDefinition -> Text
definition Formatter
formatter ExecutableDefinition
executableDefinition' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc
    executableDefinition (Full.TypeSystemDefinition TypeSystemDefinition
typeSystemDefinition' Location
_location) [Text]
acc =
        Formatter -> TypeSystemDefinition -> Text
typeSystemDefinition Formatter
formatter TypeSystemDefinition
typeSystemDefinition' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc
    executableDefinition (Full.TypeSystemExtension TypeSystemExtension
typeSystemExtension' Location
_location) [Text]
acc =
        Formatter -> TypeSystemExtension -> Text
typeSystemExtension Formatter
formatter TypeSystemExtension
typeSystemExtension' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc

directiveLocation :: DirectiveLocation.DirectiveLocation -> Lazy.Text
directiveLocation :: DirectiveLocation -> Text
directiveLocation = String -> Text
Lazy.Text.pack (String -> Text)
-> (DirectiveLocation -> String) -> DirectiveLocation -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectiveLocation -> String
forall a. Show a => a -> String
show

withLineBreak :: Formatter -> Lazy.Text.Text -> Lazy.Text.Text
withLineBreak :: Formatter -> Text -> Text
withLineBreak Formatter
formatter Text
encodeDefinition
    | Pretty Word
_ <- Formatter
formatter = Text -> Char -> Text
Lazy.Text.snoc Text
encodeDefinition Char
'\n'
    | Formatter
Minified <- Formatter
formatter = Text
encodeDefinition

typeSystemExtension :: Formatter -> Full.TypeSystemExtension -> Lazy.Text
typeSystemExtension :: Formatter -> TypeSystemExtension -> Text
typeSystemExtension Formatter
formatter = \case
    Full.SchemaExtension SchemaExtension
schemaExtension' ->
        Formatter -> SchemaExtension -> Text
schemaExtension Formatter
formatter SchemaExtension
schemaExtension'
    Full.TypeExtension TypeExtension
typeExtension' -> Formatter -> TypeExtension -> Text
typeExtension Formatter
formatter TypeExtension
typeExtension'

schemaExtension :: Formatter -> Full.SchemaExtension -> Lazy.Text
schemaExtension :: Formatter -> SchemaExtension -> Text
schemaExtension Formatter
formatter = \case
    Full.SchemaOperationExtension [Directive]
operationDirectives NonEmpty OperationTypeDefinition
operationTypeDefinitions' ->
        Formatter -> Text -> Text
withLineBreak Formatter
formatter
            (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"extend schema "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
operationDirectives
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter
-> (OperationTypeDefinition -> Text)
-> [OperationTypeDefinition]
-> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter (Formatter -> OperationTypeDefinition -> Text
operationTypeDefinition Formatter
formatter) (NonEmpty OperationTypeDefinition -> [OperationTypeDefinition]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty OperationTypeDefinition
operationTypeDefinitions')
    Full.SchemaDirectivesExtension NonEmpty Directive
operationDirectives -> Text
"extend schema "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) (NonEmpty Directive -> [Directive]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Directive
operationDirectives)

typeExtension :: Formatter -> Full.TypeExtension -> Lazy.Text
typeExtension :: Formatter -> TypeExtension -> Text
typeExtension Formatter
formatter = \case
    Full.ScalarTypeExtension StrictText
name' NonEmpty Directive
directives'
        -> Text
"extend scalar "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> [Directive] -> Text
directives Formatter
formatter (NonEmpty Directive -> [Directive]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Directive
directives')
    Full.ObjectTypeFieldsDefinitionExtension StrictText
name' ImplementsInterfaces []
ifaces' [Directive]
directives' NonEmpty FieldDefinition
fields'
        -> Text
"extend type "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Text -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (ImplementsInterfaces [] -> Text
forall (t :: * -> *). Foldable t => ImplementsInterfaces t -> Text
implementsInterfaces ImplementsInterfaces []
ifaces')
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
directives'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
""
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> (FieldDefinition -> Text) -> [FieldDefinition] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter (Formatter -> FieldDefinition -> Text
fieldDefinition Formatter
nextFormatter) (NonEmpty FieldDefinition -> [FieldDefinition]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty FieldDefinition
fields')
    Full.ObjectTypeDirectivesExtension StrictText
name' ImplementsInterfaces []
ifaces' NonEmpty Directive
directives'
        -> Text
"extend type "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Text -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (ImplementsInterfaces [] -> Text
forall (t :: * -> *). Foldable t => ImplementsInterfaces t -> Text
implementsInterfaces ImplementsInterfaces []
ifaces')
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) (NonEmpty Directive -> [Directive]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Directive
directives')
    Full.ObjectTypeImplementsInterfacesExtension StrictText
name' ImplementsInterfaces NonEmpty
ifaces'
        -> Text
"extend type "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Text -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (ImplementsInterfaces NonEmpty -> Text
forall (t :: * -> *). Foldable t => ImplementsInterfaces t -> Text
implementsInterfaces ImplementsInterfaces NonEmpty
ifaces')
    Full.InterfaceTypeFieldsDefinitionExtension StrictText
name' [Directive]
directives' NonEmpty FieldDefinition
fields'
        -> Text
"extend interface "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
directives'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
""
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> (FieldDefinition -> Text) -> [FieldDefinition] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter (Formatter -> FieldDefinition -> Text
fieldDefinition Formatter
nextFormatter) (NonEmpty FieldDefinition -> [FieldDefinition]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty FieldDefinition
fields')
    Full.InterfaceTypeDirectivesExtension StrictText
name' NonEmpty Directive
directives'
        -> Text
"extend interface "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) (NonEmpty Directive -> [Directive]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Directive
directives')
    Full.UnionTypeUnionMemberTypesExtension StrictText
name' [Directive]
directives' UnionMemberTypes NonEmpty
members'
        -> Text
"extend union "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
directives'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
""
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> UnionMemberTypes NonEmpty -> Text
forall (t :: * -> *).
Foldable t =>
Formatter -> UnionMemberTypes t -> Text
unionMemberTypes Formatter
formatter UnionMemberTypes NonEmpty
members'
    Full.UnionTypeDirectivesExtension StrictText
name' NonEmpty Directive
directives'
        -> Text
"extend union "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) (NonEmpty Directive -> [Directive]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Directive
directives')
    Full.EnumTypeEnumValuesDefinitionExtension StrictText
name' [Directive]
directives' NonEmpty EnumValueDefinition
members'
        -> Text
"extend enum "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
directives'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
""
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter
-> (EnumValueDefinition -> Text) -> [EnumValueDefinition] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter (Formatter -> EnumValueDefinition -> Text
enumValueDefinition Formatter
formatter) (NonEmpty EnumValueDefinition -> [EnumValueDefinition]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty EnumValueDefinition
members')
    Full.EnumTypeDirectivesExtension StrictText
name' NonEmpty Directive
directives'
        -> Text
"extend enum "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) (NonEmpty Directive -> [Directive]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Directive
directives')
    Full.InputObjectTypeInputFieldsDefinitionExtension StrictText
name' [Directive]
directives' NonEmpty InputValueDefinition
fields'
        -> Text
"extend input "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
directives'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
""
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter
-> (InputValueDefinition -> Text) -> [InputValueDefinition] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter (Formatter -> InputValueDefinition -> Text
inputValueDefinition Formatter
nextFormatter) (NonEmpty InputValueDefinition -> [InputValueDefinition]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty InputValueDefinition
fields')
    Full.InputObjectTypeDirectivesExtension StrictText
name' NonEmpty Directive
directives'
        -> Text
"extend input "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) (NonEmpty Directive -> [Directive]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Directive
directives')
  where
    nextFormatter :: Formatter
nextFormatter = Formatter -> Formatter
incrementIndent Formatter
formatter

-- | Converts a t'Full.TypeSystemDefinition' into a string.
typeSystemDefinition :: Formatter -> Full.TypeSystemDefinition -> Lazy.Text
typeSystemDefinition :: Formatter -> TypeSystemDefinition -> Text
typeSystemDefinition Formatter
formatter = \case
    Full.SchemaDefinition [Directive]
operationDirectives NonEmpty OperationTypeDefinition
operationTypeDefinitions' ->
        Formatter -> Text -> Text
withLineBreak Formatter
formatter
            (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"schema "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
operationDirectives
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter
-> (OperationTypeDefinition -> Text)
-> [OperationTypeDefinition]
-> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter (Formatter -> OperationTypeDefinition -> Text
operationTypeDefinition Formatter
formatter) (NonEmpty OperationTypeDefinition -> [OperationTypeDefinition]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty OperationTypeDefinition
operationTypeDefinitions')
    Full.TypeDefinition TypeDefinition
typeDefinition' -> Formatter -> TypeDefinition -> Text
typeDefinition Formatter
formatter TypeDefinition
typeDefinition'
    Full.DirectiveDefinition Description
description' StrictText
name' ArgumentsDefinition
arguments' Bool
repeatable NonEmpty DirectiveLocation
locations
        -> Formatter -> Description -> Text
description Formatter
formatter Description
description'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> ArgumentsDefinition -> Text
argumentsDefinition Formatter
formatter ArgumentsDefinition
arguments'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
repeatable then Text
" repeatable" else Text
forall a. Monoid a => a
mempty)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" on"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> NonEmpty Text -> Text
forall (t :: * -> *). Foldable t => Formatter -> t Text -> Text
pipeList Formatter
formatter (DirectiveLocation -> Text
directiveLocation (DirectiveLocation -> Text)
-> NonEmpty DirectiveLocation -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty DirectiveLocation
locations)

operationTypeDefinition :: Formatter -> Full.OperationTypeDefinition -> Lazy.Text.Text
operationTypeDefinition :: Formatter -> OperationTypeDefinition -> Text
operationTypeDefinition Formatter
formatter (Full.OperationTypeDefinition OperationType
operationType' StrictText
namedType')
    = Formatter -> Text
indentLine (Formatter -> Formatter
incrementIndent Formatter
formatter)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> OperationType -> Text
operationType Formatter
formatter OperationType
operationType'
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text
colon Formatter
formatter
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
namedType'

fieldDefinition :: Formatter -> Full.FieldDefinition -> Lazy.Text.Text
fieldDefinition :: Formatter -> FieldDefinition -> Text
fieldDefinition Formatter
formatter FieldDefinition
fieldDefinition' =
    let Full.FieldDefinition Description
description' StrictText
name' ArgumentsDefinition
arguments' Type
type'' [Directive]
directives' = FieldDefinition
fieldDefinition'
     in (Description -> Text) -> Description -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> Description -> Text
description Formatter
formatter) Description
description'
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text
indentLine Formatter
formatter
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> ArgumentsDefinition -> Text
argumentsDefinition Formatter
formatter ArgumentsDefinition
arguments'
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text
colon Formatter
formatter
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
type' Type
type''
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
directives'

argumentsDefinition :: Formatter -> Full.ArgumentsDefinition -> Lazy.Text.Text
argumentsDefinition :: Formatter -> ArgumentsDefinition -> Text
argumentsDefinition Formatter
formatter (Full.ArgumentsDefinition [InputValueDefinition]
arguments') =
    Formatter
-> (InputValueDefinition -> Text) -> [InputValueDefinition] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
parensCommas Formatter
formatter (Formatter -> InputValueDefinition -> Text
argumentDefinition Formatter
formatter) [InputValueDefinition]
arguments'

argumentDefinition :: Formatter -> Full.InputValueDefinition -> Lazy.Text.Text
argumentDefinition :: Formatter -> InputValueDefinition -> Text
argumentDefinition Formatter
formatter InputValueDefinition
definition' =
    let Full.InputValueDefinition Description
description' StrictText
name' Type
type'' Maybe (Node ConstValue)
defaultValue' [Directive]
directives' = InputValueDefinition
definition'
     in (Description -> Text) -> Description -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> Description -> Text
description Formatter
formatter) Description
description'
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text
colon Formatter
formatter
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
type' Type
type''
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
-> (Node ConstValue -> Text) -> Maybe (Node ConstValue) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty (Formatter -> ConstValue -> Text
defaultValue Formatter
formatter (ConstValue -> Text)
-> (Node ConstValue -> ConstValue) -> Node ConstValue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node ConstValue -> ConstValue
forall a. Node a -> a
Full.node) Maybe (Node ConstValue)
defaultValue'
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> [Directive] -> Text
directives Formatter
formatter [Directive]
directives'

inputValueDefinition :: Formatter -> Full.InputValueDefinition -> Lazy.Text.Text
inputValueDefinition :: Formatter -> InputValueDefinition -> Text
inputValueDefinition Formatter
formatter InputValueDefinition
definition' =
    let Full.InputValueDefinition Description
description' StrictText
name' Type
type'' Maybe (Node ConstValue)
defaultValue' [Directive]
directives' = InputValueDefinition
definition'
     in (Description -> Text) -> Description -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> Description -> Text
description Formatter
formatter) Description
description'
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text
indentLine Formatter
formatter
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text
colon Formatter
formatter
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
type' Type
type''
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
-> (Node ConstValue -> Text) -> Maybe (Node ConstValue) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty (Formatter -> ConstValue -> Text
defaultValue Formatter
formatter (ConstValue -> Text)
-> (Node ConstValue -> ConstValue) -> Node ConstValue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node ConstValue -> ConstValue
forall a. Node a -> a
Full.node) Maybe (Node ConstValue)
defaultValue'
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> [Directive] -> Text
directives Formatter
formatter [Directive]
directives'

typeDefinition :: Formatter -> Full.TypeDefinition -> Lazy.Text
typeDefinition :: Formatter -> TypeDefinition -> Text
typeDefinition Formatter
formatter = \case
    Full.ScalarTypeDefinition Description
description' StrictText
name' [Directive]
directives'
        -> (Description -> Text) -> Description -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> Description -> Text
description Formatter
formatter) Description
description'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"scalar "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
directives'
    Full.ObjectTypeDefinition Description
description' StrictText
name' ImplementsInterfaces []
ifaces' [Directive]
directives' [FieldDefinition]
fields'
        -> (Description -> Text) -> Description -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> Description -> Text
description Formatter
formatter) Description
description'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"type "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Text -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (ImplementsInterfaces [] -> Text
forall (t :: * -> *). Foldable t => ImplementsInterfaces t -> Text
implementsInterfaces ImplementsInterfaces []
ifaces')
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
directives'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
""
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> (FieldDefinition -> Text) -> [FieldDefinition] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter (Formatter -> FieldDefinition -> Text
fieldDefinition Formatter
nextFormatter) [FieldDefinition]
fields'
    Full.InterfaceTypeDefinition Description
description' StrictText
name' ImplementsInterfaces []
ifaces' [Directive]
directives' [FieldDefinition]
fields'
        -> (Description -> Text) -> Description -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> Description -> Text
description Formatter
formatter) Description
description'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"interface "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Text -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (ImplementsInterfaces [] -> Text
forall (t :: * -> *). Foldable t => ImplementsInterfaces t -> Text
implementsInterfaces ImplementsInterfaces []
ifaces')
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
directives'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
""
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> (FieldDefinition -> Text) -> [FieldDefinition] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter (Formatter -> FieldDefinition -> Text
fieldDefinition Formatter
nextFormatter) [FieldDefinition]
fields'
    Full.UnionTypeDefinition Description
description' StrictText
name' [Directive]
directives' UnionMemberTypes []
members'
        -> (Description -> Text) -> Description -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> Description -> Text
description Formatter
formatter) Description
description'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"union "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
directives'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
""
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> UnionMemberTypes [] -> Text
forall (t :: * -> *).
Foldable t =>
Formatter -> UnionMemberTypes t -> Text
unionMemberTypes Formatter
formatter UnionMemberTypes []
members'
    Full.EnumTypeDefinition Description
description' StrictText
name' [Directive]
directives' [EnumValueDefinition]
members'
        -> (Description -> Text) -> Description -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> Description -> Text
description Formatter
formatter) Description
description'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"enum "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
directives'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
""
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter
-> (EnumValueDefinition -> Text) -> [EnumValueDefinition] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter (Formatter -> EnumValueDefinition -> Text
enumValueDefinition Formatter
formatter) [EnumValueDefinition]
members'
    Full.InputObjectTypeDefinition Description
description' StrictText
name' [Directive]
directives' [InputValueDefinition]
fields'
        -> (Description -> Text) -> Description -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> Description -> Text
description Formatter
formatter) Description
description'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"input "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
directives'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
""
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter
-> (InputValueDefinition -> Text) -> [InputValueDefinition] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter (Formatter -> InputValueDefinition -> Text
inputValueDefinition Formatter
nextFormatter) [InputValueDefinition]
fields'
  where
    nextFormatter :: Formatter
nextFormatter = Formatter -> Formatter
incrementIndent Formatter
formatter

implementsInterfaces :: Foldable t => Full.ImplementsInterfaces t -> Lazy.Text
implementsInterfaces :: forall (t :: * -> *). Foldable t => ImplementsInterfaces t -> Text
implementsInterfaces (Full.ImplementsInterfaces t StrictText
interfaces)
    | t StrictText -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t StrictText
interfaces = Text
forall a. Monoid a => a
mempty
    | Bool
otherwise = StrictText -> Text
Lazy.Text.fromStrict
        (StrictText -> Text) -> StrictText -> Text
forall a b. (a -> b) -> a -> b
$ StrictText -> StrictText -> StrictText
Text.append StrictText
"implements "
        (StrictText -> StrictText) -> StrictText -> StrictText
forall a b. (a -> b) -> a -> b
$ StrictText -> [StrictText] -> StrictText
Text.intercalate StrictText
" & "
        ([StrictText] -> StrictText) -> [StrictText] -> StrictText
forall a b. (a -> b) -> a -> b
$ t StrictText -> [StrictText]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t StrictText
interfaces

unionMemberTypes :: Foldable t => Formatter -> Full.UnionMemberTypes t -> Lazy.Text
unionMemberTypes :: forall (t :: * -> *).
Foldable t =>
Formatter -> UnionMemberTypes t -> Text
unionMemberTypes Formatter
formatter (Full.UnionMemberTypes t StrictText
memberTypes)
    | t StrictText -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t StrictText
memberTypes = Text
forall a. Monoid a => a
mempty
    | Bool
otherwise = Text -> Text -> Text
Lazy.Text.append Text
"="
        (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Formatter -> [Text] -> Text
forall (t :: * -> *). Foldable t => Formatter -> t Text -> Text
pipeList Formatter
formatter
        ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ StrictText -> Text
Lazy.Text.fromStrict
        (StrictText -> Text) -> [StrictText] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t StrictText -> [StrictText]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t StrictText
memberTypes

pipeList :: Foldable t => Formatter -> t Lazy.Text -> Lazy.Text
pipeList :: forall (t :: * -> *). Foldable t => Formatter -> t Text -> Text
pipeList Formatter
Minified =  (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (t Text -> Text) -> t Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Lazy.Text.intercalate Text
" | " ([Text] -> Text) -> (t Text -> [Text]) -> t Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t Text -> [Text]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
pipeList (Pretty Word
_) =  [Text] -> Text
Lazy.Text.concat
    ([Text] -> Text) -> (t Text -> [Text]) -> t Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
indentSymbol Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
    ([Text] -> [Text]) -> (t Text -> [Text]) -> t Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t Text -> [Text]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

enumValueDefinition :: Formatter -> Full.EnumValueDefinition -> Lazy.Text
enumValueDefinition :: Formatter -> EnumValueDefinition -> Text
enumValueDefinition (Pretty Word
_) EnumValueDefinition
enumValue =
    let Full.EnumValueDefinition Description
description' StrictText
name' [Directive]
directives' = EnumValueDefinition
enumValue
        formatter :: Formatter
formatter = Word -> Formatter
Pretty Word
1
     in Formatter -> Description -> Text
description Formatter
formatter Description
description'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text
indentLine Formatter
formatter
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> [Directive] -> Text
directives Formatter
formatter [Directive]
directives'
enumValueDefinition Formatter
Minified EnumValueDefinition
enumValue =
    let Full.EnumValueDefinition Description
description' StrictText
name' [Directive]
directives' = EnumValueDefinition
enumValue
     in Formatter -> Description -> Text
description Formatter
Minified Description
description'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name'
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> [Directive] -> Text
directives Formatter
Minified [Directive]
directives'

description :: Formatter -> Full.Description -> Lazy.Text.Text
description :: Formatter -> Description -> Text
description Formatter
_formatter (Full.Description Maybe StrictText
Nothing) = Text
""
description Formatter
formatter (Full.Description (Just StrictText
description')) =
    Formatter -> StrictText -> Text
stringValue Formatter
formatter StrictText
description'

-- | Converts a t'Full.ExecutableDefinition' into a string.
definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text
definition :: Formatter -> ExecutableDefinition -> Text
definition Formatter
formatter ExecutableDefinition
x
    | Pretty Word
_ <- Formatter
formatter = Text -> Char -> Text
Lazy.Text.snoc (ExecutableDefinition -> Text
encodeDefinition ExecutableDefinition
x) Char
'\n'
    | Formatter
Minified <- Formatter
formatter = ExecutableDefinition -> Text
encodeDefinition ExecutableDefinition
x
  where
    encodeDefinition :: ExecutableDefinition -> Text
encodeDefinition (Full.DefinitionOperation OperationDefinition
operation)
        = Formatter -> OperationDefinition -> Text
operationDefinition Formatter
formatter OperationDefinition
operation
    encodeDefinition (Full.DefinitionFragment FragmentDefinition
fragment)
        = Formatter -> FragmentDefinition -> Text
fragmentDefinition Formatter
formatter FragmentDefinition
fragment

-- | Converts a 'Full.OperationDefinition into a string.
operationDefinition :: Formatter -> Full.OperationDefinition -> Lazy.Text
operationDefinition :: Formatter -> OperationDefinition -> Text
operationDefinition Formatter
formatter = \case
    Full.SelectionSet SelectionSet
sels Location
_ -> Formatter -> SelectionSet -> Text
selectionSet Formatter
formatter SelectionSet
sels
    Full.OperationDefinition OperationType
Full.Query Maybe StrictText
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels Location
_ ->
        Text
"query " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe StrictText
-> [VariableDefinition] -> [Directive] -> SelectionSet -> Text
root Maybe StrictText
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels
    Full.OperationDefinition OperationType
Full.Mutation Maybe StrictText
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels Location
_ ->
        Text
"mutation " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe StrictText
-> [VariableDefinition] -> [Directive] -> SelectionSet -> Text
root Maybe StrictText
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels
    Full.OperationDefinition OperationType
Full.Subscription Maybe StrictText
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels Location
_ ->
        Text
"subscription " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe StrictText
-> [VariableDefinition] -> [Directive] -> SelectionSet -> Text
root Maybe StrictText
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels
  where
    -- | Converts a Query or Mutation into a string.
    root :: Maybe Full.Name ->
        [Full.VariableDefinition] ->
        [Full.Directive] ->
        Full.SelectionSet ->
        Lazy.Text
    root :: Maybe StrictText
-> [VariableDefinition] -> [Directive] -> SelectionSet -> Text
root Maybe StrictText
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels
        = StrictText -> Text
Lazy.Text.fromStrict (Maybe StrictText -> StrictText
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe StrictText
name)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([VariableDefinition] -> Text) -> [VariableDefinition] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [VariableDefinition] -> Text
variableDefinitions Formatter
formatter) [VariableDefinition]
vars
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
dirs
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
forall a. Monoid a => a
mempty
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> SelectionSet -> Text
selectionSet Formatter
formatter SelectionSet
sels

variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Lazy.Text
variableDefinitions :: Formatter -> [VariableDefinition] -> Text
variableDefinitions Formatter
formatter
    = Formatter
-> (VariableDefinition -> Text) -> [VariableDefinition] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
parensCommas Formatter
formatter ((VariableDefinition -> Text) -> [VariableDefinition] -> Text)
-> (VariableDefinition -> Text) -> [VariableDefinition] -> Text
forall a b. (a -> b) -> a -> b
$ Formatter -> VariableDefinition -> Text
variableDefinition Formatter
formatter

variableDefinition :: Formatter -> Full.VariableDefinition -> Lazy.Text
variableDefinition :: Formatter -> VariableDefinition -> Text
variableDefinition Formatter
formatter VariableDefinition
variableDefinition' =
    let Full.VariableDefinition StrictText
variableName Type
variableType Maybe (Node ConstValue)
defaultValue' Location
_ =
            VariableDefinition
variableDefinition'
     in StrictText -> Text
variable StrictText
variableName
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text
colon Formatter
formatter
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
type' Type
variableType
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
-> (Node ConstValue -> Text) -> Maybe (Node ConstValue) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty (Formatter -> ConstValue -> Text
defaultValue Formatter
formatter (ConstValue -> Text)
-> (Node ConstValue -> ConstValue) -> Node ConstValue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node ConstValue -> ConstValue
forall a. Node a -> a
Full.node) Maybe (Node ConstValue)
defaultValue'

defaultValue :: Formatter -> Full.ConstValue -> Lazy.Text
defaultValue :: Formatter -> ConstValue -> Text
defaultValue Formatter
formatter ConstValue
val
    = Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" = " Text
"="
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Value -> Text
value Formatter
formatter (ConstValue -> Value
fromConstValue ConstValue
val)

variable :: Full.Name -> Lazy.Text
variable :: StrictText -> Text
variable StrictText
var = Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
var

selectionSet :: Formatter -> Full.SelectionSet -> Lazy.Text
selectionSet :: Formatter -> SelectionSet -> Text
selectionSet Formatter
formatter
    = Formatter -> (Selection -> Text) -> SelectionSetOpt -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter (Formatter -> Selection -> Text
selection Formatter
formatter)
    (SelectionSetOpt -> Text)
-> (SelectionSet -> SelectionSetOpt) -> SelectionSet -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionSet -> SelectionSetOpt
forall a. NonEmpty a -> [a]
NonEmpty.toList

selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text
selectionSetOpt :: Formatter -> SelectionSetOpt -> Text
selectionSetOpt Formatter
formatter = Formatter -> (Selection -> Text) -> SelectionSetOpt -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter ((Selection -> Text) -> SelectionSetOpt -> Text)
-> (Selection -> Text) -> SelectionSetOpt -> Text
forall a b. (a -> b) -> a -> b
$ Formatter -> Selection -> Text
selection Formatter
formatter

indentSymbol :: Lazy.Text
indentSymbol :: Text
indentSymbol = Text
"  "

indent :: (Integral a) => a -> Lazy.Text
indent :: forall a. Integral a => a -> Text
indent a
indentation = Int64 -> Text -> Text
Lazy.Text.replicate (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
indentation) Text
indentSymbol

selection :: Formatter -> Full.Selection -> Lazy.Text
selection :: Formatter -> Selection -> Text
selection Formatter
formatter = Text -> Text -> Text
Lazy.Text.append (Formatter -> Text
indentLine Formatter
formatter')
    (Text -> Text) -> (Selection -> Text) -> Selection -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection -> Text
encodeSelection
  where
    encodeSelection :: Selection -> Text
encodeSelection (Full.FieldSelection Field
fieldSelection) =
        Formatter -> Field -> Text
field Formatter
formatter' Field
fieldSelection
    encodeSelection (Full.InlineFragmentSelection InlineFragment
fragmentSelection) =
        Formatter -> InlineFragment -> Text
inlineFragment Formatter
formatter' InlineFragment
fragmentSelection
    encodeSelection (Full.FragmentSpreadSelection FragmentSpread
fragmentSelection) =
        Formatter -> FragmentSpread -> Text
fragmentSpread Formatter
formatter' FragmentSpread
fragmentSelection
    formatter' :: Formatter
formatter' = Formatter -> Formatter
incrementIndent Formatter
formatter

indentLine :: Formatter -> Lazy.Text
indentLine :: Formatter -> Text
indentLine Formatter
formatter
    | Pretty Word
indentation <- Formatter
formatter = Word -> Text
forall a. Integral a => a -> Text
indent Word
indentation
    | Bool
otherwise = Text
""

incrementIndent :: Formatter -> Formatter
incrementIndent :: Formatter -> Formatter
incrementIndent Formatter
formatter
    | Pretty Word
indentation <- Formatter
formatter = Word -> Formatter
Pretty (Word -> Formatter) -> Word -> Formatter
forall a b. (a -> b) -> a -> b
$ Word
indentation Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1
    | Bool
otherwise = Formatter
Minified

colon :: Formatter -> Lazy.Text
colon :: Formatter -> Text
colon Formatter
formatter = Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
": " Text
":"

-- | Converts Field into a string.
field :: Formatter -> Full.Field -> Lazy.Text
field :: Formatter -> Field -> Text
field Formatter
formatter (Full.Field Maybe StrictText
alias StrictText
name [Argument]
args [Directive]
dirs SelectionSetOpt
set Location
_)
    = (StrictText -> Text) -> StrictText -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty StrictText -> Text
prependAlias (Maybe StrictText -> StrictText
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe StrictText
alias)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Argument] -> Text) -> [Argument] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Argument] -> Text
arguments Formatter
formatter) [Argument]
args
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
dirs
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (SelectionSetOpt -> Text) -> SelectionSetOpt -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty SelectionSetOpt -> Text
selectionSetOpt' SelectionSetOpt
set
  where
    prependAlias :: StrictText -> Text
prependAlias StrictText
aliasName = StrictText -> Text
Lazy.Text.fromStrict StrictText
aliasName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Formatter -> Text
colon Formatter
formatter
    selectionSetOpt' :: SelectionSetOpt -> Text
selectionSetOpt' = (Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
        (Text -> Text)
-> (SelectionSetOpt -> Text) -> SelectionSetOpt -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatter -> SelectionSetOpt -> Text
selectionSetOpt Formatter
formatter

arguments :: Formatter -> [Full.Argument] -> Lazy.Text
arguments :: Formatter -> [Argument] -> Text
arguments Formatter
formatter = Formatter -> (Argument -> Text) -> [Argument] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
parensCommas Formatter
formatter ((Argument -> Text) -> [Argument] -> Text)
-> (Argument -> Text) -> [Argument] -> Text
forall a b. (a -> b) -> a -> b
$ Formatter -> Argument -> Text
argument Formatter
formatter

argument :: Formatter -> Full.Argument -> Lazy.Text
argument :: Formatter -> Argument -> Text
argument Formatter
formatter (Full.Argument StrictText
name Node Value
value' Location
_)
    = StrictText -> Text
Lazy.Text.fromStrict StrictText
name
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text
colon Formatter
formatter
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Value -> Text
value Formatter
formatter (Node Value -> Value
forall a. Node a -> a
Full.node Node Value
value')

-- * Fragments

fragmentSpread :: Formatter -> Full.FragmentSpread -> Lazy.Text
fragmentSpread :: Formatter -> FragmentSpread -> Text
fragmentSpread Formatter
formatter (Full.FragmentSpread StrictText
name [Directive]
directives' Location
_)
    = Text
"..." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
directives'

inlineFragment :: Formatter -> Full.InlineFragment -> Lazy.Text
inlineFragment :: Formatter -> InlineFragment -> Text
inlineFragment Formatter
formatter (Full.InlineFragment Maybe StrictText
typeCondition [Directive]
directives' SelectionSet
selections Location
_)
    = Text
"... on "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict (Maybe StrictText -> StrictText
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe StrictText
typeCondition)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> [Directive] -> Text
directives Formatter
formatter [Directive]
directives'
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
forall a. Monoid a => a
mempty
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> SelectionSet -> Text
selectionSet Formatter
formatter SelectionSet
selections

fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Lazy.Text
fragmentDefinition :: Formatter -> FragmentDefinition -> Text
fragmentDefinition Formatter
formatter (Full.FragmentDefinition StrictText
name StrictText
tc [Directive]
dirs SelectionSet
sels Location
_)
    = Text
"fragment " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" on " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
tc
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Directive] -> Text) -> [Directive] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
dirs
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
forall a. Monoid a => a
mempty
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> SelectionSet -> Text
selectionSet Formatter
formatter SelectionSet
sels

-- * Miscellaneous

-- | Converts a 'Full.Directive' into a string.
directive :: Formatter -> Full.Directive -> Lazy.Text
directive :: Formatter -> Directive -> Text
directive Formatter
formatter (Full.Directive StrictText
name [Argument]
args Location
_)
    = Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StrictText -> Text
Lazy.Text.fromStrict StrictText
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Argument] -> Text) -> [Argument] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Argument] -> Text
arguments Formatter
formatter) [Argument]
args

directives :: Formatter -> [Full.Directive] -> Lazy.Text
directives :: Formatter -> [Directive] -> Text
directives Formatter
Minified [Directive]
values = (Directive -> Text) -> [Directive] -> Text
forall a. (a -> Text) -> [a] -> Text
spaces (Formatter -> Directive -> Text
directive Formatter
Minified) [Directive]
values
directives Formatter
formatter [Directive]
values
    | [Directive] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Directive]
values = Text
""
    | Bool
otherwise = Char -> Text -> Text
Lazy.Text.cons Char
' ' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Directive -> Text) -> [Directive] -> Text
forall a. (a -> Text) -> [a] -> Text
spaces (Formatter -> Directive -> Text
directive Formatter
formatter) [Directive]
values

-- | Converts a 'Full.Value' into a string.
value :: Formatter -> Full.Value -> Lazy.Text
value :: Formatter -> Value -> Text
value Formatter
_ (Full.Variable StrictText
x) = StrictText -> Text
variable StrictText
x
value Formatter
_ (Full.Int Int32
x) = Builder -> Text
Builder.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Int32 -> Builder
forall a. Integral a => a -> Builder
decimal Int32
x
value Formatter
_ (Full.Float Double
x) = Builder -> Text
Builder.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Double -> Builder
forall a. RealFloat a => a -> Builder
realFloat Double
x
value Formatter
_ (Full.Boolean  Bool
x) = Bool -> Text
booleanValue Bool
x
value Formatter
_ Value
Full.Null = Text
"null"
value Formatter
formatter (Full.String StrictText
string) = Formatter -> StrictText -> Text
stringValue Formatter
formatter StrictText
string
value Formatter
_ (Full.Enum StrictText
x) = StrictText -> Text
Lazy.Text.fromStrict StrictText
x
value Formatter
formatter (Full.List [Node Value]
x) = Formatter -> [Node Value] -> Text
listValue Formatter
formatter [Node Value]
x
value Formatter
formatter (Full.Object [ObjectField Value]
x) = Formatter -> [ObjectField Value] -> Text
objectValue Formatter
formatter [ObjectField Value]
x

fromConstValue :: Full.ConstValue -> Full.Value
fromConstValue :: ConstValue -> Value
fromConstValue (Full.ConstInt Int32
x) = Int32 -> Value
Full.Int Int32
x
fromConstValue (Full.ConstFloat Double
x) = Double -> Value
Full.Float Double
x
fromConstValue (Full.ConstBoolean  Bool
x) = Bool -> Value
Full.Boolean Bool
x
fromConstValue ConstValue
Full.ConstNull = Value
Full.Null
fromConstValue (Full.ConstString StrictText
string) = StrictText -> Value
Full.String StrictText
string
fromConstValue (Full.ConstEnum StrictText
x) = StrictText -> Value
Full.Enum StrictText
x
fromConstValue (Full.ConstList [Node ConstValue]
x) = [Node Value] -> Value
Full.List ([Node Value] -> Value) -> [Node Value] -> Value
forall a b. (a -> b) -> a -> b
$ (ConstValue -> Value) -> Node ConstValue -> Node Value
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstValue -> Value
fromConstValue (Node ConstValue -> Node Value)
-> [Node ConstValue] -> [Node Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node ConstValue]
x
fromConstValue (Full.ConstObject [ObjectField ConstValue]
x) = [ObjectField Value] -> Value
Full.Object ([ObjectField Value] -> Value) -> [ObjectField Value] -> Value
forall a b. (a -> b) -> a -> b
$ ObjectField ConstValue -> ObjectField Value
fromConstObjectField (ObjectField ConstValue -> ObjectField Value)
-> [ObjectField ConstValue] -> [ObjectField Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ObjectField ConstValue]
x
  where
    fromConstObjectField :: ObjectField ConstValue -> ObjectField Value
fromConstObjectField Full.ObjectField{value :: forall a. ObjectField a -> Node a
value = Node ConstValue
value', StrictText
Location
name :: StrictText
location :: Location
location :: forall a. ObjectField a -> Location
name :: forall a. ObjectField a -> StrictText
..} =
        StrictText -> Node Value -> Location -> ObjectField Value
forall a. StrictText -> Node a -> Location -> ObjectField a
Full.ObjectField StrictText
name (ConstValue -> Value
fromConstValue (ConstValue -> Value) -> Node ConstValue -> Node Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node ConstValue
value') Location
location

booleanValue :: Bool -> Lazy.Text
booleanValue :: Bool -> Text
booleanValue Bool
True  = Text
"true"
booleanValue Bool
False = Text
"false"

quote :: Builder.Builder
quote :: Builder
quote = Char -> Builder
Builder.singleton Char
'\"'

oneLine :: Text -> Builder
oneLine :: StrictText -> Builder
oneLine StrictText
string = Builder
quote Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Char -> Builder -> Builder) -> Builder -> StrictText -> Builder
forall a. (Char -> a -> a) -> a -> StrictText -> a
Text.foldr Char -> Builder -> Builder
merge Builder
quote StrictText
string
  where
    merge :: Char -> Builder -> Builder
merge = Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend (Builder -> Builder -> Builder)
-> (Char -> Builder) -> Char -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
Builder.fromString (String -> Builder) -> (Char -> String) -> Char -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
Full.escape

stringValue :: Formatter -> Text -> Lazy.Text
stringValue :: Formatter -> StrictText -> Text
stringValue Formatter
Minified StrictText
string = Builder -> Text
Builder.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ StrictText -> Builder
oneLine StrictText
string
stringValue (Pretty Word
indentation) StrictText
string =
  if StrictText -> Bool
hasEscaped StrictText
string
  then Formatter -> StrictText -> Text
stringValue Formatter
Minified StrictText
string
  else Builder -> Text
Builder.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
encoded [Builder]
lines'
    where
      isWhiteSpace :: Char -> Bool
isWhiteSpace Char
char = Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'
      isNewline :: Char -> Bool
isNewline Char
char = Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r'
      hasEscaped :: StrictText -> Bool
hasEscaped = (Char -> Bool) -> StrictText -> Bool
Text.any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAllowed)
      isAllowed :: Char -> Bool
isAllowed Char
char =
          Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char -> Bool
isNewline Char
char Bool -> Bool -> Bool
|| (Char
char Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0020' Bool -> Bool -> Bool
&& Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\x007F')

      tripleQuote :: Builder
tripleQuote = StrictText -> Builder
Builder.fromText StrictText
"\"\"\""
      newline :: Builder
newline = Char -> Builder
Builder.singleton Char
'\n'

      strip :: StrictText -> StrictText
strip = (Char -> Bool) -> StrictText -> StrictText
Text.dropWhile Char -> Bool
isWhiteSpace (StrictText -> StrictText)
-> (StrictText -> StrictText) -> StrictText -> StrictText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> StrictText -> StrictText
Text.dropWhileEnd Char -> Bool
isWhiteSpace
      lines' :: [Builder]
lines' = (StrictText -> Builder) -> [StrictText] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map StrictText -> Builder
Builder.fromText ([StrictText] -> [Builder]) -> [StrictText] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> StrictText -> [StrictText]
Text.split Char -> Bool
isNewline (HasCallStack =>
StrictText -> StrictText -> StrictText -> StrictText
StrictText -> StrictText -> StrictText -> StrictText
Text.replace StrictText
"\r\n" StrictText
"\n" (StrictText -> StrictText) -> StrictText -> StrictText
forall a b. (a -> b) -> a -> b
$ StrictText -> StrictText
strip StrictText
string)
      encoded :: [Builder] -> Builder
encoded [] = StrictText -> Builder
oneLine StrictText
string
      encoded [Builder
_] = StrictText -> Builder
oneLine StrictText
string
      encoded [Builder]
lines'' = Builder
tripleQuote Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
transformLines [Builder]
lines''
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Builder.fromLazyText (Word -> Text
forall a. Integral a => a -> Text
indent Word
indentation) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
tripleQuote
      transformLines :: [Builder] -> Builder
transformLines = (Builder -> Builder -> Builder) -> Builder -> [Builder] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Builder -> Builder -> Builder
transformLine Builder
forall a. Monoid a => a
mempty
      transformLine :: Builder -> Builder -> Builder
transformLine Builder
"" Builder
acc = Builder
newline Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
acc
      transformLine Builder
line' Builder
acc
            = Text -> Builder
Builder.fromLazyText (Word -> Text
forall a. Integral a => a -> Text
indent (Word
indentation Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1))
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
line' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
acc

listValue :: Formatter -> [Full.Node Full.Value] -> Lazy.Text
listValue :: Formatter -> [Node Value] -> Text
listValue Formatter
formatter = Formatter -> (Node Value -> Text) -> [Node Value] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracketsCommas Formatter
formatter ((Node Value -> Text) -> [Node Value] -> Text)
-> (Node Value -> Text) -> [Node Value] -> Text
forall a b. (a -> b) -> a -> b
$ Formatter -> Value -> Text
value Formatter
formatter (Value -> Text) -> (Node Value -> Value) -> Node Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node Value -> Value
forall a. Node a -> a
Full.node

objectValue :: Formatter -> [Full.ObjectField Full.Value] -> Lazy.Text
objectValue :: Formatter -> [ObjectField Value] -> Text
objectValue Formatter
formatter = (ObjectField Value -> Text) -> [ObjectField Value] -> Text
forall a. (a -> Text) -> [a] -> Text
intercalate ((ObjectField Value -> Text) -> [ObjectField Value] -> Text)
-> (ObjectField Value -> Text) -> [ObjectField Value] -> Text
forall a b. (a -> b) -> a -> b
$ Formatter -> ObjectField Value -> Text
objectField Formatter
formatter
  where
    intercalate :: (a -> Text) -> [a] -> Text
intercalate a -> Text
f
        = Text -> Text
braces
        (Text -> Text) -> ([a] -> Text) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Lazy.Text.intercalate (Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
", " Text
",")
        ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Text
f

objectField :: Formatter -> Full.ObjectField Full.Value -> Lazy.Text
objectField :: Formatter -> ObjectField Value -> Text
objectField Formatter
formatter (Full.ObjectField StrictText
name (Full.Node Value
value' Location
_) Location
_) =
    StrictText -> Text
Lazy.Text.fromStrict StrictText
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text
colon Formatter
formatter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Value -> Text
value Formatter
formatter Value
value'

-- | Converts a 'Full.Type' a type into a string.
type' :: Full.Type -> Lazy.Text
type' :: Type -> Text
type' (Full.TypeNamed StrictText
x) = StrictText -> Text
Lazy.Text.fromStrict StrictText
x
type' (Full.TypeList Type
x) = Type -> Text
listType Type
x
type' (Full.TypeNonNull NonNullType
x) = NonNullType -> Text
nonNullType NonNullType
x

listType :: Full.Type -> Lazy.Text
listType :: Type -> Text
listType Type
x = Text -> Text
brackets (Type -> Text
type' Type
x)

nonNullType :: Full.NonNullType -> Lazy.Text
nonNullType :: NonNullType -> Text
nonNullType (Full.NonNullTypeNamed StrictText
x) = StrictText -> Text
Lazy.Text.fromStrict StrictText
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"!"
nonNullType (Full.NonNullTypeList Type
x) = Type -> Text
listType Type
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"!"

-- | Produces lowercase operation type: query, mutation or subscription.
operationType :: Formatter -> Full.OperationType -> Lazy.Text
operationType :: Formatter -> OperationType -> Text
operationType Formatter
_formatter OperationType
Full.Query = Text
"query"
operationType Formatter
_formatter OperationType
Full.Mutation = Text
"mutation"
operationType Formatter
_formatter OperationType
Full.Subscription = Text
"subscription"

-- * Internal

between :: Char -> Char -> Lazy.Text -> Lazy.Text
between :: Char -> Char -> Text -> Text
between Char
open Char
close = Char -> Text -> Text
Lazy.Text.cons Char
open (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text
`Lazy.Text.snoc` Char
close)

parens :: Lazy.Text -> Lazy.Text
parens :: Text -> Text
parens = Char -> Char -> Text -> Text
between Char
'(' Char
')'

brackets :: Lazy.Text -> Lazy.Text
brackets :: Text -> Text
brackets = Char -> Char -> Text -> Text
between Char
'[' Char
']'

braces :: Lazy.Text -> Lazy.Text
braces :: Text -> Text
braces = Char -> Char -> Text -> Text
between Char
'{' Char
'}'

spaces :: forall a. (a -> Lazy.Text) -> [a] -> Lazy.Text
spaces :: forall a. (a -> Text) -> [a] -> Text
spaces a -> Text
f = Text -> [Text] -> Text
Lazy.Text.intercalate Text
"\SP" ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Text
f

parensCommas :: forall a. Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
parensCommas :: forall a. Formatter -> (a -> Text) -> [a] -> Text
parensCommas Formatter
formatter a -> Text
f
    = Text -> Text
parens
    (Text -> Text) -> ([a] -> Text) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Lazy.Text.intercalate (Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
", " Text
",")
    ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Text
f

bracketsCommas :: Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
bracketsCommas :: forall a. Formatter -> (a -> Text) -> [a] -> Text
bracketsCommas Formatter
formatter a -> Text
f
    = Text -> Text
brackets
    (Text -> Text) -> ([a] -> Text) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Lazy.Text.intercalate (Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
", " Text
",")
    ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Text
f

bracesList :: forall a. Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
bracesList :: forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList (Pretty Word
intendation) a -> Text
f [a]
xs
    = Text -> Char -> Text
Lazy.Text.snoc (Text -> [Text] -> Text
Lazy.Text.intercalate Text
"\n" [Text]
content) Char
'\n'
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Char -> Text
Lazy.Text.snoc (Text -> Char -> Text) -> Text -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Int64 -> Text -> Text
Lazy.Text.replicate (Word -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
intendation) Text
"  ") Char
'}'
  where
    content :: [Text]
content = Text
"{" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Text
f [a]
xs
bracesList Formatter
Minified a -> Text
f [a]
xs = Text -> Text
braces (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Lazy.Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Text
f [a]
xs

optempty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty :: forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty a -> b
f a
xs = if a
xs a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty then b
forall a. Monoid a => a
mempty else a -> b
f a
xs

eitherFormat :: forall a. Formatter -> a -> a -> a
eitherFormat :: forall a. Formatter -> a -> a -> a
eitherFormat (Pretty Word
_) a
x a
_ = a
x
eitherFormat Formatter
Minified a
_ a
x = a
x