prescientmoon/graphql
1
0
Fork 0
forked from OSS/graphql
Code Pull Requests Activity

Introduce hspec-megaparsec

Browse Source 
Fixes #13.
This commit is contained in:
Eugen Wissner
2019-09-27 10:50:38 +02:00
parent 70f7e1bd8e
commit eb98c36258
5 changed files with 80 additions and 101 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
graphql.cabal
View File

@@ -4,7 +4,7 @@ cabal-version: 1.12
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: ff53309ec0180b799fcc69ff3a53a6c9411940332e75ebc8097a83d40c085d98 -- hash: 7396988b6b8e966751eaf92b5a8c1cb820f7a3dbbf60736ea46faab4653fb40c
name: graphql name: graphql
version: 0.5.0.1 version: 0.5.0.1
@@ -85,6 +85,7 @@ test-suite tasty
, graphql , graphql
, hspec , hspec
, hspec-expectations , hspec-expectations
, hspec-megaparsec
, megaparsec , megaparsec
, raw-strings-qq , raw-strings-qq
, text , text

1
package.yaml
View File

@@ -49,4 +49,5 @@ tests:
- graphql - graphql
- hspec - hspec
- hspec-expectations - hspec-expectations
- hspec-megaparsec
- raw-strings-qq - raw-strings-qq

126
tests/Language/GraphQL/LexerSpec.hs
View File

