Introduce formatter type for the encoder

... to distinguish between minified and pretty printing.
This commit is contained in:
Eugen Wissner 2019-07-31 05:40:17 +02:00
parent d690d22ce8
commit 4812c8f039
6 changed files with 114 additions and 54 deletions

View File

@ -1,7 +1,8 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
-- | 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
( definition ( Formatter(..)
, definition
, document , document
) where ) where
@ -12,34 +13,50 @@ import Data.Text (Text, pack)
import qualified Data.Text as Text import qualified Data.Text as Text
import Language.GraphQL.AST import Language.GraphQL.AST
-- | Instructs the encoder whether a GraphQL should be minified or pretty
-- printed.
data Formatter
= Minified
| Pretty Int
-- | Converts a 'Document' into a string. -- | Converts a 'Document' into a string.
document :: Document -> Text document :: Formatter -> Document -> Text
document defs = Text.intercalate "\n" document formatter defs
. NonEmpty.toList | Pretty _ <- formatter = Text.intercalate "\n" encodeDocument
$ definition <$> defs | Minified <-formatter = Text.snoc (mconcat encodeDocument) '\n'
where
encodeDocument = NonEmpty.toList $ definition formatter <$> defs
-- | Converts a 'Definition' into a string. -- | Converts a 'Definition' into a string.
definition :: Definition -> Text definition :: Formatter -> Definition -> Text
definition x = Text.snoc (encodeDefinition x) '\n' definition formatter x
| Pretty _ <- formatter = Text.snoc (encodeDefinition x) '\n'
| Minified <- formatter = encodeDefinition x
where where
encodeDefinition (DefinitionOperation operation) encodeDefinition (DefinitionOperation operation)
= operationDefinition operation = operationDefinition formatter operation
encodeDefinition (DefinitionFragment fragment) encodeDefinition (DefinitionFragment fragment)
= fragmentDefinition fragment = fragmentDefinition formatter fragment
operationDefinition :: OperationDefinition -> Text operationDefinition :: Formatter -> OperationDefinition -> Text
operationDefinition (OperationSelectionSet sels) = selectionSet sels operationDefinition formatter (OperationSelectionSet sels)
operationDefinition (OperationDefinition Query name vars dirs sels) = = selectionSet formatter sels
"query " <> node (fold name) vars dirs sels operationDefinition formatter (OperationDefinition Query name vars dirs sels)
operationDefinition (OperationDefinition Mutation name vars dirs sels) = = "query " <> node formatter (fold name) vars dirs sels
"mutation " <> node (fold name) vars dirs sels operationDefinition formatter (OperationDefinition Mutation name vars dirs sels)
= "mutation " <> node formatter (fold name) vars dirs sels
node :: Name -> VariableDefinitions -> Directives -> SelectionSet -> Text node :: Formatter
node name vars dirs sels = -> Name
name -> VariableDefinitions
-> Directives
-> SelectionSet
-> Text
node formatter name vars dirs sels
= name
<> optempty variableDefinitions vars <> optempty variableDefinitions vars
<> optempty directives dirs <> optempty directives dirs
<> selectionSet sels <> selectionSet formatter sels
variableDefinitions :: [VariableDefinition] -> Text variableDefinitions :: [VariableDefinition] -> Text
variableDefinitions = parensCommas variableDefinition variableDefinitions = parensCommas variableDefinition
@ -54,24 +71,26 @@ defaultValue val = "=" <> value val
variable :: Name -> Text variable :: Name -> Text
variable var = "$" <> var variable var = "$" <> var
selectionSet :: SelectionSet -> Text selectionSet :: Formatter -> SelectionSet -> Text
selectionSet = bracesCommas selection . NonEmpty.toList selectionSet formatter@(Pretty _) = bracesNewLines (selection formatter) . NonEmpty.toList
selectionSet Minified = bracesCommas (selection Minified) . NonEmpty.toList
selectionSetOpt :: SelectionSetOpt -> Text selectionSetOpt :: Formatter -> SelectionSetOpt -> Text
selectionSetOpt = bracesCommas selection selectionSetOpt formatter@(Pretty _) = bracesNewLines $ selection formatter
selectionSetOpt Minified = bracesCommas $ selection Minified
selection :: Selection -> Text selection :: Formatter -> Selection -> Text
selection (SelectionField x) = field x selection formatter (SelectionField x) = field formatter x
selection (SelectionInlineFragment x) = inlineFragment x selection formatter (SelectionInlineFragment x) = inlineFragment formatter x
selection (SelectionFragmentSpread x) = fragmentSpread x selection _ (SelectionFragmentSpread x) = fragmentSpread x
field :: Field -> Text field :: Formatter -> Field -> Text
field (Field alias name args dirs selso) = field formatter (Field alias name args dirs selso) =
optempty (`Text.snoc` ':') (fold alias) optempty (`Text.append` ":") (fold alias)
<> name <> name
<> optempty arguments args <> optempty arguments args
<> optempty directives dirs <> optempty directives dirs
<> optempty selectionSetOpt selso <> optempty (selectionSetOpt formatter) selso
arguments :: [Argument] -> Text arguments :: [Argument] -> Text
arguments = parensCommas argument arguments = parensCommas argument
@ -85,17 +104,17 @@ fragmentSpread :: FragmentSpread -> Text
fragmentSpread (FragmentSpread name ds) = fragmentSpread (FragmentSpread name ds) =
"..." <> name <> optempty directives ds "..." <> name <> optempty directives ds
inlineFragment :: InlineFragment -> Text inlineFragment :: Formatter -> InlineFragment -> Text
inlineFragment (InlineFragment tc dirs sels) = inlineFragment formatter (InlineFragment tc dirs sels) =
"... on " <> fold tc "... on " <> fold tc
<> directives dirs <> directives dirs
<> selectionSet sels <> selectionSet formatter sels
fragmentDefinition :: FragmentDefinition -> Text fragmentDefinition :: Formatter -> FragmentDefinition -> Text
fragmentDefinition (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 dirs
<> selectionSet sels <> selectionSet formatter sels
-- * Values -- * Values
@ -180,5 +199,8 @@ bracketsCommas f = brackets . Text.intercalate "," . fmap f
bracesCommas :: (a -> Text) -> [a] -> Text bracesCommas :: (a -> Text) -> [a] -> Text
bracesCommas f = braces . Text.intercalate "," . fmap f bracesCommas f = braces . Text.intercalate "," . fmap f
bracesNewLines :: (a -> Text) -> [a] -> Text
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

View File

@ -1,4 +1,4 @@
resolver: lts-13.29 resolver: lts-13.30
packages: packages:
- '.' - '.'
extra-deps: [] extra-deps: []

View File

@ -7,6 +7,6 @@ packages: []
snapshots: snapshots:
- completed: - completed:
size: 500539 size: 500539
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/29.yaml url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/30.yaml
sha256: 006398c5e92d1d64737b7e98ae4d63987c36808814504d1451f56ebd98093f75 sha256: 59ad6b944c9903847fecdc1d4815e8500c1f9999d80fd1b4d2d66e408faec44b
original: lts-13.29 original: lts-13.30

View File

@ -1,3 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.KitchenSinkSpec module Test.KitchenSinkSpec
( spec ( spec
) where ) where
@ -16,10 +18,11 @@ import Test.Hspec.Expectations ( expectationFailure
import Text.Megaparsec ( errorBundlePretty import Text.Megaparsec ( errorBundlePretty
, parse , parse
) )
import Text.RawString.QQ (r)
spec :: Spec spec :: Spec
spec = describe "Kitchen Sink" $ spec = describe "Kitchen Sink" $ do
it "prints the query" $ do it "minifies the query" $ do
dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql" dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql"
minFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql" minFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql"
actual <- Text.IO.readFile dataFileName actual <- Text.IO.readFile dataFileName
@ -27,5 +30,46 @@ spec = describe "Kitchen Sink" $
either either
(expectationFailure . errorBundlePretty) (expectationFailure . errorBundlePretty)
(flip shouldBe expected . Encoder.document) (flip shouldBe expected . Encoder.document Encoder.Minified)
$ parse Parser.document dataFileName actual
it "pretty prints the query" $ do
dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql"
actual <- Text.IO.readFile dataFileName
let expected = [r|query queryName($foo:ComplexType,$site:Site=MOBILE){
whoever123is:node(id:[123,456]){
id
... on User@defer{
field2{
id
alias:field1(first:10,after:$foo)@include(if:$foo){
id
...frag
}
}
}
}
}
mutation likeStory{
like(story:123)@defer{
story{
id
}
}
}
fragment frag on Friend{
foo(size:$size,bar:$b,obj:{key:"value"})
}
{
unnamed(truthy:true,falsey:false)
query
}
|]
either
(expectationFailure . errorBundlePretty)
(flip shouldBe expected . Encoder.document (Encoder.Pretty 0))
$ parse Parser.document dataFileName actual $ parse Parser.document dataFileName actual

View File

@ -11,7 +11,7 @@ query queryName($foo: ComplexType, $site: Site = MOBILE) {
... on User @defer { ... on User @defer {
field2 { field2 {
id, id,
alias: field1(first:10, after:$foo,) @include(if: $foo) { alias: field1(first: 10, after: $foo) @include(if: $foo) {
id, id,
...frag ...frag
} }

View File

@ -1,7 +1 @@
query queryName($foo:ComplexType,$site:Site=MOBILE){whoever123is:node(id:[123,456]){id,... on User@defer{field2{id,alias:field1(first:10,after:$foo)@include(if:$foo){id,...frag}}}}} query queryName($foo:ComplexType,$site:Site=MOBILE){whoever123is:node(id:[123,456]){id,... on User@defer{field2{id,alias:field1(first:10,after:$foo)@include(if:$foo){id,...frag}}}}}mutation likeStory{like(story:123)@defer{story{id}}}fragment frag on Friend{foo(size:$size,bar:$b,obj:{key:"value"})}{unnamed(truthy:true,falsey:false),query}
mutation likeStory{like(story:123)@defer{story{id}}}
fragment frag on Friend{foo(size:$size,bar:$b,obj:{key:"value"})}
{unnamed(truthy:true,falsey:false),query}