diff --git a/Text/XML/Stream/Parse.hs b/Text/XML/Stream/Parse.hs
--- a/Text/XML/Stream/Parse.hs
+++ b/Text/XML/Stream/Parse.hs
@@ -87,6 +87,7 @@
import Control.Applicative (Applicative(..), Alternative(empty,(<|>)), (<$>))
import Data.Text (Text)
import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
import Data.Text.Read (Reader, decimal, hexadecimal)
import Data.Text.Encoding (decodeUtf32BEWith)
import Data.Text.Encoding.Error (ignore)
@@ -99,8 +100,9 @@
import qualified Data.Map as Map
import Data.Enumerator
( Iteratee, Enumeratee, (>>==), Stream (..), run_, Enumerator, Step (..)
- , checkDone, yield, ($$), joinI, run, throwError, returnI
+ , checkDone, yield, ($$), joinI, run, throwError, returnI, continue
)
+import Control.Monad (when)
import qualified Data.Enumerator as E
import qualified Data.Enumerator.List as EL
import qualified Data.Enumerator.Text as ET
@@ -201,8 +203,12 @@
-- with the parser provided by libxml-enumerator. However, this has the
-- advantage of not relying on any C libraries.
parseText :: Monad m => ParseSettings -> Enumeratee TS.Text Event m a
-parseText de =
- checkDone $ \k -> k (Chunks [EventBeginDocument]) >>== loop []
+parseText de step = do
+ -- drop the BOM
+ c <- peek
+ when (c == Just '\xfeef') $ ET.head >> return ()
+
+ (checkDone $ \k -> k (Chunks [EventBeginDocument]) >>== loop []) step
where
loop levels = checkDone $ go levels
go levels k = do
@@ -212,6 +218,13 @@
Just token ->
let (levels', events) = tokenToEvent levels token
in k (Chunks events) >>== loop levels'
+
+peek :: Monad m => Iteratee TS.Text m (Maybe Char)
+peek = continue loop where
+ loop (Chunks xs) = case TL.uncons (TL.fromChunks xs) of
+ Just (c, _) -> yield (Just c) $ Chunks xs
+ Nothing -> peek
+ loop EOF = yield Nothing EOF
data ParseSettings = ParseSettings
{ psDecodeEntities :: DecodeEntities
diff --git a/test/main.hs b/test/main.hs
--- a/test/main.hs
+++ b/test/main.hs
@@ -5,7 +5,7 @@
import Control.Monad.IO.Class (liftIO)
import Data.XML.Types
import Test.HUnit hiding (Test)
-import Test.Hspec
+import Test.Hspec.Monadic
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Text.XML.Unresolved as D
import qualified Text.XML.Stream.Parse as P
@@ -21,48 +21,45 @@
import Control.Exception (toException)
import Test.Hspec.HUnit ()
-main :: IO [Spec]
-main = hspec $ descriptions $
- [ describe "XML parsing and rendering"
- [ it "is idempotent to parse and render a document" documentParseRender
- , it "has valid parser combinators" combinators
- , it "has working choose function" testChoose
- , it "has working many function" testMany
- , it "has working orE" testOrE
- , it "is idempotent to parse and pretty render a document" documentParsePrettyRender
- ]
- , describe "XML Cursors"
- [ it "has correct parent" cursorParent
- , it "has correct ancestor" cursorAncestor
- , it "has correct orSelf" cursorOrSelf
- , it "has correct preceding" cursorPreceding
- , it "has correct following" cursorFollowing
- , it "has correct precedingSibling" cursorPrecedingSib
- , it "has correct followingSibling" cursorFollowingSib
- , it "has correct descendant" cursorDescendant
- , it "has correct check" cursorCheck
- , it "has correct check with lists" cursorPredicate
- , it "has correct checkNode" cursorCheckNode
- , it "has correct checkElement" cursorCheckElement
- , it "has correct checkName" cursorCheckName
- , it "has correct anyElement" cursorAnyElement
- , it "has correct element" cursorElement
- , it "has correct laxElement" cursorLaxElement
- , it "has correct content" cursorContent
- , it "has correct attribute" cursorAttribute
- , it "has correct laxAttribute" cursorLaxAttribute
- , it "has correct &* and $* operators" cursorDeep
- , it "has correct force" cursorForce
- , it "has correct forceM" cursorForceM
- , it "has correct hasAttribute" cursorHasAttribute
- , it "has correct attributeIs" cursorAttributeIs
- ]
- , describe "resolved"
- [ it "identifies unresolved entities" resolvedIdentifies
- , it "works for resolvable entities" resolvedAllGood
- , it "merges adjacent content nodes" resolvedMergeContent
- ]
- ]
+main :: IO ()
+main = hspecX $ do
+ describe "XML parsing and rendering" $ do
+ it "is idempotent to parse and render a document" documentParseRender
+ it "has valid parser combinators" combinators
+ it "has working choose function" testChoose
+ it "has working many function" testMany
+ it "has working orE" testOrE
+ it "is idempotent to parse and pretty render a document" documentParsePrettyRender
+ it "ignores the BOM" parseIgnoreBOM
+ describe "XML Cursors" $ do
+ it "has correct parent" cursorParent
+ it "has correct ancestor" cursorAncestor
+ it "has correct orSelf" cursorOrSelf
+ it "has correct preceding" cursorPreceding
+ it "has correct following" cursorFollowing
+ it "has correct precedingSibling" cursorPrecedingSib
+ it "has correct followingSibling" cursorFollowingSib
+ it "has correct descendant" cursorDescendant
+ it "has correct check" cursorCheck
+ it "has correct check with lists" cursorPredicate
+ it "has correct checkNode" cursorCheckNode
+ it "has correct checkElement" cursorCheckElement
+ it "has correct checkName" cursorCheckName
+ it "has correct anyElement" cursorAnyElement
+ it "has correct element" cursorElement
+ it "has correct laxElement" cursorLaxElement
+ it "has correct content" cursorContent
+ it "has correct attribute" cursorAttribute
+ it "has correct laxAttribute" cursorLaxAttribute
+ it "has correct &* and $* operators" cursorDeep
+ it "has correct force" cursorForce
+ it "has correct forceM" cursorForceM
+ it "has correct hasAttribute" cursorHasAttribute
+ it "has correct attributeIs" cursorAttributeIs
+ describe "resolved" $ do
+ it "identifies unresolved entities" resolvedIdentifies
+ it "works for resolvable entities" resolvedAllGood
+ it "merges adjacent content nodes" resolvedMergeContent
documentParseRender :: IO ()
documentParseRender =
@@ -287,3 +284,8 @@
Res.Element "foo" [] [Res.NodeContent "bar&baz"]
where
xml = "bar&baz"
+
+parseIgnoreBOM :: Assertion
+parseIgnoreBOM = do
+ either (const $ Left (1 :: Int)) Right (Res.parseText Res.def "\xfeef") @?=
+ either (const $ Left (2 :: Int)) Right (Res.parseText Res.def "")
diff --git a/xml-enumerator.cabal b/xml-enumerator.cabal
--- a/xml-enumerator.cabal
+++ b/xml-enumerator.cabal
@@ -1,5 +1,5 @@
name: xml-enumerator
-version: 0.4.2
+version: 0.4.2.1
license: BSD3
license-file: LICENSE
author: Michael Snoyman , Aristid Breitkreuz
@@ -63,7 +63,7 @@
, enumerator >= 0.4.14 && < 0.5
, bytestring >= 0.9 && < 0.10
, xml-enumerator >= 0.4 && < 0.5
- , hspec >= 0.6.1 && < 0.7
+ , hspec >= 0.6.1 && < 0.10
, HUnit >= 1.2 && < 1.3
, xml-types >= 0.3 && < 0.4