@@ -1,104 +1,92 @@
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.LexerSpec module Language.GraphQL.LexerSpec
( spec ( spec
) where ) where
import Data.Either (isRight)
import Data.Text (Text) import Data.Text (Text)
import Data.Void (Void) import Data.Void (Void)
import Language.GraphQL.Lexer import Language.GraphQL.Lexer
import Test.Hspec ( Spec import Test.Hspec (Spec, context, describe, it)
, context import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn)
, describe import Text.Megaparsec (ParseErrorBundle, parse)
, it
, shouldBe
, shouldSatisfy
)
import Text.Megaparsec ( ParseErrorBundle
, parse
)
import Text.RawString.QQ (r) import Text.RawString.QQ (r)
spec :: Spec spec :: Spec
spec = describe "Lexer" $ do spec = describe "Lexer" $ do
context "Reference tests" $ do context "Reference tests" $ do
it "accepts BOM header" $ it "accepts BOM header" $
runParser unicodeBOM "\xfeff" `shouldSatisfy` isRight parse unicodeBOM "" `shouldSucceedOn` "\xfeff"
it "lexes strings" $ do it "lexes strings" $ do
runParser string [r|"simple"|] `shouldBe` Right "simple" parse string "" [r|"simple"|] `shouldParse` "simple"
runParser string [r|" white space "|] `shouldBe` Right " white space " parse string "" [r|" white space "|] `shouldParse` " white space "
runParser string [r|"quote \""|] `shouldBe` Right [r|quote "|] parse string "" [r|"quote \""|] `shouldParse` [r|quote "|]
runParser string [r|"escaped \n"|] `shouldBe` Right "escaped \n" parse string "" [r|"escaped \n"|] `shouldParse` "escaped \n"
runParser string [r|"slashes \\ \/"|] `shouldBe` Right [r|slashes \ /|] parse string "" [r|"slashes \\ \/"|] `shouldParse` [r|slashes \ /|]
runParser string [r|"unicode \u1234\u5678\u90AB\uCDEF"|] parse string "" [r|"unicode \u1234\u5678\u90AB\uCDEF"|]
`shouldBe` Right "unicode ሴ噸邫췯" `shouldParse` "unicode ሴ噸邫췯"
it "lexes block string" $ do it "lexes block string" $ do
runParser blockString [r|"""simple"""|] `shouldBe` Right "simple" parse blockString "" [r|"""simple"""|] `shouldParse` "simple"
runParser blockString [r|""" white space """|] parse blockString "" [r|""" white space """|]
`shouldBe` Right " white space " `shouldParse` " white space "
runParser blockString [r|"""contains " quote"""|] parse blockString "" [r|"""contains " quote"""|]
`shouldBe` Right [r|contains " quote|] `shouldParse` [r|contains " quote|]
runParser blockString [r|"""contains \""" triplequote"""|] parse blockString "" [r|"""contains \""" triplequote"""|]
`shouldBe` Right [r|contains """ triplequote|] `shouldParse` [r|contains """ triplequote|]
runParser blockString "\"\"\"multi\nline\"\"\"" `shouldBe` Right "multi\nline" parse blockString "" "\"\"\"multi\nline\"\"\"" `shouldParse` "multi\nline"
runParser blockString "\"\"\"multi\rline\r\nnormalized\"\"\"" parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
`shouldBe` Right "multi\nline\nnormalized" `shouldParse` "multi\nline\nnormalized"
runParser blockString "\"\"\"multi\rline\r\nnormalized\"\"\"" parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
`shouldBe` Right "multi\nline\nnormalized" `shouldParse` "multi\nline\nnormalized"
runParser blockString [r|"""unescaped \n\r\b\t\f\u1234"""|] parse blockString "" [r|"""unescaped \n\r\b\t\f\u1234"""|]
`shouldBe` Right [r|unescaped \n\r\b\t\f\u1234|] `shouldParse` [r|unescaped \n\r\b\t\f\u1234|]
runParser blockString [r|"""slashes \\ \/"""|] parse blockString "" [r|"""slashes \\ \/"""|]
`shouldBe` Right [r|slashes \\ \/|] `shouldParse` [r|slashes \\ \/|]
runParser blockString [r|""" parse blockString "" [r|"""
spans spans
multiple multiple
lines lines
"""|] `shouldBe` Right "spans\n multiple\n lines" """|] `shouldParse` "spans\n multiple\n lines"
it "lexes numbers" $ do it "lexes numbers" $ do
runParser integer "4" `shouldBe` Right (4 :: Int) parse integer "" "4" `shouldParse` (4 :: Int)
runParser float "4.123" `shouldBe` Right 4.123 parse float "" "4.123" `shouldParse` 4.123
runParser integer "-4" `shouldBe` Right (-4 :: Int) parse integer "" "-4" `shouldParse` (-4 :: Int)
runParser integer "9" `shouldBe` Right (9 :: Int) parse integer "" "9" `shouldParse` (9 :: Int)
runParser integer "0" `shouldBe` Right (0 :: Int) parse integer "" "0" `shouldParse` (0 :: Int)
runParser float "-4.123" `shouldBe` Right (-4.123) parse float "" "-4.123" `shouldParse` (-4.123)
runParser float "0.123" `shouldBe` Right 0.123 parse float "" "0.123" `shouldParse` 0.123
runParser float "123e4" `shouldBe` Right 123e4 parse float "" "123e4" `shouldParse` 123e4
runParser float "123E4" `shouldBe` Right 123E4 parse float "" "123E4" `shouldParse` 123E4
runParser float "123e-4" `shouldBe` Right 123e-4 parse float "" "123e-4" `shouldParse` 123e-4
runParser float "123e+4" `shouldBe` Right 123e+4 parse float "" "123e+4" `shouldParse` 123e+4
runParser float "-1.123e4" `shouldBe` Right (-1.123e4) parse float "" "-1.123e4" `shouldParse` (-1.123e4)
runParser float "-1.123E4" `shouldBe` Right (-1.123E4) parse float "" "-1.123E4" `shouldParse` (-1.123E4)
runParser float "-1.123e-4" `shouldBe` Right (-1.123e-4) parse float "" "-1.123e-4" `shouldParse` (-1.123e-4)
runParser float "-1.123e+4" `shouldBe` Right (-1.123e+4) parse float "" "-1.123e+4" `shouldParse` (-1.123e+4)
runParser float "-1.123e4567" `shouldBe` Right (-1.123e4567) parse float "" "-1.123e4567" `shouldParse` (-1.123e4567)
it "lexes punctuation" $ do it "lexes punctuation" $ do
runParser bang "!" `shouldBe` Right '!' parse bang "" "!" `shouldParse` '!'
runParser dollar "$" `shouldBe` Right '$' parse dollar "" "$" `shouldParse` '$'
runBetween parens "()" `shouldSatisfy` isRight runBetween parens `shouldSucceedOn` "()"
runParser spread "..." `shouldBe` Right "..." parse spread "" "..." `shouldParse` "..."
runParser colon ":" `shouldBe` Right ":" parse colon "" ":" `shouldParse` ":"
runParser equals "=" `shouldBe` Right "=" parse equals "" "=" `shouldParse` "="
runParser at "@" `shouldBe` Right '@' parse at "" "@" `shouldParse` '@'
runBetween brackets "[]" `shouldSatisfy` isRight runBetween brackets `shouldSucceedOn` "[]"
runBetween braces "{}" `shouldSatisfy` isRight runBetween braces `shouldSucceedOn` "{}"
runParser pipe "|" `shouldBe` Right "|" parse pipe "" "|" `shouldParse` "|"
context "Implementation tests" $ do context "Implementation tests" $ do
it "lexes empty block strings" $ it "lexes empty block strings" $
runParser blockString [r|""""""|] `shouldBe` Right "" parse blockString "" [r|""""""|] `shouldParse` ""
it "lexes ampersand" $ it "lexes ampersand" $
runParser amp "&" `shouldBe` Right "&" parse amp "" "&" `shouldParse` "&"
runParser :: forall a. Parser a -> Text -> Either (ParseErrorBundle Text Void) a
runParser = flip parse ""
runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) () runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) ()
runBetween parser = parse (parser $ pure ()) "" runBetween parser = parse (parser $ pure ()) ""

