From 06b3302862e0c427439136241fb6299f215cec52 Mon Sep 17 00:00:00 2001 From: Danny Navarro Date: Tue, 22 Sep 2015 13:53:37 +0200 Subject: [PATCH] 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 | 16 ++++--------- Data/GraphQL/Printer.hs | 8 +++++-- graphql.cabal | 31 +++++++++++++------------- tests/data/kitchen-sink.graphql.golden | 1 - tests/data/kitchen-sink.min.graphql | 1 + tests/golden.hs | 25 --------------------- tests/tasty.hs | 23 +++++++++++++++++++ 7 files changed, 49 insertions(+), 56 deletions(-) delete mode 100644 tests/data/kitchen-sink.graphql.golden create mode 100644 tests/data/kitchen-sink.min.graphql delete mode 100644 tests/golden.hs create mode 100644 tests/tasty.hs 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