Parse the BOM header if any

graphql.cabal

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

src/Language/GraphQL/Lexer.hs

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

src/Language/GraphQL/Parser.hs

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

tests/Language/GraphQL/LexerSpec.hs

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

tests/Language/GraphQL/ParserSpec.hs

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