summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDanny Navarro <j@dannynavarro.net>2015-09-22 13:53:37 +0200
committerDanny Navarro <j@dannynavarro.net>2015-09-22 14:02:49 +0200
commit06b3302862e0c427439136241fb6299f215cec52 (patch)
tree338b9ecc208b4b25dfeaab61d2d326e6020aa3a8
parent45083642667fce8a1f6d1491f3487243416e8cc0 (diff)
downloadgraphql-06b3302862e0c427439136241fb6299f215cec52.tar.gz
Add kitchen sink parse/encode unit test
This also includes the fixes to make it work. Golden tests have been removed.
-rw-r--r--Data/GraphQL/Parser.hs16
-rw-r--r--Data/GraphQL/Printer.hs8
-rw-r--r--graphql.cabal31
-rw-r--r--tests/data/kitchen-sink.graphql.golden1
-rw-r--r--tests/data/kitchen-sink.min.graphql1
-rw-r--r--tests/golden.hs25
-rw-r--r--tests/tasty.hs23
7 files changed, 49 insertions, 56 deletions
diff --git a/Data/GraphQL/Parser.hs b/Data/GraphQL/Parser.hs
index 3ff780c..00e4df1 100644
--- a/Data/GraphQL/Parser.hs
+++ b/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)
- 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
+stringValue = StringValue <$> quotes (takeWhile (/= '"'))
-- Notice it can be empty
listValue :: Parser ListValue
@@ -205,9 +197,9 @@ directive = Directive
-- * Type Reference
type_ :: Parser Type
-type_ = TypeNamed <$> namedType
- <|> TypeList <$> listType
+type_ = TypeList <$> listType
<|> TypeNonNull <$> nonNullType
+ <|> TypeNamed <$> namedType
<?> "type_ error!"
namedType :: Parser NamedType
diff --git a/Data/GraphQL/Printer.hs b/Data/GraphQL/Printer.hs
index 4a4d67e..f241220 100644
--- a/Data/GraphQL/Printer.hs
+++ b/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
diff --git a/graphql.cabal b/graphql.cabal
index 7b47bd9..a9e7f66 100644
--- a/graphql.cabal
+++ b/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
--- default-language: Haskell2010
--- type: exitcode-stdio-1.0
--- hs-source-dirs: tests
--- main-is: golden.hs
--- ghc-options: -Wall
--- other-modules: Paths_graphql
--- build-depends: base >= 4.6 && <5,
--- bytestring,
--- text,
--- attoparsec,
--- tasty >=0.10,
--- tasty-golden,
--- graphql
+test-suite tasty
+ default-language: Haskell2010
+ type: exitcode-stdio-1.0
+ hs-source-dirs: tests
+ main-is: tasty.hs
+ ghc-options: -Wall
+ other-modules: Paths_graphql
+ build-depends: base >=4.6 && <5,
+ text >=0.11.3.1,
+ attoparsec >=0.10.4.0,
+ tasty >=0.10,
+ tasty-hunit >=0.9,
+ graphql
source-repository head
type: git
diff --git a/tests/data/kitchen-sink.graphql.golden b/tests/data/kitchen-sink.graphql.golden
deleted file mode 100644
index 2542cd5..0000000
--- a/tests/data/kitchen-sink.graphql.golden
+++ /dev/null
@@ -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")]))] [] [])])]
diff --git a/tests/data/kitchen-sink.min.graphql b/tests/data/kitchen-sink.min.graphql
new file mode 100644
index 0000000..4f8553d
--- /dev/null
+++ b/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"})}
diff --git a/tests/golden.hs b/tests/golden.hs
deleted file mode 100644
index 98413eb..0000000
--- a/tests/golden.hs
+++ /dev/null
@@ -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)
diff --git a/tests/tasty.hs b/tests/tasty.hs
new file mode 100644
index 0000000..64786e6
--- /dev/null
+++ b/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