Add kitchen sink parse/encode unit test

This also includes the fixes to make it work. Golden tests have been
removed.
This commit is contained in:
Danny Navarro 2015-09-22 13:53:37 +02:00
parent 4508364266
commit 06b3302862
7 changed files with 49 additions and 56 deletions

View File

@ -14,7 +14,6 @@ import Data.Char
import Data.Foldable (traverse_) import Data.Foldable (traverse_)
import Data.Text (Text, append) import Data.Text (Text, append)
import qualified Data.Text as T
import Data.Attoparsec.Text import Data.Attoparsec.Text
( Parser ( Parser
, (<?>) , (<?>)
@ -29,7 +28,6 @@ import Data.Attoparsec.Text
, peekChar , peekChar
, sepBy1 , sepBy1
, signed , signed
, takeText
, takeWhile , takeWhile
, takeWhile1 , takeWhile1
) )
@ -170,15 +168,9 @@ booleanValue :: Parser Bool
booleanValue = True <$ tok "true" booleanValue = True <$ tok "true"
<|> False <$ tok "false" <|> False <$ tok "false"
-- TODO: Escape characters. Look at `jsstring_` in aeson package.
stringValue :: Parser StringValue 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 -- Notice it can be empty
listValue :: Parser ListValue listValue :: Parser ListValue
@ -205,9 +197,9 @@ directive = Directive
-- * Type Reference -- * Type Reference
type_ :: Parser Type type_ :: Parser Type
type_ = TypeNamed <$> namedType type_ = TypeList <$> listType
<|> TypeList <$> listType
<|> TypeNonNull <$> nonNullType <|> TypeNonNull <$> nonNullType
<|> TypeNamed <$> namedType
<?> "type_ error!" <?> "type_ error!"
namedType :: Parser NamedType namedType :: Parser NamedType

View File

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

View File

@ -17,7 +17,7 @@ cabal-version: >=1.10
tested-with: GHC == 7.8.4, GHC == 7.10.2 tested-with: GHC == 7.8.4, GHC == 7.10.2
extra-source-files: README.md CHANGELOG.md stack.yaml extra-source-files: README.md CHANGELOG.md stack.yaml
data-files: tests/data/*.graphql data-files: tests/data/*.graphql
tests/data/*.graphql.golden tests/data/*.min.graphql
library library
default-language: Haskell2010 default-language: Haskell2010
@ -29,20 +29,19 @@ library
text >=0.11.3.1, text >=0.11.3.1,
attoparsec >=0.10.4.0 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 source-repository head
type: git type: git

View File

@ -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")]))] [] [])])]

View File

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

View File

@ -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)

23
tests/tasty.hs Normal file
View File

@ -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