OSS/graphql
1
1
Fork 1
Code Issues 5 Pull Requests Actions Releases 22 Wiki Activity

Put spaces between tokens in the pretty printer

Browse Source
This commit is contained in:
Eugen Wissner 2019-08-02 13:52:51 +02:00
parent 4812c8f039
commit 989e418cc2
3 changed files with 109 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CHANGELOG.md
View File

@ -9,6 +9,8 @@ All notable changes to this project will be documented in this file.
### Changed ### Changed
- `Operation` includes now possible operation name which allows to support - `Operation` includes now possible operation name which allows to support
documents with multiple operations. documents with multiple operations.
- `Language.GraphQL.Encoder.document` and other encoding functions take a
`Formatter` as argument to distinguish between minified and pretty printing.
### Removed ### Removed
- Unused `Language.GraphQL.Encoder.spaced`. - Unused `Language.GraphQL.Encoder.spaced`.

153
src/Language/GraphQL/Encoder.hs
View File

@ -1,4 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExplicitForAll #-}
-- | This module defines a printer for the @GraphQL@ language. -- | This module defines a printer for the @GraphQL@ language.
module Language.GraphQL.Encoder module Language.GraphQL.Encoder
( Formatter(..) ( Formatter(..)
@ -42,31 +44,38 @@ operationDefinition :: Formatter -> OperationDefinition -> Text
operationDefinition formatter (OperationSelectionSet sels) operationDefinition formatter (OperationSelectionSet sels)
= selectionSet formatter sels = selectionSet formatter sels
operationDefinition formatter (OperationDefinition Query name vars dirs sels) operationDefinition formatter (OperationDefinition Query name vars dirs sels)
= "query " <> node formatter (fold name) vars dirs sels = "query " <> node formatter name vars dirs sels
operationDefinition formatter (OperationDefinition Mutation name vars dirs sels) operationDefinition formatter (OperationDefinition Mutation name vars dirs sels)
= "mutation " <> node formatter (fold name) vars dirs sels = "mutation " <> node formatter name vars dirs sels
node :: Formatter node :: Formatter
-> Name -> Maybe Name
-> VariableDefinitions -> VariableDefinitions
-> Directives -> Directives
-> SelectionSet -> SelectionSet
-> Text -> Text
node formatter name vars dirs sels node formatter name vars dirs sels
= name = fold name
<> optempty variableDefinitions vars <> optempty (variableDefinitions formatter) vars
<> optempty directives dirs <> optempty (directives formatter) dirs
<> eitherFormat formatter " " mempty
<> selectionSet formatter sels <> selectionSet formatter sels
variableDefinitions :: [VariableDefinition] -> Text variableDefinitions :: Formatter -> [VariableDefinition] -> Text
variableDefinitions = parensCommas variableDefinition variableDefinitions formatter
= parensCommas formatter $ variableDefinition formatter
variableDefinition :: VariableDefinition -> Text variableDefinition :: Formatter -> VariableDefinition -> Text
variableDefinition (VariableDefinition var ty dv) = variableDefinition formatter (VariableDefinition var ty dv)
variable var <> ":" <> type_ ty <> maybe mempty defaultValue dv = variable var
<> eitherFormat formatter ": " ":"
<> type_ ty
<> maybe mempty (defaultValue formatter) dv
defaultValue :: Value -> Text defaultValue :: Formatter -> Value -> Text
defaultValue val = "=" <> value val defaultValue formatter val
= eitherFormat formatter " = " "="
<> value formatter val
variable :: Name -> Text variable :: Name -> Text
variable var = "$" <> var variable var = "$" <> var
@ -82,54 +91,64 @@ selectionSetOpt Minified = bracesCommas $ selection Minified
selection :: Formatter -> Selection -> Text selection :: Formatter -> Selection -> Text
selection formatter (SelectionField x) = field formatter x selection formatter (SelectionField x) = field formatter x
selection formatter (SelectionInlineFragment x) = inlineFragment formatter x selection formatter (SelectionInlineFragment x) = inlineFragment formatter x
selection _ (SelectionFragmentSpread x) = fragmentSpread x selection formatter (SelectionFragmentSpread x) = fragmentSpread formatter x
field :: Formatter -> Field -> Text field :: Formatter -> Field -> Text
field formatter (Field alias name args dirs selso) = field formatter (Field alias name args dirs selso)
optempty (`Text.append` ":") (fold alias) = optempty (`Text.append` colon) (fold alias)
<> name <> name
<> optempty arguments args <> optempty (arguments formatter) args
<> optempty directives dirs <> optempty (directives formatter) dirs
<> optempty (selectionSetOpt formatter) selso <> selectionSetOpt'
where
colon = eitherFormat formatter ": " ":"
selectionSetOpt'
| null selso = mempty
| otherwise = eitherFormat formatter " " mempty <> selectionSetOpt formatter selso
arguments :: [Argument] -> Text arguments :: Formatter -> [Argument] -> Text
arguments = parensCommas argument arguments formatter = parensCommas formatter $ argument formatter
argument :: Argument -> Text argument :: Formatter -> Argument -> Text
argument (Argument name v) = name <> ":" <> value v argument formatter (Argument name v)
= name
<> eitherFormat formatter ": " ":"
<> value formatter v
-- * Fragments -- * Fragments
fragmentSpread :: FragmentSpread -> Text fragmentSpread :: Formatter -> FragmentSpread -> Text
fragmentSpread (FragmentSpread name ds) = fragmentSpread formatter (FragmentSpread name ds) =
"..." <> name <> optempty directives ds "..." <> name <> optempty (directives formatter) ds
inlineFragment :: Formatter -> InlineFragment -> Text inlineFragment :: Formatter -> InlineFragment -> Text
inlineFragment formatter (InlineFragment tc dirs sels) = inlineFragment formatter (InlineFragment tc dirs sels)
"... on " <> fold tc = "... on " <> fold tc
<> directives dirs <> directives formatter dirs
<> eitherFormat formatter " " mempty
<> selectionSet formatter sels <> selectionSet formatter sels
fragmentDefinition :: Formatter -> FragmentDefinition -> Text fragmentDefinition :: Formatter -> FragmentDefinition -> Text
fragmentDefinition formatter (FragmentDefinition name tc dirs sels) = fragmentDefinition formatter (FragmentDefinition name tc dirs sels)
"fragment " <> name <> " on " <> tc = "fragment " <> name <> " on " <> tc
<> optempty directives dirs <> optempty (directives formatter) dirs
<> eitherFormat formatter " " mempty
<> selectionSet formatter sels <> selectionSet formatter sels
-- * Values -- * Values
value :: Value -> Text value :: Formatter -> Value -> Text
value (ValueVariable x) = variable x value _ (ValueVariable x) = variable x
-- TODO: This will be replaced with `decimal` Builder -- TODO: This will be replaced with `decimal` Builder
value (ValueInt x) = pack $ show x value _ (ValueInt x) = pack $ show x
-- TODO: This will be replaced with `decimal` Builder -- TODO: This will be replaced with `decimal` Builder
value (ValueFloat x) = pack $ show x value _ (ValueFloat x) = pack $ show x
value (ValueBoolean x) = booleanValue x value _ (ValueBoolean x) = booleanValue x
value ValueNull = mempty value _ ValueNull = mempty
value (ValueString x) = stringValue x value _ (ValueString x) = stringValue x
value (ValueEnum x) = x value _ (ValueEnum x) = x
value (ValueList x) = listValue x value formatter (ValueList x) = listValue formatter x
value (ValueObject x) = objectValue x value formatter (ValueObject x) = objectValue formatter x
booleanValue :: Bool -> Text booleanValue :: Bool -> Text
booleanValue True = "true" booleanValue True = "true"
@ -139,22 +158,28 @@ booleanValue False = "false"
stringValue :: Text -> Text stringValue :: Text -> Text
stringValue = quotes stringValue = quotes
listValue :: [Value] -> Text listValue :: Formatter -> [Value] -> Text
listValue = bracketsCommas value listValue formatter = bracketsCommas formatter $ value formatter
objectValue :: [ObjectField] -> Text objectValue :: Formatter -> [ObjectField] -> Text
objectValue = bracesCommas objectField objectValue formatter = bracesCommas $ objectField formatter
objectField :: ObjectField -> Text objectField :: Formatter -> ObjectField -> Text
objectField (ObjectField name v) = name <> ":" <> value v objectField formatter (ObjectField name v) = name <> colon <> value formatter v
where
colon
| Pretty _ <- formatter = ": "
| Minified <- formatter = ":"
-- * Directives -- * Directives
directives :: [Directive] -> Text directives :: Formatter -> [Directive] -> Text
directives = spaces directive directives formatter@(Pretty _) = Text.cons ' ' . spaces (directive formatter)
directives Minified = spaces (directive Minified)
directive :: Directive -> Text directive :: Formatter -> Directive -> Text
directive (Directive name args) = "@" <> name <> optempty arguments args directive formatter (Directive name args)
= "@" <> name <> optempty (arguments formatter) args
-- * Type Reference -- * Type Reference
@ -187,20 +212,30 @@ braces = between '{' '}'
quotes :: Text -> Text quotes :: Text -> Text
quotes = between '"' '"' quotes = between '"' '"'
spaces :: (a -> Text) -> [a] -> Text spaces :: forall a. (a -> Text) -> [a] -> Text
spaces f = Text.intercalate "\SP" . fmap f spaces f = Text.intercalate "\SP" . fmap f
parensCommas :: (a -> Text) -> [a] -> Text parensCommas :: forall a. Formatter -> (a -> Text) -> [a] -> Text
parensCommas f = parens . Text.intercalate "," . fmap f parensCommas formatter f
= parens
. Text.intercalate (eitherFormat formatter ", " ",")
. fmap f
bracketsCommas :: (a -> Text) -> [a] -> Text bracketsCommas :: Formatter -> (a -> Text) -> [a] -> Text
bracketsCommas f = brackets . Text.intercalate "," . fmap f bracketsCommas formatter f
= brackets
. Text.intercalate (eitherFormat formatter ", " ",")
. fmap f
bracesCommas :: (a -> Text) -> [a] -> Text bracesCommas :: forall a. (a -> Text) -> [a] -> Text
bracesCommas f = braces . Text.intercalate "," . fmap f bracesCommas f = braces . Text.intercalate "," . fmap f
bracesNewLines :: (a -> Text) -> [a] -> Text bracesNewLines :: forall a. (a -> Text) -> [a] -> Text
bracesNewLines f xs = Text.append (Text.intercalate "\n" $ "{" : fmap f xs) "\n}" bracesNewLines f xs = Text.append (Text.intercalate "\n" $ "{" : fmap f xs) "\n}"
optempty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b optempty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty f xs = if xs == mempty then mempty else f xs optempty f xs = if xs == mempty then mempty else f xs
eitherFormat :: forall a. Formatter -> a -> a -> a
eitherFormat (Pretty _) pretty _ = pretty
eitherFormat Minified _ minified = minified