Parse the BOM header if any

This commit is contained in:
Eugen Wissner 2019-07-22 05:50:00 +02:00
parent 9d15b83164
commit 1b5094b6a3
5 changed files with 44 additions and 9 deletions

View File

@ -4,7 +4,7 @@ cabal-version: 1.12
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: 36fc8a7c107b61579191035619873e2001628165d12013cef25921cd7e31a240 -- hash: 0738bb4bfceb40525227c29cb0c32d360f528ba3a84890817c65f5950e37b311
name: graphql name: graphql
version: 0.4.0.0 version: 0.4.0.0
@ -67,6 +67,7 @@ test-suite tasty
main-is: Spec.hs main-is: Spec.hs
other-modules: other-modules:
Language.GraphQL.LexerSpec Language.GraphQL.LexerSpec
Language.GraphQL.ParserSpec
Test.KitchenSinkSpec Test.KitchenSinkSpec
Test.StarWars.Data Test.StarWars.Data
Test.StarWars.QuerySpec Test.StarWars.QuerySpec

View File

@ -1,5 +1,8 @@
{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
-- | This module defines a bunch of small parsers used to parse individual
-- lexemes.
module Language.GraphQL.Lexer module Language.GraphQL.Lexer
( Parser ( Parser
, amp , amp
@ -22,6 +25,7 @@ module Language.GraphQL.Lexer
, spread , spread
, string , string
, symbol , symbol
, unicodeBOM
) where ) where
import Control.Applicative ( Alternative(..) import Control.Applicative ( Alternative(..)
@ -44,6 +48,7 @@ import Text.Megaparsec ( Parsec
, notFollowedBy , notFollowedBy
, oneOf , oneOf
, option , option
, optional
, satisfy , satisfy
, sepBy , sepBy
, skipSome , skipSome
@ -73,9 +78,11 @@ spaceConsumer = Lexer.space ignoredCharacters comment empty
comment :: Parser () comment :: Parser ()
comment = Lexer.skipLineComment "#" comment = Lexer.skipLineComment "#"
-- | Lexeme definition which ignores whitespaces and commas.
lexeme :: forall a. Parser a -> Parser a lexeme :: forall a. Parser a -> Parser a
lexeme = Lexer.lexeme spaceConsumer lexeme = Lexer.lexeme spaceConsumer
-- | Symbol definition which ignores whitespaces and commas.
symbol :: T.Text -> Parser T.Text symbol :: T.Text -> Parser T.Text
symbol = Lexer.symbol spaceConsumer symbol = Lexer.symbol spaceConsumer
@ -213,3 +220,7 @@ escapeSequence = do
_ -> return escaped _ -> return escaped
where where
step accumulator = (accumulator * 16 +) . digitToInt step accumulator = (accumulator * 16 +) . digitToInt
-- | Parser for the "Byte Order Mark".
unicodeBOM :: Parser ()
unicodeBOM = optional (char '\xfeff') >> pure ()

View File

@ -17,7 +17,7 @@ import Text.Megaparsec ( lookAhead
) )
document :: Parser Document document :: Parser Document
document = spaceConsumer >> lexeme (manyNE definition) document = unicodeBOM >> spaceConsumer >> lexeme (manyNE definition)
definition :: Parser Definition definition :: Parser Definition
definition = DefinitionOperation <$> operationDefinition definition = DefinitionOperation <$> operationDefinition

View File

@ -5,14 +5,16 @@ module Language.GraphQL.LexerSpec
( spec ( spec
) where ) where
import Language.GraphQL.Lexer import Data.Either (isRight)
import qualified Data.Text as T import Data.Text (Text)
import Data.Void (Void) import Data.Void (Void)
import Language.GraphQL.Lexer
import Test.Hspec ( Spec import Test.Hspec ( Spec
, context , context
, describe , describe
, it , it
, shouldBe , shouldBe
, shouldSatisfy
) )
import Text.Megaparsec ( ParseErrorBundle import Text.Megaparsec ( ParseErrorBundle
, parse , parse
@ -22,6 +24,9 @@ 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" $
runParser unicodeBOM "\xfeff" `shouldSatisfy` isRight
it "lexes strings" $ do it "lexes strings" $ do
runParser string [r|"simple"|] `shouldBe` Right "simple" runParser string [r|"simple"|] `shouldBe` Right "simple"
runParser string [r|" white space "|] `shouldBe` Right " white space " runParser string [r|" white space "|] `shouldBe` Right " white space "
@ -77,13 +82,13 @@ spec = describe "Lexer" $ do
it "lexes punctuation" $ do it "lexes punctuation" $ do
runParser bang "!" `shouldBe` Right '!' runParser bang "!" `shouldBe` Right '!'
runParser dollar "$" `shouldBe` Right '$' runParser dollar "$" `shouldBe` Right '$'
runBetween parens "()" `shouldBe` Right () runBetween parens "()" `shouldSatisfy` isRight
runParser spread "..." `shouldBe` Right "..." runParser spread "..." `shouldBe` Right "..."
runParser colon ":" `shouldBe` Right ":" runParser colon ":" `shouldBe` Right ":"
runParser equals "=" `shouldBe` Right "=" runParser equals "=" `shouldBe` Right "="
runParser at "@" `shouldBe` Right '@' runParser at "@" `shouldBe` Right '@'
runBetween brackets "[]" `shouldBe` Right () runBetween brackets "[]" `shouldSatisfy` isRight
runBetween braces "{}" `shouldBe` Right () runBetween braces "{}" `shouldSatisfy` isRight
runParser pipe "|" `shouldBe` Right "|" runParser pipe "|" `shouldBe` Right "|"
context "Implementation tests" $ do context "Implementation tests" $ do
@ -92,8 +97,8 @@ spec = describe "Lexer" $ do
it "lexes ampersand" $ it "lexes ampersand" $
runParser amp "&" `shouldBe` Right "&" runParser amp "&" `shouldBe` Right "&"
runParser :: forall a. Parser a -> T.Text -> Either (ParseErrorBundle T.Text Void) a runParser :: forall a. Parser a -> Text -> Either (ParseErrorBundle Text Void) a
runParser = flip parse "" runParser = flip parse ""
runBetween :: (Parser () -> Parser ()) -> T.Text -> Either (ParseErrorBundle T.Text Void) () runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) ()
runBetween parser = parse (parser $ pure ()) "" runBetween parser = parse (parser $ pure ()) ""

View File

@ -0,0 +1,18 @@
{-# LANGUAGE OverloadedStrings #-}
module Language.GraphQL.ParserSpec
( spec
) where
import Data.Either (isRight)
import Language.GraphQL.Parser (document)
import Test.Hspec ( Spec
, describe
, it
, shouldSatisfy
)
import Text.Megaparsec (parse)
spec :: Spec
spec = describe "Parser" $
it "accepts BOM header" $
parse document "" "\xfeff{foo}" `shouldSatisfy` isRight