{-# 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'
    , value
    ) where

import Data.Foldable (fold)
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

-- | 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 (forall a. Monoid a => [a] -> a
mconcat [Text]
encodeDocument) Char
'\n'
  where
    encodeDocument :: [Text]
encodeDocument = 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' forall a. a -> [a] -> [a]
: [Text]
acc
    executableDefinition Definition
_ [Text]
acc = [Text]
acc

-- | 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 Text
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels Location
_ ->
        Text
"query " forall a. Semigroup a => a -> a -> a
<> Maybe Text
-> [VariableDefinition] -> [Directive] -> SelectionSet -> Text
root Maybe Text
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels
    Full.OperationDefinition OperationType
Full.Mutation Maybe Text
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels Location
_ ->
        Text
"mutation " forall a. Semigroup a => a -> a -> a
<> Maybe Text
-> [VariableDefinition] -> [Directive] -> SelectionSet -> Text
root Maybe Text
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels
    Full.OperationDefinition OperationType
Full.Subscription Maybe Text
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels Location
_ ->
        Text
"subscription " forall a. Semigroup a => a -> a -> a
<> Maybe Text
-> [VariableDefinition] -> [Directive] -> SelectionSet -> Text
root Maybe Text
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 Text
-> [VariableDefinition] -> [Directive] -> SelectionSet -> Text
root Maybe Text
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels
        = Text -> Text
Lazy.Text.fromStrict (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Text
name)
        forall a. Semigroup a => a -> a -> a
<> forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [VariableDefinition] -> Text
variableDefinitions Formatter
formatter) [VariableDefinition]
vars
        forall a. Semigroup a => a -> a -> a
<> forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
dirs
        forall a. Semigroup a => a -> a -> a
<> forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " forall a. Monoid a => a
mempty
        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
    = forall a. Formatter -> (a -> Text) -> [a] -> Text
parensCommas Formatter
formatter 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 Text
variableName Type
variableType Maybe (Node ConstValue)
defaultValue' Location
_ =
            VariableDefinition
variableDefinition'
     in Text -> Text
variable Text
variableName
    forall a. Semigroup a => a -> a -> a
<> forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
": " Text
":"
    forall a. Semigroup a => a -> a -> a
<> Type -> Text
type' Type
variableType
    forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (Formatter -> ConstValue -> Text
defaultValue Formatter
formatter forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    = forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter 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 :: Text -> Text
variable Text
var = Text
"$" forall a. Semigroup a => a -> a -> a
<> Text -> Text
Lazy.Text.fromStrict Text
var

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

selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text
selectionSetOpt :: Formatter -> SelectionSetOpt -> Text
selectionSetOpt Formatter
formatter = forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter 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 (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 Text
indent' 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
incrementIndent Field
fieldSelection
    encodeSelection (Full.InlineFragmentSelection InlineFragment
fragmentSelection) =
        Formatter -> InlineFragment -> Text
inlineFragment Formatter
incrementIndent InlineFragment
fragmentSelection
    encodeSelection (Full.FragmentSpreadSelection FragmentSpread
fragmentSelection) =
        Formatter -> FragmentSpread -> Text
fragmentSpread Formatter
incrementIndent FragmentSpread
fragmentSelection
    incrementIndent :: Formatter
incrementIndent
        | Pretty Word
indentation <- Formatter
formatter = Word -> Formatter
Pretty forall a b. (a -> b) -> a -> b
$ Word
indentation forall a. Num a => a -> a -> a
+ Word
1
        | Bool
otherwise = Formatter
Minified
    indent' :: Text
indent'
        | Pretty Word
indentation <- Formatter
formatter = forall a. Integral a => a -> Text
indent forall a b. (a -> b) -> a -> b
$ Word
indentation forall a. Num a => a -> a -> a
+ Word
1
        | Bool
otherwise = Text
""

colon :: Formatter -> Lazy.Text
colon :: Formatter -> Text
colon Formatter
formatter = 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 Text
alias Text
name [Argument]
args [Directive]
dirs SelectionSetOpt
set Location
_)
    = forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty Text -> Text
prependAlias (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Text
alias)
    forall a. Semigroup a => a -> a -> a
<> Text -> Text
Lazy.Text.fromStrict Text
name
    forall a. Semigroup a => a -> a -> a
<> forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Argument] -> Text
arguments Formatter
formatter) [Argument]
args
    forall a. Semigroup a => a -> a -> a
<> forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
dirs
    forall a. Semigroup a => a -> a -> a
<> forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty SelectionSetOpt -> Text
selectionSetOpt' SelectionSetOpt
set
  where
    prependAlias :: Text -> Text
prependAlias Text
aliasName = Text -> Text
Lazy.Text.fromStrict Text
aliasName forall a. Semigroup a => a -> a -> a
<>  Formatter -> Text
colon Formatter
formatter
    selectionSetOpt' :: SelectionSetOpt -> Text
selectionSetOpt' = (forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " Text
"" forall a. Semigroup a => a -> a -> a
<>)
        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 = forall a. Formatter -> (a -> Text) -> [a] -> Text
parensCommas Formatter
formatter 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 Text
name Node Value
value' Location
_)
    = Text -> Text
Lazy.Text.fromStrict Text
name
    forall a. Semigroup a => a -> a -> a
<> Formatter -> Text
colon Formatter
formatter
    forall a. Semigroup a => a -> a -> a
<> Formatter -> Value -> Text
value Formatter
formatter (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 Text
name [Directive]
directives' Location
_)
    = Text
"..." forall a. Semigroup a => a -> a -> a
<> Text -> Text
Lazy.Text.fromStrict Text
name
    forall a. Semigroup a => a -> a -> a
<> 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 Text
typeCondition [Directive]
directives' SelectionSet
selections Location
_)
    = Text
"... on "
    forall a. Semigroup a => a -> a -> a
<> Text -> Text
Lazy.Text.fromStrict (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Text
typeCondition)
    forall a. Semigroup a => a -> a -> a
<> Formatter -> [Directive] -> Text
directives Formatter
formatter [Directive]
directives'
    forall a. Semigroup a => a -> a -> a
<> forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " forall a. Monoid a => a
mempty
    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 Text
name Text
tc [Directive]
dirs SelectionSet
sels Location
_)
    = Text
"fragment " forall a. Semigroup a => a -> a -> a
<> Text -> Text
Lazy.Text.fromStrict Text
name
    forall a. Semigroup a => a -> a -> a
<> Text
" on " forall a. Semigroup a => a -> a -> a
<> Text -> Text
Lazy.Text.fromStrict Text
tc
    forall a. Semigroup a => a -> a -> a
<> forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty (Formatter -> [Directive] -> Text
directives Formatter
formatter) [Directive]
dirs
    forall a. Semigroup a => a -> a -> a
<> forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
" " forall a. Monoid a => a
mempty
    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 Text
name [Argument]
args Location
_)
    = Text
"@" forall a. Semigroup a => a -> a -> a
<> Text -> Text
Lazy.Text.fromStrict Text
name forall a. Semigroup a => a -> a -> a
<> 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 = forall a. (a -> Text) -> [a] -> Text
spaces (Formatter -> Directive -> Text
directive Formatter
Minified)
directives Formatter
formatter = Char -> Text -> Text
Lazy.Text.cons Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Text) -> [a] -> Text
spaces (Formatter -> Directive -> Text
directive Formatter
formatter)

-- | Converts a 'Full.Value' into a string.
value :: Formatter -> Full.Value -> Lazy.Text
value :: Formatter -> Value -> Text
value Formatter
_ (Full.Variable Text
x) = Text -> Text
variable Text
x
value Formatter
_ (Full.Int Int32
x) = Builder -> Text
Builder.toLazyText forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Builder
decimal Int32
x
value Formatter
_ (Full.Float Double
x) = Builder -> Text
Builder.toLazyText forall a b. (a -> b) -> a -> b
$ 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 Text
string) = Formatter -> Text -> Text
stringValue Formatter
formatter Text
string
value Formatter
_ (Full.Enum Text
x) = Text -> Text
Lazy.Text.fromStrict Text
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 Text
string) = Text -> Value
Full.String Text
string
fromConstValue (Full.ConstEnum Text
x) = Text -> Value
Full.Enum Text
x
fromConstValue (Full.ConstList [Node ConstValue]
x) = [Node Value] -> Value
Full.List forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstValue -> Value
fromConstValue 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 forall a b. (a -> b) -> a -> b
$ ObjectField ConstValue -> ObjectField Value
fromConstObjectField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ObjectField ConstValue]
x
  where
    fromConstObjectField :: ObjectField ConstValue -> ObjectField Value