18
tests/Language/GraphQL/ParserSpec.hs
View File

@@ -4,27 +4,23 @@ module Language.GraphQL.ParserSpec
( spec ( spec
) where ) where
import Data.Either (isRight)
import Language.GraphQL.Parser (document) import Language.GraphQL.Parser (document)
import Test.Hspec ( Spec import Test.Hspec (Spec, describe, it)
, describe import Test.Hspec.Megaparsec (shouldSucceedOn)
, it
, shouldSatisfy
)
import Text.Megaparsec (parse) import Text.Megaparsec (parse)
import Text.RawString.QQ (r) import Text.RawString.QQ (r)
spec :: Spec spec :: Spec
spec = describe "Parser" $ do spec = describe "Parser" $ do
it "accepts BOM header" $ it "accepts BOM header" $
parse document "" "\xfeff{foo}" `shouldSatisfy` isRight parse document "" `shouldSucceedOn` "\xfeff{foo}"
it "accepts block strings as argument" $ it "accepts block strings as argument" $
parse document "" [r|{ parse document "" `shouldSucceedOn` [r|{
hello(text: """Argument""") hello(text: """Argument""")
}|] `shouldSatisfy` isRight }|]
it "accepts strings as argument" $ it "accepts strings as argument" $
parse document "" [r|{ parse document "" `shouldSucceedOn` [r|{
hello(text: "Argument") hello(text: "Argument")
}|] `shouldSatisfy` isRight }|]

33
tests/Test/KitchenSinkSpec.hs
View File

@@ -6,19 +6,13 @@ module Test.KitchenSinkSpec
import qualified Data.Text.IO as Text.IO import qualified Data.Text.IO as Text.IO
import qualified Data.Text.Lazy.IO as Text.Lazy.IO import qualified Data.Text.Lazy.IO as Text.Lazy.IO
import qualified Data.Text.Lazy as Lazy (Text)
import qualified Language.GraphQL.Encoder as Encoder import qualified Language.GraphQL.Encoder as Encoder
import qualified Language.GraphQL.Parser as Parser import qualified Language.GraphQL.Parser as Parser
import Paths_graphql (getDataFileName) import Paths_graphql (getDataFileName)
import Test.Hspec ( Spec import Test.Hspec (Spec, describe, it)
, describe import Test.Hspec.Megaparsec (parseSatisfies)
, it import Text.Megaparsec (parse)
)
import Test.Hspec.Expectations ( expectationFailure
, shouldBe
)
import Text.Megaparsec ( errorBundlePretty
, parse
)
import Text.RawString.QQ (r) import Text.RawString.QQ (r)
spec :: Spec spec :: Spec
@@ -26,17 +20,12 @@ spec = describe "Kitchen Sink" $ do
it "minifies the query" $ do it "minifies the query" $ do
dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql" dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql"
minFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql" minFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql"
actual <- Text.IO.readFile dataFileName
expected <- Text.Lazy.IO.readFile minFileName expected <- Text.Lazy.IO.readFile minFileName
either shouldNormalize Encoder.minified dataFileName expected
(expectationFailure . errorBundlePretty)
(flip shouldBe expected . Encoder.document Encoder.minified)
$ parse Parser.document dataFileName actual
it "pretty prints the query" $ do it "pretty prints the query" $ do
dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql" dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql"
actual <- Text.IO.readFile dataFileName
let expected = [r|query queryName($foo: ComplexType, $site: Site = MOBILE) { let expected = [r|query queryName($foo: ComplexType, $site: Site = MOBILE) {
whoever123is: node(id: [123, 456]) { whoever123is: node(id: [123, 456]) {
id id
@@ -70,7 +59,11 @@ fragment frag on Friend {
} }
|] |]
either shouldNormalize Encoder.pretty dataFileName expected
(expectationFailure . errorBundlePretty)
(flip shouldBe expected . Encoder.document Encoder.pretty) shouldNormalize :: Encoder.Formatter -> FilePath -> Lazy.Text -> IO ()
$ parse Parser.document dataFileName actual shouldNormalize formatter dataFileName expected = do
actual <- Text.IO.readFile dataFileName
parse Parser.document dataFileName actual `parseSatisfies` condition
where
condition = (expected ==) . Encoder.document formatter