Polish printer code

- Add printing combinators to make code more readable.
- Optimize printing for encoding. Pretty printing will be in a different
  module.

Data/GraphQL/Printer.hs

@@ -4,17 +4,14 @@ module Data.GraphQL.Printer where
 import Prelude hiding (unwords)
 import Data.Monoid ((<>))
 
-import Data.Text (Text, intercalate, pack, unwords)
+import Data.Text (Text, cons, intercalate, pack, snoc)
 
 import Data.GraphQL.AST
 
--- Uniplate could avoid boilerplate, but is it worth bringing the
--- extra dependency?
-
 -- * Document
 
 document :: Document -> Text
-document (Document defs) = intercalate "\n\n" $ definition <$> defs
+document (Document defs) = mconcat $ definition <$> defs
 
 definition :: Definition -> Text
 definition (DefinitionOperation x) = operationDefinition x
@@ -29,12 +26,11 @@ node :: Node -> Text
 node (Node name vds ds ss) =
        name
     <> optempty variableDefinitions vds
-    <> optempty (("\SP" <>) . directives) ds
+    <> optempty directives ds
-    <> "\SP"
     <> selectionSet ss
 
 variableDefinitions :: [VariableDefinition] -> Text
-variableDefinitions = parens . intercalate ", " . fmap variableDefinition
+variableDefinitions = parensCommas variableDefinition
 
 variableDefinition :: VariableDefinition -> Text
 variableDefinition (VariableDefinition var ty dv) =
@@ -47,7 +43,7 @@ variable :: Variable -> Text
 variable (Variable name) = "$" <> name
 
 selectionSet :: SelectionSet -> Text
-selectionSet = block . fmap selection
+selectionSet = bracesCommas selection
 
 selection :: Selection -> Text
 selection (SelectionField          x) = field x
@@ -56,14 +52,14 @@ selection (SelectionFragmentSpread x) = fragmentSpread x
 
 field :: Field -> Text
 field (Field alias name args ds ss) =
-       optempty (<> ": ") alias
+       optempty (cons ':') alias
     <> name
     <> optempty arguments args
-    <> optempty (("\SP" <>) . directives) ds
+    <> optempty directives ds
-    <> optempty (("\SP" <>) . selectionSet) ss
+    <> optempty selectionSet ss
 
 arguments :: [Argument] -> Text
-arguments = parens . intercalate ", " . fmap argument
+arguments = parensCommas argument
 
 argument :: Argument -> Text
 argument (Argument name v) = name <> ":" <> value v
@@ -72,19 +68,19 @@ argument (Argument name v) = name <> ": " <> value v
 
 fragmentSpread :: FragmentSpread -> Text
 fragmentSpread (FragmentSpread name ds) =
-    "..." <> name <> optempty (spaces . directives) ds
+    "..." <> name <> optempty directives ds
 
 inlineFragment :: InlineFragment -> Text
 inlineFragment (InlineFragment (NamedType tc) ds ss) =
     "... on " <> tc
-             <> optempty (("\SP" <>) . directives) ds
+              <> optempty directives ds
-             <> optempty (("\SP" <>) . selectionSet) ss
+              <> optempty selectionSet ss
 
 fragmentDefinition :: FragmentDefinition -> Text
 fragmentDefinition (FragmentDefinition name (NamedType tc) ds ss) =
     "fragment " <> name <> " on " <> tc
-                <> optempty (("\SP" <>) . directives) ds
+                <> optempty directives ds
-                <> (("\SP" <>) . selectionSet) ss
+                <> selectionSet ss
 
 -- * Values
 
@@ -109,10 +105,10 @@ stringValue :: StringValue -> Text
 stringValue (StringValue x) = x
 
 listValue :: ListValue -> Text
-listValue (ListValue vs) = brackets . intercalate ", " $ value <$> vs
+listValue (ListValue vs) = bracketsCommas value vs
 
 objectValue :: ObjectValue -> Text
-objectValue (ObjectValue ofs) = block $ objectField <$> ofs
+objectValue (ObjectValue ofs) = bracesCommas objectField ofs
 
 objectField :: ObjectField -> Text
 objectField (ObjectField name v) = name <> ":" <> value v
@@ -120,7 +116,7 @@ objectField (ObjectField name v) = name <> ": " <> value v
 -- * Directives
 
 directives :: [Directive] -> Text
-directives = withSpaces directive
+directives = spaces directive
 
 directive :: Directive -> Text
 directive (Directive name args) = "@" <> name <> optempty arguments args
@@ -136,7 +132,7 @@ namedType :: NamedType -> Text
 namedType (NamedType name) = name
 
 listType :: ListType -> Text
-listType (ListType ty) = "[" <> type_ ty <> "]"
+listType (ListType ty) = brackets (type_ ty)
 
 nonNullType :: NonNullType -> Text
 nonNullType (NonNullTypeNamed (NamedType x)) = x <> "!"
