xeno 0.4.3 → 0.5
raw patch · 7 files changed
+142/−20 lines, 7 files
Files
- README.md +2/−1
- src/Xeno/DOM.hs +49/−6
- src/Xeno/DOM/Robust.hs +55/−5
- src/Xeno/Errors.hs +6/−4
- src/Xeno/SAX.hs +6/−0
- test/Main.hs +13/−2
- xeno.cabal +11/−2
README.md view
@@ -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.
src/Xeno/DOM.hs view
@@ -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
src/Xeno/DOM/Robust.hs view
@@ -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
src/Xeno/Errors.hs view
@@ -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)
src/Xeno/SAX.hs view
@@ -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 #-}
test/Main.hs view
@@ -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, "<some-example/>") ,(True, "<a numeric1=\"attribute\"/>") ,(True, "<also.a.dot></also.a.dot>")+ ]++ws_around_equals_sax :: [(Bool, ByteString)]+ws_around_equals_sax =+ [(True, "<o \nm = \"100\"\n gee = \"0\">") ] -- | We want to make sure that the parser doesn't jump out of the CDATA
xeno.cabal view
@@ -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