Introduce formatter type for the encoder

... to distinguish between minified and pretty printing.

src/Language/GraphQL/Encoder.hs

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

stack.yaml

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

stack.yaml.lock

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

tests/Test/KitchenSinkSpec.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 module Test.KitchenSinkSpec
     ( spec
     ) where
@@ -16,10 +18,11 @@ import Test.Hspec.Expectations ( expectationFailure
 import Text.Megaparsec ( errorBundlePretty
                        , parse
                        )
+import Text.RawString.QQ (r)
 
 spec :: Spec
-spec = describe "Kitchen Sink" $
-    it "prints the query" $ do
+spec = describe "Kitchen Sink" $ do
+    it "minifies the query" $ do
         dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql"
         minFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql"
         actual <- Text.IO.readFile dataFileName
@@ -27,5 +30,46 @@ spec = describe "Kitchen Sink" $
 
         either
             (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

tests/data/kitchen-sink.graphql

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

tests/data/kitchen-sink.min.graphql

@@ -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}}}}}
-
-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}
+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}