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

import Data.Char (ord)
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, hexadecimal)
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 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
formatter defs :: Document
defs
    | Pretty _ <- Formatter
formatter = Text -> [Text] -> Text
Lazy.Text.intercalate "\n" [Text]
encodeDocument
    | Formatter
Minified <-Formatter
formatter = Text -> Char -> Text
Lazy.Text.snoc ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text]
encodeDocument) '\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
executableDefinition') acc :: [Text]
acc =
        Formatter -> ExecutableDefinition -> Text
definition Formatter
formatter ExecutableDefinition
executableDefinition' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc
    executableDefinition _ acc :: [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
formatter x :: ExecutableDefinition
x
    | Pretty _ <- Formatter
formatter = Text -> Char -> Text
Lazy.Text.snoc (ExecutableDefinition -> Text
encodeDefinition ExecutableDefinition
x) '\n'
    | Formatter
Minified <- Formatter
formatter = ExecutableDefinition -> Text
encodeDefinition ExecutableDefinition
x
  where
    encodeDefinition :: ExecutableDefinition -> Text
encodeDefinition (Full.DefinitionOperation operation :: OperationDefinition
operation)
        = Formatter -> OperationDefinition -> Text
operationDefinition Formatter
formatter OperationDefinition
operation
    encodeDefinition (Full.DefinitionFragment fragment :: 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
formatter = \case
    Full.SelectionSet sels :: SelectionSet
sels _ -> Formatter -> SelectionSet -> Text
selectionSet Formatter
formatter SelectionSet
sels
    Full.OperationDefinition Full.Query name :: Maybe Name
name vars :: [VariableDefinition]
vars dirs :: [Directive]
dirs sels :: SelectionSet
sels _ ->
        "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 Full.Mutation name :: Maybe Name
name vars :: [VariableDefinition]
vars dirs :: [Directive]
dirs sels :: SelectionSet
sels _ ->
        "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 Full.Subscription name :: Maybe Name
name vars :: [VariableDefinition]
vars dirs :: [Directive]
dirs sels :: SelectionSet
sels _ ->
        "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
    -- | Converts a Query or Mutation into a string.
    root :: Maybe Full.Name ->
        [Full.VariableDefinition] ->
        [Full.Directive] ->
        Full.SelectionSet ->
        Lazy.Text
    root :: Maybe Name
-> [VariableDefinition] -> [Directive] -> SelectionSet -> Text
root name :: Maybe Name
name vars :: [VariableDefinition]
vars dirs :: [Directive]
dirs sels :: 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
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
    = 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
formatter variableDefinition' :: VariableDefinition
variableDefinition' =
    let Full.VariableDefinition variableName :: Name
variableName variableType :: Type
variableType defaultValue' :: Maybe (Node ConstValue)
defaultValue' _ =
            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
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
formatter val :: ConstValue
val
    = Formatter -> Text -> Text -> Text
forall a. Formatter -> a -> a -> a
eitherFormat Formatter
formatter " = " "="
    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 var :: Name
var = "$" 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
    = 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 = 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 = "  "

indent :: (Integral a) => a -> Lazy.Text
indent :: a -> Text
indent indentation :: 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
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 fieldSelection :: Field
fieldSelection) =
        Formatter -> Field -> Text
field Formatter
incrementIndent Field
fieldSelection
    encodeSelection (Full.InlineFragmentSelection fragmentSelection :: InlineFragment
fragmentSelection) =
        Formatter -> InlineFragment -> Text
inlineFragment Formatter
incrementIndent InlineFragment
fragmentSelection
    encodeSelection (Full.FragmentSpreadSelection fragmentSelection :: FragmentSpread
fragmentSelection) =
        Formatter -> FragmentSpread -> Text
fragmentSpread Formatter
incrementIndent FragmentSpread
fragmentSelection
    incrementIndent :: Formatter
incrementIndent
        | Pretty indentation :: 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
+ 1
        | Bool
otherwise = Formatter
Minified
    indent' :: Text
indent'
        | Pretty indentation :: 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
+ 1
        | Bool
otherwise = ""

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

-- | Converts Field into a string.
field :: Formatter -> Full.Field -> Lazy.Text
field :: Formatter -> Field -> Text
field formatter :: Formatter
formatter (Full.Field alias :: Maybe Name
alias name :: Name
name args :: [Argument]
args dirs :: [Directive]
dirs set :: [Selection]
set _)
    = (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 aliasName :: 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
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 = 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
formatter (Full.Argument name :: Name
name value' :: Node Value
value' _)
    = 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')

-- * Fragments

fragmentSpread :: Formatter -> Full.FragmentSpread -> Lazy.Text
fragmentSpread :: Formatter -> FragmentSpread -> Text
fragmentSpread formatter :: Formatter
formatter (Full.FragmentSpread name :: Name
name directives' :: [Directive]
directives' _)
    = "..." 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
formatter (Full.InlineFragment typeCondition :: Maybe Name
typeCondition directives' :: [Directive]
directives' selections :: SelectionSet
selections _)
    = "... 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
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
formatter (Full.FragmentDefinition name :: Name
name tc :: Name
tc dirs :: [Directive]
dirs sels :: SelectionSet
sels _)
    = "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
<> " 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
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
formatter (Full.Directive name :: Name
name args :: [Argument]
args _)
    = "@" 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 Minified = (Directive -> Text) -> [Directive] -> Text
forall a. (a -> Text) -> [a] -> Text
spaces (Formatter -> Directive -> Text
directive Formatter
Minified)
directives formatter :: Formatter
formatter = Char -> Text -> Text
Lazy.Text.cons ' ' (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)

-- | Converts a 'Full.Value' into a string.
value :: Formatter -> Full.Value -> Lazy.Text
value :: Formatter -> Value -> Text
value _ (Full.Variable x :: Name
x) = Name -> Text
variable Name
x
value _ (Full.Int x :: 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 _ (Full.Float x :: 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 _ (Full.Boolean  x :: Bool
x) = Bool -> Text
booleanValue Bool
x
value _ Full.Null = "null"
value formatter :: Formatter
formatter (Full.String string :: Name
string) = Formatter -> Name -> Text
stringValue Formatter
formatter Name
string
value _ (Full.Enum x :: Name
x) = Name -> Text
Lazy.Text.fromStrict Name
x
value formatter :: Formatter
formatter (Full.List x :: [Value]
x) = Formatter -> [Value] -> Text
listValue Formatter
formatter [Value]
x
value formatter :: Formatter
formatter (Full.Object x :: [ObjectField Value]
x) = Formatter -> [ObjectField Value] -> Text
objectValue Formatter
formatter [ObjectField Value]
x

fromConstValue :: Full.ConstValue -> Full.Value
fromConstValue :: ConstValue -> Value
fromConstValue (Full.ConstInt x :: Int32
x) = Int32 -> Value
Full.Int Int32
x
fromConstValue (Full.ConstFloat x :: Double
x) = Double -> Value
Full.Float Double
x
fromConstValue (Full.ConstBoolean  x :: Bool
x) = Bool -> Value
Full.Boolean Bool
x
fromConstValue Full.ConstNull = Value
Full.Null
fromConstValue (Full.ConstString string :: Name
string) = Name -> Value
Full.String Name
string
fromConstValue (Full.ConstEnum x :: Name
x) = Name -> Value
Full.Enum Name
x
fromConstValue (Full.ConstList x :: [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 x :: [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 -> 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 True  = "true"
booleanValue False = "false"

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

oneLine :: Text -> Builder
oneLine :: Name -> Builder
oneLine string :: 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 (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
. Char -> Builder
escape) Builder
quote Name
string

stringValue :: Formatter -> Text -> Lazy.Text
stringValue :: Formatter -> Name -> Text
stringValue Minified string :: Name
string = Builder -> Text
Builder.toLazyText
    (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ 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 (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
. Char -> Builder
escape) Builder
quote Name
string
stringValue (Pretty indentation :: Word
indentation) string :: 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 -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' Bool -> Bool -> Bool
|| Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\t'
      isNewline :: Char -> Bool
isNewline char :: Char
char = Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' Bool -> Bool -> Bool
|| Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\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 -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\t' Bool -> Bool -> Bool
|| Char -> Bool
isNewline Char
char Bool -> Bool -> Bool
|| (Char
char Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x0020' Bool -> Bool -> Bool
&& Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\x007F')

      tripleQuote :: Builder
tripleQuote = Name -> Builder
Builder.fromText "\"\"\""
      newline :: Builder
newline = Char -> Builder
Builder.singleton '\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 "\r\n" "\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 [_] = Name -> Builder
oneLine Name
string
      encoded lines'' :: [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 "" acc :: Builder
acc = Builder
newline Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
acc
      transformLine line' :: Builder
line' acc :: 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
+ 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

escape :: Char -> Builder
escape :: Char -> Builder
escape char' :: Char
char'
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\\' = String -> Builder
Builder.fromString "\\\\"
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\"' = String -> Builder
Builder.fromString "\\\""
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\b' = String -> Builder
Builder.fromString "\\b"
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\f' = String -> Builder
Builder.fromString "\\f"
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' = String -> Builder
Builder.fromString "\\n"
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\r' = String -> Builder
Builder.fromString "\\r"
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\t' = String -> Builder
Builder.fromString "\\t"
    | Char
char' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< '\x0010' = String -> Char -> Builder
unicode  "\\u000" Char
char'
    | Char
char' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< '\x0020' = String -> Char -> Builder
unicode "\\u00" Char
char'
    | Bool
otherwise = Char -> Builder
Builder.singleton Char
char'
  where
    unicode :: String -> Char -> Builder
unicode prefix :: String
prefix = Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend (String -> Builder
Builder.fromString String
prefix) (Builder -> Builder) -> (Char -> Builder) -> Char -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Builder
forall a. Integral a => a -> Builder
hexadecimal (Int -> Builder) -> (Char -> Int) -> Char -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)

listValue :: Formatter -> [Full.Value] -> Lazy.Text
listValue :: Formatter -> [Value] -> Text
listValue formatter :: 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
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 f :: 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) -> ([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
formatter (Full.ObjectField name :: Name
name (Full.Node value' :: Value
value' _) _) =
    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'

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

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

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

-- * Internal

between :: Char -> Char -> Lazy.Text -> Lazy.Text
between :: Char -> Char -> Text -> Text
between open :: Char
open close :: 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 '(' ')'

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

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

spaces :: forall a. (a -> Lazy.Text) -> [a] -> Lazy.Text
spaces :: (a -> Text) -> [a] -> Text
spaces f :: a -> Text
f = Text -> [Text] -> Text
Lazy.Text.intercalate "\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
formatter f :: 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) -> ([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
formatter f :: 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) -> ([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 intendation :: Word
intendation) f :: a -> Text
f xs :: [a]
xs
    = Text -> Char -> Text
Lazy.Text.snoc (Text -> [Text] -> Text
Lazy.Text.intercalate "\n" [Text]
content) '\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) "  ") '}'
  where
    content :: [Text]
content = "{" 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 Minified f :: a -> Text
f xs :: [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
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 f :: a -> b
f xs :: 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 _) x :: a
x _ = a
x
eitherFormat Minified _ x :: a
x = a
x