diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,6 +1,7 @@
# xeno
-[](https://travis-ci.org/ocramz/xeno) [](https://hackage.haskell.org/package/xeno) [](https://www.stackage.org/package/xeno)
+[](https://github.com/ocramz/xeno/actions) [](https://hackage.haskell.org/package/xeno) [](https://www.stackage.org/package/xeno)
+
A fast event-based XML parser.
diff --git a/src/Xeno/DOM.hs b/src/Xeno/DOM.hs
--- a/src/Xeno/DOM.hs
+++ b/src/Xeno/DOM.hs
@@ -3,6 +3,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP #-}
-- | DOM parser and API for XML.
module Xeno.DOM
@@ -18,12 +19,21 @@
import Control.Monad.ST
import Control.Spork
import Data.ByteString (ByteString)
+#if MIN_VERSION_bytestring(0,11,0)
+import Data.ByteString.Internal (ByteString(BS))
+#else
import Data.ByteString.Internal (ByteString(PS))
+#endif
import qualified Data.ByteString as S
import Data.Mutable
import Data.STRef
import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Unboxed.Mutable as UMV
+#if MIN_VERSION_bytestring(0,11,0)
+import Foreign.Ptr (minusPtr)
+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
+import System.IO.Unsafe (unsafeDupablePerformIO)
+#endif
import Xeno.SAX
import Xeno.Types
import Xeno.DOM.Internal
@@ -41,7 +51,11 @@
-- characters
Just 0x1 -> go (n+3)
_ -> Nothing
+#if MIN_VERSION_bytestring(0,11,0)
+ BS offset0 _ = str
+#else
PS _ offset0 _ = str
+#endif
node =
let !initialSize = max 1000 (S.length str `div` 8) in
runST
@@ -50,7 +64,11 @@
sizeRef <- fmap asURef (newRef 0)
parentRef <- fmap asURef (newRef 0)
process Process {
+#if MIN_VERSION_bytestring(0,11,0)
+ openF = \(BS name_start name_len) -> do
+#else
openF = \(PS _ name_start name_len) -> do
+#endif
let tag = 0x00
tag_end = -1
index <- readRef sizeRef
@@ -67,10 +85,14 @@
writeRef sizeRef (index + 5)
do UMV.unsafeWrite v' index tag
UMV.unsafeWrite v' (index + 1) tag_parent
- UMV.unsafeWrite v' (index + 2) (name_start - offset0)
+ UMV.unsafeWrite v' (index + 2) (distance name_start offset0)
UMV.unsafeWrite v' (index + 3) name_len
UMV.unsafeWrite v' (index + 4) tag_end
+#if MIN_VERSION_bytestring(0,11,0)
+ , attrF = \(BS key_start key_len) (BS value_start value_len) -> do
+#else
, attrF = \(PS _ key_start key_len) (PS _ value_start value_len) -> do
+#endif
index <- readRef sizeRef
v' <-
do v <- readSTRef vecRef
@@ -83,12 +105,16 @@
let tag = 0x02
do writeRef sizeRef (index + 5)
do UMV.unsafeWrite v' index tag
- UMV.unsafeWrite v' (index + 1) (key_start - offset0)
+ UMV.unsafeWrite v' (index + 1) (distance key_start offset0)
UMV.unsafeWrite v' (index + 2) key_len
- UMV.unsafeWrite v' (index + 3) (value_start - offset0)
+ UMV.unsafeWrite v' (index + 3) (distance value_start offset0)
UMV.unsafeWrite v' (index + 4) value_len
, endOpenF = \_ -> return ()
+#if MIN_VERSION_bytestring(0,11,0)
+ , textF = \(BS text_start text_len) -> do
+#else
, textF = \(PS _ text_start text_len) -> do
+#endif
let tag = 0x01
index <- readRef sizeRef
v' <-
@@ -101,7 +127,7 @@
return v'
do writeRef sizeRef (index + 3)
do UMV.unsafeWrite v' index tag
- UMV.unsafeWrite v' (index + 1) (text_start - offset0)
+ UMV.unsafeWrite v' (index + 1) (distance text_start offset0)
UMV.unsafeWrite v' (index + 2) text_len
, closeF = \_ -> do
v <- readSTRef vecRef
@@ -112,7 +138,11 @@
-- Pop the stack and return to the parent element.
previousParent <- UMV.unsafeRead v (parent + 1)
writeRef parentRef previousParent
+#if MIN_VERSION_bytestring(0,11,0)
+ , cdataF = \(BS cdata_start cdata_len) -> do
+#else
, cdataF = \(PS _ cdata_start cdata_len) -> do
+#endif
let tag = 0x03
index <- readRef sizeRef
v' <- do
@@ -125,7 +155,7 @@
return v'
writeRef sizeRef (index + 3)
UMV.unsafeWrite v' index tag
- UMV.unsafeWrite v' (index + 1) (cdata_start - offset0)
+ UMV.unsafeWrite v' (index + 1) (distance cdata_start offset0)
UMV.unsafeWrite v' (index + 2) cdata_len
} str
wet <- readSTRef vecRef
@@ -140,7 +170,7 @@
predictGrowSize bsStart bsLen index vecLen =
let -- at least 1 so we don't divide by zero below and end up with
-- a negative grow size if (bsStart + bsLen - offset0) == 0
- processedLen = max 1 (bsStart + bsLen - offset0)
+ processedLen = max 1 (distance bsStart offset0 + bsLen)
-- 1. Using integral operations, such as
-- "predictedTotalSize = (index * S.length str) `div` processedLen"
-- cause overflow, so we use float.
@@ -150,3 +180,16 @@
predictedTotalSize = round $ fromIntegral index * k
growSize = predictedTotalSize - vecLen
in growSize
+
+#if MIN_VERSION_bytestring(0,11,0)
+minusForeignPtr :: ForeignPtr a -> ForeignPtr b -> Int
+minusForeignPtr fpA fpB = unsafeDupablePerformIO $
+ withForeignPtr fpA $ \ptrA -> withForeignPtr fpB $ \ptrB ->
+ pure (minusPtr ptrA ptrB)
+
+distance :: ForeignPtr a -> ForeignPtr b -> Int
+distance = minusForeignPtr
+#else
+distance :: Int -> Int -> Int
+distance a b = a - b
+#endif
diff --git a/src/Xeno/DOM/Robust.hs b/src/Xeno/DOM/Robust.hs
--- a/src/Xeno/DOM/Robust.hs
+++ b/src/Xeno/DOM/Robust.hs
@@ -3,6 +3,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP #-}
-- | DOM parser and API for XML.
-- Slightly slower DOM parsing,
-- but add missing close tags.
@@ -18,11 +19,20 @@
import Control.Monad.ST
import Control.Spork
+#if MIN_VERSION_bytestring(0,11,0)
+import Data.ByteString.Internal as BS (ByteString(..), plusForeignPtr)
+#else
import Data.ByteString.Internal(ByteString(..))
+#endif
import Data.STRef
import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Unboxed.Mutable as UMV
import Data.Mutable(asURef, newRef, readRef, writeRef)
+#if MIN_VERSION_bytestring(0,11,0)
+import Foreign.Ptr (minusPtr)
+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
+import System.IO.Unsafe (unsafeDupablePerformIO)
+#endif
import Xeno.SAX
import Xeno.Types
import Xeno.DOM.Internal(Node(..), Content(..), name, attributes, contents, children)
@@ -45,7 +55,11 @@
-- characters
Just 0x1 -> go (n+3)
_ -> Nothing
+#if MIN_VERSION_bytestring(0,11,0)
+ BS offset0 _ = str
+#else
PS _ offset0 _ = str
+#endif
str = skipDoctype inp
node =
runST
@@ -54,7 +68,11 @@
sizeRef <- fmap asURef $ newRef 0
parentRef <- fmap asURef $ newRef 0
process Process {
+#if MIN_VERSION_bytestring(0,11,0)
+ openF = \(BS name_start name_len) -> do
+#else
openF = \(PS _ name_start name_len) -> do
+#endif
let tag = 0x00
tag_end = -1
index <- readRef sizeRef
@@ -71,10 +89,14 @@
writeRef sizeRef (index + 5)
UMV.write v' index tag
UMV.write v' (index + 1) tag_parent
- UMV.write v' (index + 2) (name_start - offset0)
+ UMV.write v' (index + 2) (distance name_start offset0)
UMV.write v' (index + 3) name_len
UMV.write v' (index + 4) tag_end
+#if MIN_VERSION_bytestring(0,11,0)
+ , attrF = \(BS key_start key_len) (BS value_start value_len) -> do
+#else
, attrF = \(PS _ key_start key_len) (PS _ value_start value_len) -> do
+#endif
index <- readRef sizeRef
v' <-
do v <- readSTRef vecRef
@@ -87,12 +109,16 @@
let tag = 0x02
do writeRef sizeRef (index + 5)
do UMV.write v' index tag
- UMV.write v' (index + 1) (key_start - offset0)
+ UMV.write v' (index + 1) (distance key_start offset0)
UMV.write v' (index + 2) key_len
- UMV.write v' (index + 3) (value_start - offset0)
+ UMV.write v' (index + 3) (distance value_start offset0)
UMV.write v' (index + 4) value_len
, endOpenF = \_ -> return ()
+#if MIN_VERSION_bytestring(0,11,0)
+ , textF = \(BS text_start text_len) -> do
+#else
, textF = \(PS _ text_start text_len) -> do
+#endif
let tag = 0x01
index <- readRef sizeRef
v' <-
@@ -105,9 +131,13 @@
return v'
do writeRef sizeRef (index + 3)
do UMV.write v' index tag
- UMV.write v' (index + 1) (text_start - offset0)
+ UMV.write v' (index + 1) (distance text_start offset0)
UMV.write v' (index + 2) text_len
+#if MIN_VERSION_bytestring(0,11,0)
+ , closeF = \closeTag@(BS _ _) -> do
+#else
, closeF = \closeTag@(PS s _ _) -> do
+#endif
v <- readSTRef vecRef
-- Set the tag_end slot of the parent.
index <- readRef sizeRef
@@ -118,14 +148,22 @@
else do
parent_name <- UMV.read v (parent + 2)
parent_len <- UMV.read v (parent + 3)
+#if MIN_VERSION_bytestring(0,11,0)
+ let openTag = BS (BS.plusForeignPtr offset0 parent_name) parent_len
+#else
let openTag = PS s (parent_name+offset0) parent_len
+#endif
return $ openTag == closeTag
UMV.write v (parent + 4) index
-- Pop the stack and return to the parent element.
previousParent <- UMV.read v (parent + 1)
writeRef parentRef previousParent
return correctTag -- continue closing tags, until matching one is found
+#if MIN_VERSION_bytestring(0,11,0)
+ , cdataF = \(BS cdata_start cdata_len) -> do
+#else
, cdataF = \(PS _ cdata_start cdata_len) -> do
+#endif
let tag = 0x03
index <- readRef sizeRef
v' <-
@@ -138,7 +176,7 @@
return v'
do writeRef sizeRef (index + 3)
do UMV.write v' index tag
- UMV.write v' (index + 1) (cdata_start - offset0)
+ UMV.write v' (index + 1) (distance cdata_start offset0)
UMV.write v' (index + 2) cdata_len
} str
wet <- readSTRef vecRef
@@ -153,3 +191,15 @@
True -> return ()
False -> untilM loop
+#if MIN_VERSION_bytestring(0,11,0)
+minusForeignPtr :: ForeignPtr a -> ForeignPtr b -> Int
+minusForeignPtr fpA fpB = unsafeDupablePerformIO $
+ withForeignPtr fpA $ \ptrA -> withForeignPtr fpB $ \ptrB ->
+ pure (minusPtr ptrA ptrB)
+
+distance :: ForeignPtr a -> ForeignPtr b -> Int
+distance = minusForeignPtr
+#else
+distance :: Int -> Int -> Int
+distance a b = a - b
+#endif
diff --git a/src/Xeno/Errors.hs b/src/Xeno/Errors.hs
--- a/src/Xeno/Errors.hs
+++ b/src/Xeno/Errors.hs
@@ -34,6 +34,7 @@
bshow = BS.pack . show
{-# INLINE CONLIKE getStartIndex #-}
+-- FIXME remove this; there's no offset in the bytestring.
getStartIndex :: BS.ByteString -> Int
getStartIndex (PS _ from _) = from
@@ -54,8 +55,9 @@
-- | Take n last bytes.
revTake :: Int -> BS.ByteString -> BS.ByteString
-revTake i (PS ptr from to) = PS ptr (end-len) len
+revTake i bs =
+ if i >= len
+ then bs
+ else BS.drop (len - i) bs
where
- end = from + to
- len = min to i
-
+ len = fromIntegral (BS.length bs)
diff --git a/src/Xeno/SAX.hs b/src/Xeno/SAX.hs
--- a/src/Xeno/SAX.hs
+++ b/src/Xeno/SAX.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE LambdaCase #-}
@@ -323,8 +324,13 @@
= throw (XenoParseError index ("Expected =, got: " <> S.singleton (s_index' str afterAttrName) <> " at character index: " <> (S8.pack . show) afterAttrName))
where
index = skipSpaces str index0
+#ifdef WHITESPACE_AROUND_EQUALS
+ afterAttrName = skipSpaces str (parseName str index)
+ quoteIndex = skipSpaces str (afterAttrName + 1)
+#else
afterAttrName = parseName str index
quoteIndex = afterAttrName + 1
+#endif
usedChar = s_index' str quoteIndex
{-# INLINE process #-}
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -64,8 +65,13 @@
describe
"hexml tests"
(do mapM_
- (\(v, i) -> it (show i) (shouldBe (validate i) v))
- (hexml_examples_sax ++ extra_examples_sax)
+ (\(v, i) -> it (show i) (shouldBe (validate i) v)) $ concat
+ [ hexml_examples_sax
+ , extra_examples_sax
+#ifdef WHITESPACE_AROUND_EQUALS
+ , ws_around_equals_sax
+#endif
+ ]
mapM_
(\(v, i) -> it (show i) (shouldBe (either (Left . show) (Right . id) (contents <$> parse i)) v))
cdata_tests
@@ -153,6 +159,11 @@
[(True, "")
,(True, "")
,(True, "")
+ ]
+
+ws_around_equals_sax :: [(Bool, ByteString)]
+ws_around_equals_sax =
+ [(True, "")
]
-- | We want to make sure that the parser doesn't jump out of the CDATA
diff --git a/xeno.cabal b/xeno.cabal
--- a/xeno.cabal
+++ b/xeno.cabal
@@ -1,5 +1,5 @@
name: xeno
-version: 0.4.3
+version: 0.5
synopsis: A fast event-based XML parser in pure Haskell
description: A fast, low-memory use, event-based XML parser in pure Haskell.
build-type: Simple
@@ -10,7 +10,7 @@
license-file: LICENSE
author: Christopher Done
maintainer: Marco Zocca (ocramz fripost org)
-tested-with: GHC == 8.0.1, GHC == 8.2.2, GHC == 8.4.2, GHC == 8.4.4, GHC == 8.6.5
+tested-with: GHC == 8.0.1, GHC == 8.2.2, GHC == 8.4.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 9.0.1
extra-source-files: README.md
CHANGELOG.markdown
CONTRIBUTORS.md
@@ -24,6 +24,10 @@
description: Include libxml2 in the benchmarks
default: False
+flag whitespace-around-equals
+ description: Correctly parse whitespace around the = characters in attribute definitions
+ default: False
+
library
hs-source-dirs: src
ghc-options: -Wall -O2
@@ -37,6 +41,9 @@
, array >= 0.5.1
, mutable-containers >= 0.3.3
, mtl >= 2.2.1
+ if flag(whitespace-around-equals)
+ cpp-options: -DWHITESPACE_AROUND_EQUALS
+
default-language: Haskell2010
test-suite xeno-test
@@ -47,6 +54,8 @@
-- | DEBUG
, hspec
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
+ if flag(whitespace-around-equals)
+ cpp-options: -DWHITESPACE_AROUND_EQUALS
default-language: Haskell2010
benchmark xeno-speed-bench