forked from OSS/graphql
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:
parent
4508364266
commit
06b3302862
@ -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
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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")]))] [] [])])]
|
|
1
tests/data/kitchen-sink.min.graphql
Normal file
1
tests/data/kitchen-sink.min.graphql
Normal 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"})}
|
@ -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
23
tests/tasty.hs
Normal 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
|
Loading…
Reference in New Issue
Block a user