1 files changed, 40 insertions, 35 deletions

diff --git a/Data/GraphQL/Encoder.hs b/Data/GraphQL/Encoder.hs
index 0cf878e..924bdea 100644
--- a/Data/GraphQL/Encoder.hs
+++ b/Data/GraphQL/Encoder.hs
@@ -2,7 +2,9 @@
 -- | This module defines a printer for the @GraphQL@ language.
 module Data.GraphQL.Encoder where
 
+import Data.Foldable (fold)
 import Data.Monoid ((<>))
+import qualified Data.List.NonEmpty as NonEmpty (toList)
 
 import Data.Text (Text, cons, intercalate, pack, snoc)
 
@@ -10,24 +12,26 @@ import Data.GraphQL.AST
 
 -- * Document
 
--- TODO: Use query shorthand
 document :: Document -> Text
-document (Document defs) = (`snoc` '\n') . mconcat $ definition <$> defs
+document defs = (`snoc` '\n') . mconcat . NonEmpty.toList $ definition <$> defs
 
 definition :: Definition -> Text
 definition (DefinitionOperation x) = operationDefinition x
 definition (DefinitionFragment  x) = fragmentDefinition x
 
 operationDefinition :: OperationDefinition -> Text
-operationDefinition (Query    n) = "query "    <> node n
-operationDefinition (Mutation n) = "mutation " <> node n
-
-node :: Node -> Text
-node (Node name vds ds ss) =
+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
+
+node :: Name -> VariableDefinitions -> Directives -> SelectionSet -> Text
+node name vars dirs sels =
        name
-    <> optempty variableDefinitions vds
-    <> optempty directives ds
-    <> selectionSet ss
+    <> optempty variableDefinitions vars
+    <> optempty directives dirs
+    <> selectionSet sels
 
 variableDefinitions :: [VariableDefinition] -> Text
 variableDefinitions = parensCommas variableDefinition
@@ -40,10 +44,13 @@ defaultValue :: DefaultValue -> Text
 defaultValue val = "=" <> value val
 
 variable :: Variable -> Text
-variable (Variable name) = "$" <> name
+variable var = "$" <> var
 
 selectionSet :: SelectionSet -> Text
-selectionSet = bracesCommas selection
+selectionSet = bracesCommas selection . NonEmpty.toList
+
+selectionSetOpt :: SelectionSetOpt -> Text
+selectionSetOpt = bracesCommas selection
 
 selection :: Selection -> Text
 selection (SelectionField          x) = field x
@@ -51,12 +58,12 @@ selection (SelectionInlineFragment x) = inlineFragment x
 selection (SelectionFragmentSpread x) = fragmentSpread x
 
 field :: Field -> Text
-field (Field alias name args ds ss) =
-       optempty (`snoc` ':') alias
+field (Field alias name args dirs selso) =
+       optempty (`snoc` ':') (fold alias)
     <> name
     <> optempty arguments args
-    <> optempty directives ds
-    <> optempty selectionSet ss
+    <> optempty directives dirs
+    <> optempty selectionSetOpt selso
 
 arguments :: [Argument] -> Text
 arguments = parensCommas argument
@@ -71,26 +78,27 @@ fragmentSpread (FragmentSpread name ds) =
     "..." <> name <> optempty directives ds
 
 inlineFragment :: InlineFragment -> Text
-inlineFragment (InlineFragment (NamedType tc) ds ss) =
-    "... on " <> tc
-              <> optempty directives ds
-              <> optempty selectionSet ss
+inlineFragment (InlineFragment tc dirs sels) =
+    "... on " <> fold tc
+              <> directives dirs
+              <> selectionSet sels
 
 fragmentDefinition :: FragmentDefinition -> Text
-fragmentDefinition (FragmentDefinition name (NamedType tc) ds ss) =
+fragmentDefinition (FragmentDefinition name tc dirs sels) =
     "fragment " <> name <> " on " <> tc
-                <> optempty directives ds
-                <> selectionSet ss
+                <> optempty directives dirs
+                <> selectionSet sels
 
 -- * Values
 
 value :: Value -> Text
 value (ValueVariable x) = variable x
--- TODO: This will be replaced with `decimal` Buidler
+-- TODO: This will be replaced with `decimal` Builder
 value (ValueInt      x) = pack $ show x
--- TODO: This will be replaced with `decimal` Buidler
+-- TODO: This will be replaced with `decimal` Builder
 value (ValueFloat    x) = pack $ show x
 value (ValueBoolean  x) = booleanValue x
+value ValueNull         = mempty
 value (ValueString   x) = stringValue x
 value (ValueEnum     x) = x
 value (ValueList     x) = listValue x
@@ -105,10 +113,10 @@ stringValue :: Text -> Text
 stringValue = quotes
 
 listValue :: ListValue -> Text
-listValue (ListValue vs) = bracketsCommas value vs
+listValue = bracketsCommas value
 
 objectValue :: ObjectValue -> Text
-objectValue (ObjectValue ofs) = bracesCommas objectField ofs
+objectValue = bracesCommas objectField
 
 objectField :: ObjectField -> Text
 objectField (ObjectField name v) = name <> ":" <> value v
@@ -124,18 +132,15 @@ directive (Directive name args) = "@" <> name <> optempty arguments args
 -- * Type Reference
 
 type_ :: Type -> Text
-type_ (TypeNamed (NamedType x)) = x
-type_ (TypeList x) = listType x
+type_ (TypeNamed   x) = x
+type_ (TypeList    x) = listType x
 type_ (TypeNonNull x) = nonNullType x
 
-namedType :: NamedType -> Text
-namedType (NamedType name) = name
-
-listType :: ListType -> Text
-listType (ListType ty) = brackets (type_ ty)
+listType :: Type -> Text
+listType x = brackets (type_ x)
 
 nonNullType :: NonNullType -> Text
-nonNullType (NonNullTypeNamed (NamedType x)) = x <> "!"
+nonNullType (NonNullTypeNamed x) = x <> "!"
 nonNullType (NonNullTypeList  x) = listType x <> "!"
 
 -- * Internal