fromConstObjectField Full.ObjectField{$sel:value:ObjectField :: forall a. ObjectField a -> Node a
value = Node ConstValue
value', Text
Location
$sel:location:ObjectField :: forall a. ObjectField a -> Location
$sel:name:ObjectField :: forall a. ObjectField a -> Text
location :: Location
name :: Text
..} =
        forall a. Text -> Node a -> Location -> ObjectField a
Full.ObjectField Text
name (ConstValue -> Value
fromConstValue 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 :: Text -> Builder
oneLine Text
string = Builder
quote forall a. Semigroup a => a -> a -> a
<> forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr Char -> Builder -> Builder
merge Builder
quote Text
string
  where
    merge :: Char -> Builder -> Builder
merge = forall a. Monoid a => a -> a -> a
mappend forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
Builder.fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
Full.escape

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

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

      strip :: Text -> Text
strip = (Char -> Bool) -> Text -> Text
Text.dropWhile Char -> Bool
isWhiteSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.dropWhileEnd Char -> Bool
isWhiteSpace
      lines' :: [Builder]
lines' = forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
Builder.fromText forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
Text.split Char -> Bool
isNewline (Text -> Text -> Text -> Text
Text.replace Text
"\r\n" Text
"\n" forall a b. (a -> b) -> a -> b
$ Text -> Text
strip Text
string)
      encoded :: [Builder] -> Builder
encoded [] = Text -> Builder
oneLine Text
string
      encoded [Builder
_] = Text -> Builder
oneLine Text
string
      encoded [Builder]
lines'' = Builder
tripleQuote forall a. Semigroup a => a -> a -> a
<> Builder
newline
        forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
transformLines [Builder]
lines''
        forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Builder.fromLazyText (forall a. Integral a => a -> Text
indent Word
indentation) forall a. Semigroup a => a -> a -> a
<> Builder
tripleQuote
      transformLines :: [Builder] -> Builder
transformLines = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Builder -> Builder -> Builder
transformLine forall a. Monoid a => a
mempty
      transformLine :: Builder -> Builder -> Builder
transformLine Builder
"" Builder
acc = Builder
newline forall a. Semigroup a => a -> a -> a
<> Builder
acc
      transformLine Builder
line' Builder
acc
            = Text -> Builder
Builder.fromLazyText (forall a. Integral a => a -> Text
indent (Word
indentation forall a. Num a => a -> a -> a
+ Word
1))
            forall a. Semigroup a => a -> a -> a
<> Builder
line' forall a. Semigroup a => a -> a -> a
<> Builder
newline 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 = forall a. Formatter -> (a -> Text) -> [a] -> Text
bracketsCommas Formatter
formatter forall a b. (a -> b) -> a -> b
$ Formatter -> Value -> Text
value Formatter
formatter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Node a -> a
Full.node

objectValue :: Formatter -> [Full.ObjectField Full.Value] -> Lazy.Text
objectValue :: Formatter -> [ObjectField Value] -> Text
objectValue Formatter
formatter = forall a. (a -> Text) -> [a] -> Text
intercalate 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
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Lazy.Text.intercalate (forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
", " Text
",")
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 Text
name (Full.Node Value
value' Location
_) Location
_) =
    Text -> Text
Lazy.Text.fromStrict Text
name forall a. Semigroup a => a -> a -> a
<> Formatter -> Text
colon Formatter
formatter 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 Text
x) = Text -> Text
Lazy.Text.fromStrict Text
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 Text
x) = Text -> Text
Lazy.Text.fromStrict Text
x forall a. Semigroup a => a -> a -> a
<> Text
"!"
nonNullType (Full.NonNullTypeList Type
x) = Type -> Text
listType Type
x 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 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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Lazy.Text.intercalate (forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
", " Text
",")
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Lazy.Text.intercalate (forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter Text
", " Text
",")
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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'
    forall a. Semigroup a => a -> a -> a
<> (Text -> Char -> Text
Lazy.Text.snoc forall a b. (a -> b) -> a -> b
$ Int64 -> Text -> Text
Lazy.Text.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
intendation) Text
"  ") Char
'}'
  where
    content :: [Text]
content = Text
"{" forall a. a -> [a] -> [a]
: 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 forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Lazy.Text.intercalate 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 forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty then 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