Add kitchen sink parse/encode unit test

This also includes the fixes to make it work. Golden tests have been
removed.

Data/GraphQL/Parser.hs

@@ -14,7 +14,6 @@ import Data.Char
 import Data.Foldable (traverse_)
 
 import Data.Text (Text, append)
-import qualified Data.Text as T
 import Data.Attoparsec.Text
   ( Parser
   , (<?>)
@@ -29,7 +28,6 @@ import Data.Attoparsec.Text
   , peekChar
   , sepBy1
   , signed
-  , takeText
   , takeWhile
   , takeWhile1
   )
@@ -170,15 +168,9 @@ booleanValue :: Parser Bool
 booleanValue = True  <$ tok "true"
    <|> False <$ tok "false"
 
+-- TODO: Escape characters. Look at `jsstring_` in aeson package.
 stringValue :: Parser StringValue
-stringValue = StringValue <$> quotes (T.foldl' step mempty <$> takeText)
+stringValue = StringValue <$> quotes (takeWhile (/= '"'))
-  where
-    -- TODO: Handle unicode and the rest of escaped chars.
-    step acc c
-        | T.null acc = T.singleton c
-        | T.last acc == '\\' = if c == '"' then T.init acc `T.snoc` '"'
-                                           else acc `T.snoc` c
-        | otherwise = acc `T.snoc` c
 
 -- Notice it can be empty
 listValue :: Parser ListValue
@@ -205,9 +197,9 @@ directive = Directive
 -- * Type Reference
 
 type_ :: Parser Type
-type_ = TypeNamed   <$> namedType
+type_ = TypeList    <$> listType
-    <|> TypeList    <$> listType
     <|> TypeNonNull <$> nonNullType
+    <|> TypeNamed   <$> namedType
     <?> "type_ error!"
 
 namedType :: Parser NamedType

Data/GraphQL/Printer.hs

@@ -10,8 +10,9 @@ import Data.GraphQL.AST
 
 -- * Document
 
+-- TODO: Use query shorthand
 document :: Document -> Text
-document (Document defs) = mconcat $ definition <$> defs
+document (Document defs) = (`snoc` '\n') . mconcat $ definition <$> defs
 
 definition :: Definition -> Text
 definition (DefinitionOperation x) = operationDefinition x
@@ -102,7 +103,7 @@ booleanValue False = "false"
 
 -- TODO: Escape characters
 stringValue :: StringValue -> Text
-stringValue (StringValue x) = x
+stringValue (StringValue v) = quotes v
 
 listValue :: ListValue -> Text
 listValue (ListValue vs) = bracketsCommas value vs
@@ -222,6 +223,9 @@ brackets = between '[' ']'
 braces :: Text -> Text
 braces = between '{' '}'
 
+quotes :: Text -> Text
+quotes = between '"' '"'
+
 spaces :: (a -> Text) -> [a] -> Text
 spaces f = intercalate "\SP" . fmap f
 

graphql.cabal

@@ -17,7 +17,7 @@ cabal-version:       >=1.10
 tested-with:         GHC == 7.8.4, GHC == 7.10.2
 extra-source-files:  README.md CHANGELOG.md stack.yaml
 data-files:          tests/data/*.graphql
-                     tests/data/*.graphql.golden
+                     tests/data/*.min.graphql
 
 library
   default-language:    Haskell2010
@@ -25,24 +25,23 @@ library
   exposed-modules:     Data.GraphQL.AST
                        Data.GraphQL.Parser
                        Data.GraphQL.Printer
-  build-depends:       base >= 4.7 && < 5,
+  build-depends:       base >=4.7 && < 5,
                        text >=0.11.3.1,
                        attoparsec >=0.10.4.0
 
--- test-suite golden
+test-suite tasty
---   default-language:    Haskell2010
+  default-language:    Haskell2010
---   type:                exitcode-stdio-1.0
+  type:                exitcode-stdio-1.0
---   hs-source-dirs:      tests
+  hs-source-dirs:      tests
---   main-is:             golden.hs
+  main-is:             tasty.hs
---   ghc-options:         -Wall
+  ghc-options:         -Wall
---   other-modules:       Paths_graphql
+  other-modules:       Paths_graphql
---   build-depends:       base >= 4.6 && <5,
+  build-depends:       base >=4.6 && <5,
---                        bytestring,
+                       text >=0.11.3.1,
---                        text,
+                       attoparsec >=0.10.4.0,
---                        attoparsec,
+                       tasty >=0.10,
---                        tasty >=0.10,
+                       tasty-hunit >=0.9,
---                        tasty-golden,
+                       graphql
---                        graphql
 
 source-repository head
   type:     git

tests/data/kitchen-sink.graphql.golden

@@ -1 +0,0 @@
-Document [DefinitionOperation (Query "queryName" [VariableDefinition (Variable "foo") (TypeNamed (NamedType "ComplexType")) Nothing,VariableDefinition (Variable "site") (TypeNamed (NamedType "Site")) (Just (ValueEnum "MOBILE"))] [] [SelectionField (Field "whoever123is" "node" [Argument "id" (ValueList (ListValue [ValueInt 123,ValueInt 456]))] [] [SelectionField (Field "" "id" [] [] []),SelectionInlineFragment (InlineFragment (NamedType "User") [Directive "defer" []] [SelectionField (Field "" "field2" [] [] [SelectionField (Field "" "id" [] [] []),SelectionField (Field "alias" "field1" [Argument "first" (ValueInt 10),Argument "after" (ValueVariable (Variable "foo"))] [Directive "include" [Argument "if" (ValueVariable (Variable "foo"))]] [SelectionField (Field "" "id" [] [] []),SelectionFragmentSpread (FragmentSpread "frag" [])])])])])]),DefinitionOperation (Mutation "likeStory" [] [] [SelectionField (Field "" "like" [Argument "story" (ValueInt 123)] [Directive "defer" []] [SelectionField (Field "" "story" [] [] [SelectionField (Field "" "id" [] [] [])])])]),DefinitionFragment (FragmentDefinition "frag" (NamedType "Friend") [] [SelectionField (Field "" "foo" [Argument "size" (ValueVariable (Variable "size")),Argument "bar" (ValueVariable (Variable "b")),Argument "obj" (ValueObject (ObjectValue [ObjectField "key" (ValueString "value")]))] [] [])])]

tests/data/kitchen-sink.min.graphql

@@ -0,0 +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"})}

tests/golden.hs

@@ -1,25 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Main where
-
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative ((<$>), (<*>), pure)
-#endif
-import Control.Monad ((>=>))
-import Data.Attoparsec.Text (parseOnly)
-import Data.ByteString.Lazy.Char8 as B8
-import qualified Data.Text.IO as TIO
-import Test.Tasty (defaultMain)
-import Test.Tasty.Golden (goldenVsString)
-
-import Paths_graphql (getDataFileName)
-import Data.GraphQL.Parser (document)
-
-main :: IO ()
-main = defaultMain
-   =<< goldenVsString "kitchen-sink.graphql"
-   <$> getDataFileName "tests/data/kitchen-sink.graphql.graphql.golden"
-   <*> (parse <$> getDataFileName "tests/data/kitchen-sink.graphql")
-  where
-    parse = fmap (parseOnly document) . TIO.readFile
-        >=> pure . either B8.pack (flip B8.snoc '\n' . B8.pack . show)

tests/tasty.hs

@@ -0,0 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import Data.Attoparsec.Text (parseOnly)
+import qualified Data.Text.IO as Text
+import Test.Tasty (defaultMain)
+import Test.Tasty.HUnit
+
+import qualified Data.GraphQL.Parser as Parser
+import qualified Data.GraphQL.Printer as Printer
+
+import Paths_graphql (getDataFileName)
+
+main :: IO ()
+main = defaultMain =<< testCase "Kitchen Sink"
+                   <$> (assertEqual "Encode" <$> expected <*> actual)
+  where
+    expected = Text.readFile
+           =<< getDataFileName "tests/data/kitchen-sink.min.graphql"
+
+    actual = either (error "Parsing error!") Printer.document
+         <$> parseOnly Parser.document
+         <$> expected