@@ -154,14 +150,14 @@ typeDefinition (TypeDefinitionTypeExtension x) = typeExtensionDefinition x
 objectTypeDefinition :: ObjectTypeDefinition -> Text
 objectTypeDefinition (ObjectTypeDefinition name ifaces fds) =
     "type " <> name
-            <> optempty (("\SP" <>) . interfaces) ifaces
+            <> optempty (spaced . interfaces) ifaces
-            <> optempty (("\SP" <>) . fieldDefinitions) fds
+            <> optempty fieldDefinitions fds
 
 interfaces :: Interfaces -> Text
-interfaces = ("implements " <>) . unwords . fmap namedType
+interfaces = ("implements " <>) . spaces namedType
 
 fieldDefinitions :: [FieldDefinition] -> Text
-fieldDefinitions = block . fmap fieldDefinition
+fieldDefinitions = bracesCommas fieldDefinition
 
 fieldDefinition :: FieldDefinition -> Text
 fieldDefinition (FieldDefinition name args ty) =
@@ -170,18 +166,11 @@ fieldDefinition (FieldDefinition name args ty) =
          <> type_ ty
 
 argumentsDefinition :: ArgumentsDefinition -> Text
-argumentsDefinition = parens . intercalate ", " . fmap inputValueDefinition
+argumentsDefinition = parensCommas inputValueDefinition
-
-inputValueDefinitions :: [InputValueDefinition] -> Text
-inputValueDefinitions = block . fmap inputValueDefinition
-
-inputValueDefinition :: InputValueDefinition -> Text
-inputValueDefinition (InputValueDefinition name ty dv) =
-    name <> ": " <> type_ ty <> maybe mempty (("\SP" <>) . defaultValue) dv
 
 interfaceTypeDefinition :: InterfaceTypeDefinition -> Text
 interfaceTypeDefinition (InterfaceTypeDefinition name fds) =
-    "interface " <> name <> "\SP" <> fieldDefinitions fds
+    "interface " <> name <> fieldDefinitions fds
 
 unionTypeDefinition :: UnionTypeDefinition -> Text
 unionTypeDefinition (UnionTypeDefinition name ums) =
@@ -196,14 +185,21 @@ scalarTypeDefinition (ScalarTypeDefinition name) = "scalar " <> name
 enumTypeDefinition :: EnumTypeDefinition -> Text
 enumTypeDefinition (EnumTypeDefinition name evds) =
     "enum " <> name
-            <> block (enumValueDefinition <$> evds)
+            <> bracesCommas enumValueDefinition evds
 
 enumValueDefinition :: EnumValueDefinition -> Text
 enumValueDefinition (EnumValueDefinition name) = name
 
 inputObjectTypeDefinition :: InputObjectTypeDefinition -> Text
 inputObjectTypeDefinition (InputObjectTypeDefinition name ivds) =
-    "input " <> name <> "\SP" <> inputValueDefinitions ivds
+    "input " <> name <> inputValueDefinitions ivds
+
+inputValueDefinitions :: [InputValueDefinition] -> Text
+inputValueDefinitions = bracesCommas inputValueDefinition
+
+inputValueDefinition :: InputValueDefinition -> Text
+inputValueDefinition (InputValueDefinition name ty dv) =
+    name <> ":" <> type_ ty <> maybe mempty defaultValue dv
 
 typeExtensionDefinition :: TypeExtensionDefinition -> Text
 typeExtensionDefinition (TypeExtensionDefinition otd) =
@@ -211,23 +207,32 @@ typeExtensionDefinition (TypeExtensionDefinition otd) =
 
 -- * Internal
 
-spaces :: Text -> Text
+spaced :: Text -> Text
-spaces txt = "\SP" <> txt <> "\SP"
+spaced = cons '\SP'
+
+between :: Char -> Char -> Text -> Text
+between open close = cons open . (`snoc` close)
 
 parens :: Text -> Text
-parens txt = "(" <> txt <> ")"
+parens = between '(' ')'
 
 brackets :: Text -> Text
-brackets txt = "[" <> txt <> "]"
+brackets = between '[' ']'
 
-withSpaces :: (a -> Text) -> [a] -> Text
+braces :: Text -> Text
-withSpaces f = intercalate "\SP" . fmap f
+braces = between '{' '}'
 
-withCommas :: (a -> Text) -> [a] -> Text
+spaces :: (a -> Text) -> [a] -> Text
-withCommas f = intercalate ", " . fmap f
+spaces f = intercalate "\SP" . fmap f
+
+parensCommas :: (a -> Text) -> [a] -> Text
+parensCommas f = parens . intercalate "," . fmap f
+
+bracketsCommas :: (a -> Text) -> [a] -> Text
+bracketsCommas f = brackets . intercalate "," . fmap f
+
+bracesCommas :: (a -> Text) -> [a] -> Text
+bracesCommas f = braces . intercalate "," . fmap f
 
 optempty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
 optempty f xs = if xs == mempty then mempty else f xs
-
-block :: [Text] -> Text
-block txts = "{\n" <> intercalate "  \n" txts <> "\n}"