{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe #-}
module Language.GraphQL.AST.Encoder
( Formatter
, definition
, directive
, document
, minified
, 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
data Formatter
= Minified
| Pretty Word
pretty :: Formatter
pretty :: Formatter
pretty = Word -> Formatter
Pretty Word
0
minified :: Formatter
minified :: Formatter
minified = Formatter
Minified
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 (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 Definition
_ [Text]
acc = [Text]
acc
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
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 Name
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels Location
_ ->
Text
"query " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Name
-> [VariableDefinition] -> [Directive] -> SelectionSet -> Text
root Maybe Name
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels
Full.OperationDefinition OperationType
Full.Mutation Maybe Name
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels Location
_ ->
Text
"mutation " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Name
-> [VariableDefinition] -> [Directive] -> SelectionSet -> Text
root Maybe Name
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels
Full.OperationDefinition OperationType
Full.Subscription Maybe Name
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels Location
_ ->
Text
"subscription " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Name
-> [VariableDefinition] -> [Directive] -> SelectionSet -> Text
root Maybe Name
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels
where
root :: Maybe Full.Name ->
[Full.VariableDefinition] ->
[Full.Directive] ->
Full.SelectionSet ->
Lazy.Text
root :: Maybe Name
-> [VariableDefinition] -> [Directive] -> SelectionSet -> Text
root Maybe Name
name [VariableDefinition]
vars [Directive]
dirs SelectionSet
sels
= Name -> Text
Lazy.Text.fromStrict (Maybe Name -> Name
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Name
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 Name
variableName Type
variableType Maybe (Node ConstValue)
defaultValue' Location
_ =
VariableDefinition
variableDefinition'
in Name -> Text
variable Name
variableName
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
<> Type -> Text
type' Type
variableType
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (ConstValue -> Text) -> Maybe 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) (Node ConstValue -> ConstValue
forall a. Node a -> a
Full.node (Node ConstValue -> ConstValue)
-> Maybe (Node ConstValue) -> Maybe ConstValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: Name -> Text
variable Name
var = Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Lazy.Text.fromStrict Name
var
selectionSet :: Formatter -> Full.SelectionSet -> Lazy.Text
selectionSet :: Formatter -> SelectionSet -> Text
selectionSet Formatter
formatter
= Formatter -> (Selection -> Text) -> [Selection] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter (Formatter -> Selection -> Text
selection Formatter
formatter)
([Selection] -> Text)
-> (SelectionSet -> [Selection]) -> SelectionSet -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionSet -> [Selection]
forall a. NonEmpty a -> [a]
NonEmpty.toList
selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text
selectionSetOpt :: Formatter -> [Selection] -> Text
selectionSetOpt Formatter
formatter = Formatter -> (Selection -> Text) -> [Selection] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracesList Formatter
formatter ((Selection -> Text) -> [Selection] -> Text)
-> (Selection -> Text) -> [Selection] -> 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 :: 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 Text
indent' (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
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 (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
indent' :: Text
indent'
| Pretty Word
indentation <- Formatter
formatter = Word -> Text
forall a. Integral a => a -> Text
indent (Word -> Text) -> Word -> Text
forall a b. (a -> b) -> a -> b
$ Word
indentation Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1
| Bool
otherwise = Text
""
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
":"
field :: Formatter -> Full.Field -> Lazy.Text
field :: Formatter -> Field -> Text
field Formatter
formatter (Full.Field Maybe Name
alias Name
name [Argument]
args [Directive]
dirs [Selection]
set Location
_)
= (Name -> Text) -> Name -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty Name -> Text
prependAlias (Maybe Name -> Name
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Name
alias)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Lazy.Text.fromStrict Name
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
<> ([Selection] -> Text) -> [Selection] -> Text
forall a b. (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty [Selection] -> Text
selectionSetOpt' [Selection]
set
where
prependAlias :: Name -> Text
prependAlias Name
aliasName = Name -> Text
Lazy.Text.fromStrict Name
aliasName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Formatter -> Text
colon Formatter
formatter
selectionSetOpt' :: [Selection] -> 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) -> ([Selection] -> Text) -> [Selection] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatter -> [Selection] -> 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 Name
name Node Value
value' Location
_)
= Name -> Text
Lazy.Text.fromStrict Name
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')
fragmentSpread :: Formatter -> Full.FragmentSpread -> Lazy.Text
fragmentSpread :: Formatter -> FragmentSpread -> Text
fragmentSpread Formatter
formatter (Full.FragmentSpread Name
name [Directive]
directives' Location
_)
= Text
"..." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Lazy.Text.fromStrict Name
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 Name
typeCondition [Directive]
directives' SelectionSet
selections Location
_)
= Text
"... on "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Lazy.Text.fromStrict (Maybe Name -> Name
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Name
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 Name
name Name
tc [Directive]
dirs SelectionSet
sels Location
_)
= Text
"fragment " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Lazy.Text.fromStrict Name
name
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" on " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Lazy.Text.fromStrict Name
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
directive :: Formatter -> Full.Directive -> Lazy.Text
directive :: Formatter -> Directive -> Text
directive Formatter
formatter (Full.Directive Name
name [Argument]
args Location
_)
= Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Lazy.Text.fromStrict Name
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 -> Text) -> [Directive] -> Text
forall a. (a -> Text) -> [a] -> Text
spaces (Formatter -> Directive -> Text
directive Formatter
Minified)
directives Formatter
formatter = Char -> Text -> Text
Lazy.Text.cons Char
' ' (Text -> Text) -> ([Directive] -> Text) -> [Directive] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Directive -> Text) -> [Directive] -> Text
forall a. (a -> Text) -> [a] -> Text
spaces (Formatter -> Directive -> Text
directive Formatter
formatter)
value :: Formatter -> Full.Value -> Lazy.Text
value :: Formatter -> Value -> Text
value Formatter
_ (Full.Variable Name
x) = Name -> Text
variable Name
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 Name
string) = Formatter -> Name -> Text
stringValue Formatter
formatter Name
string
value Formatter
_ (Full.Enum Name
x) = Name -> Text
Lazy.Text.fromStrict Name
x
value Formatter
formatter (Full.List [Value]
x) = Formatter -> [Value] -> Text
listValue Formatter
formatter [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 Name
string) = Name -> Value
Full.String Name
string
fromConstValue (Full.ConstEnum Name
x) = Name -> Value
Full.Enum Name
x
fromConstValue (Full.ConstList [ConstValue]
x) = [Value] -> Value
Full.List ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ ConstValue -> Value
fromConstValue (ConstValue -> Value) -> [ConstValue] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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{$sel:value:ObjectField :: forall a. ObjectField a -> Node a
value = Node ConstValue
value', Name
Location
$sel:location:ObjectField :: forall a. ObjectField a -> Location
$sel:name:ObjectField :: forall a. ObjectField a -> Name
location :: Location
name :: Name
..} =
Name -> Node Value -> Location -> ObjectField Value
forall a. Name -> Node a -> Location -> ObjectField a
Full.ObjectField Name
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 :: Name -> Builder
oneLine Name
string = Builder
quote Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Char -> Builder -> Builder) -> Builder -> Name -> Builder
forall a. (Char -> a -> a) -> a -> Name -> a
Text.foldr Char -> Builder -> Builder
merge Builder
quote Name
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 -> Name -> Text
stringValue Formatter
Minified Name
string = Builder -> Text
Builder.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Builder
oneLine Name
string
stringValue (Pretty Word
indentation) Name
string =
if Name -> Bool
hasEscaped Name
string
then Formatter -> Name -> Text
stringValue Formatter
Minified Name
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 :: Name -> Bool
hasEscaped = (Char -> Bool) -> Name -> 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 = Name -> Builder
Builder.fromText Name
"\"\"\""
newline :: Builder
newline = Char -> Builder
Builder.singleton Char
'\n'
strip :: Name -> Name
strip = (Char -> Bool) -> Name -> Name
Text.dropWhile Char -> Bool
isWhiteSpace (Name -> Name) -> (Name -> Name) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Name -> Name
Text.dropWhileEnd Char -> Bool
isWhiteSpace
lines' :: [Builder]
lines' = (Name -> Builder) -> [Name] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Builder
Builder.fromText ([Name] -> [Builder]) -> [Name] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Name -> [Name]
Text.split Char -> Bool
isNewline (Name -> Name -> Name -> Name
Text.replace Name
"\r\n" Name
"\n" (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Name -> Name
strip Name
string)
encoded :: [Builder] -> Builder
encoded [] = Name -> Builder
oneLine Name
string
encoded [Builder
_] = Name -> Builder
oneLine Name
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 (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.Value] -> Lazy.Text
listValue :: Formatter -> [Value] -> Text
listValue Formatter
formatter = Formatter -> (Value -> Text) -> [Value] -> Text
forall a. Formatter -> (a -> Text) -> [a] -> Text
bracketsCommas Formatter
formatter ((Value -> Text) -> [Value] -> Text)
-> (Value -> Text) -> [Value] -> Text
forall a b. (a -> b) -> a -> b
$ Formatter -> Value -> Text
value Formatter
formatter
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 (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 Name
name (Full.Node Value
value' Location
_) Location
_) =
Name -> Text
Lazy.Text.fromStrict Name
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'
type' :: Full.Type -> Lazy.Text
type' :: Type -> Text
type' (Full.TypeNamed Name
x) = Name -> Text
Lazy.Text.fromStrict Name
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 Name
x) = Name -> Text
Lazy.Text.fromStrict Name
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
"!"
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 :: (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 (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 :: 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Text
f
bracketsCommas :: Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
bracketsCommas :: 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 (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 :: 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 (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 (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 :: (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 :: Formatter -> a -> a -> a
eitherFormat (Pretty Word
_) a
x a
_ = a
x
eitherFormat Formatter
Minified a
_ a
x = a
x