hw-xml 0.4.0.1 → 0.4.0.2

raw patch · 27 files changed

+702/−706 lines, 27 filesdep ~basedep ~generic-lensPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, generic-lens

API changes (from Hackage documentation)

Files

• app/App/Commands/CreateBpIndex.hs +1/−1
• app/App/Commands/CreateIbIndex.hs +3/−5
• bench/Main.hs +12/−10
• hw-xml.cabal +122/−119
• src/HaskellWorks/Data/Xml/Blank.hs +67/−65
• src/HaskellWorks/Data/Xml/Conduit.hs +0/−142
• src/HaskellWorks/Data/Xml/Conduit/Blank.hs +0/−151
• src/HaskellWorks/Data/Xml/Conduit/Words.hs +0/−36
• src/HaskellWorks/Data/Xml/Decode.hs +1/−1
• src/HaskellWorks/Data/Xml/Grammar.hs +3/−3
• src/HaskellWorks/Data/Xml/Internal/BalancedParens.hs +42/−0
• src/HaskellWorks/Data/Xml/Internal/Blank.hs +153/−0
• src/HaskellWorks/Data/Xml/Internal/ByteString.hs +14/−0
• src/HaskellWorks/Data/Xml/Internal/List.hs +58/−0
• src/HaskellWorks/Data/Xml/Internal/Tables.hs +32/−0
• src/HaskellWorks/Data/Xml/Internal/ToIbBp64.hs +10/−30
• src/HaskellWorks/Data/Xml/Internal/Words.hs +36/−0
• src/HaskellWorks/Data/Xml/Succinct/Cursor/BalancedParens.hs +6/−5
• src/HaskellWorks/Data/Xml/Succinct/Cursor/BlankedXml.hs +1/−1
• src/HaskellWorks/Data/Xml/Succinct/Cursor/InterestBits.hs +1/−1
• src/HaskellWorks/Data/Xml/Succinct/Cursor/Internal.hs +1/−1
• src/HaskellWorks/Data/Xml/Succinct/Cursor/Token.hs +1/−1
• src/HaskellWorks/Data/Xml/Value.hs +3/−3
• test/HaskellWorks/Data/Xml/Conduit/BlankSpec.hs +0/−121
• test/HaskellWorks/Data/Xml/Internal/BlankSpec.hs +121/−0
• test/HaskellWorks/Data/Xml/Succinct/Cursor/BalancedParensSpec.hs +11/−8
• test/HaskellWorks/Data/Xml/Token/TokenizeSpec.hs +3/−2

@@ -27,7 +27,7 @@    lbs <- LBS.readFile input   let blankedXml = lbsToBlankedXml lbs-  let ib = toBalancedParens64' blankedXml+  let ib = toBalancedParens64 blankedXml   LBS.writeFile output (LBS.fromChunks ib)    return ()

@@ -22,15 +22,13 @@  runCreateIbIndex :: Z.CreateIbIndexOptions -> IO () runCreateIbIndex opt = do-  let input     = opt ^. the @"input"+  let input   = opt ^. the @"input"   let output  = opt ^. the @"output"    lbs <- LBS.readFile input-  let blankedXml = lbsToBlankedXml lbs-  let ib = toInterestBits64' blankedXml+  let blankedXml  = lbsToBlankedXml lbs+  let ib          = toInterestBits64 blankedXml   LBS.writeFile output (LBS.fromChunks ib)--  return ()  optsCreateIbIndex :: Parser Z.CreateIbIndexOptions optsCreateIbIndex = Z.CreateIbIndexOptions

@@ -4,13 +4,15 @@ module Main where  import Criterion.Main+import Data.ByteString                         (ByteString) import Data.Word import Foreign import HaskellWorks.Data.BalancedParens.Simple import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.FromByteString-import HaskellWorks.Data.Xml.Conduit-import HaskellWorks.Data.Xml.Conduit.Blank+import HaskellWorks.Data.Xml.Internal.Blank+import HaskellWorks.Data.Xml.Internal.List+import HaskellWorks.Data.Xml.Internal.Tables import HaskellWorks.Data.Xml.Succinct.Cursor import System.IO.MMap @@ -18,23 +20,23 @@ import qualified Data.ByteString.Internal as BSI import qualified Data.Vector.Storable     as DVS -setupEnvXml :: FilePath -> IO BS.ByteString+setupEnvXml :: FilePath -> IO ByteString setupEnvXml filepath = do   (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing   let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size   return bs -loadXml :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))-loadXml bs = fromByteString bs :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+loadXml :: ByteString -> XmlCursor ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+loadXml bs = fromByteString bs :: XmlCursor ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)) -xmlToInterestBits3 :: [BS.ByteString] -> [BS.ByteString]+xmlToInterestBits3 :: [ByteString] -> [ByteString] xmlToInterestBits3 = blankedXmlToInterestBits . blankXml -runCon :: ([i] -> [BS.ByteString]) -> i -> BS.ByteString+runCon :: ([i] -> [ByteString]) -> i -> ByteString runCon con bs = BS.concat $ con [bs] -benchRankXmlCatalogConduits :: [Benchmark]-benchRankXmlCatalogConduits =+benchRankXmlCatalogLists :: [Benchmark]+benchRankXmlCatalogLists =   [ env (setupEnvXml "data/catalog.xml") $ \bs -> bgroup "catalog.xml"     [ bench "Run blankXml"            (whnf (runCon blankXml          ) bs)     , bench "Run xmlToInterestBits3"  (whnf (runCon xmlToInterestBits3) bs)@@ -57,5 +59,5 @@ main :: IO () main = defaultMain $ concat   [ benchIsInterestingWord8-  , benchRankXmlCatalogConduits+  , benchRankXmlCatalogLists   ]

@@ -1,29 +1,29 @@-cabal-version:      2.2+cabal-version: 2.2 -name:               hw-xml-version:            0.4.0.1-synopsis:           Conduits for tokenizing streams.-description:        Conduits for tokenizing streams. Please see README.md-category:           Data, XML, Succinct Data Structures, Data Structures-homepage:           http://github.com/haskell-works/hw-xml#readme-bug-reports:        https://github.com/haskell-works/hw-xml/issues-author:             John Ky,-                    Alexey Raga-maintainer:         alexey.raga@gmail.com-copyright:          2016-2019 John Ky-                  , 2016-2019 Alexey Raga-license:            BSD-3-Clause-license-file:       LICENSE-build-type:         Simple-extra-source-files: README.md-data-files:-  data/catalog.xml+name:                 hw-xml+version:              0.4.0.2+synopsis:             XML parser based on succinct data structures.+description:          XML parser based on succinct data structures. Please see README.md+category:             Data, XML, Succinct Data Structures, Data Structures+homepage:             http://github.com/haskell-works/hw-xml#readme+bug-reports:          https://github.com/haskell-works/hw-xml/issues+author:               John Ky,+                      Alexey Raga+maintainer:           alexey.raga@gmail.com+copyright:            2016-2019 John Ky+                  ,   2016-2019 Alexey Raga+license:              BSD-3-Clause+license-file:         LICENSE+tested-with:          GHC == 8.8.1, GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2+build-type:           Simple+extra-source-files:   README.md+data-files:           data/catalog.xml  source-repository head   type: git   location: https://github.com/haskell-works/hw-xml -common base                       { build-depends: base                       >= 4.7        && < 5      }+common base                       { build-depends: base                       >= 4.10       && < 5      }  common ansi-wl-pprint             { build-depends: ansi-wl-pprint             >= 0.6.9      && < 0.7    } common array                      { build-depends: array                      >= 0.5.2.0    && < 0.6    }@@ -33,7 +33,7 @@ common containers                 { build-depends: containers                 >= 0.6.2.1    && < 0.7    } common criterion                  { build-depends: criterion                  >= 1.5.5.0    && < 1.6    } common deepseq                    { build-depends: deepseq                    >= 1.4.3.0    && < 1.5    }-common generic-lens               { build-depends: generic-lens               >= 1.1.0.0    && < 1.3    }+common generic-lens               { build-depends: generic-lens               >= 1.2.0.1    && < 1.3    } common ghc-prim                   { build-depends: ghc-prim                   >= 0.5        && < 0.6    } common hedgehog                   { build-depends: hedgehog                   >= 1.0        && < 1.1    } common hspec                      { build-depends: hspec                      >= 2.5        && < 3.0    }@@ -55,65 +55,70 @@ common word8                      { build-depends: word8                      >= 0.1.3      && < 0.2    }  common config-  default-language: Haskell2010+  default-language:   Haskell2010 +common hw-xml+  build-depends: hw-xml+ library-  import:   base, config-          , ansi-wl-pprint-          , array-          , attoparsec-          , base-          , bytestring-          , cereal-          , containers-          , deepseq-          , ghc-prim-          , hw-balancedparens-          , hw-bits-          , hw-parser-          , hw-prim-          , hw-rankselect-          , hw-rankselect-base-          , lens-          , mmap-          , mtl-          , resourcet-          , transformers-          , vector-          , word8-  exposed-modules:-    HaskellWorks.Data.Xml-    HaskellWorks.Data.Xml.Blank-    HaskellWorks.Data.Xml.CharLike-    HaskellWorks.Data.Xml.Conduit-    HaskellWorks.Data.Xml.Conduit.Blank-    HaskellWorks.Data.Xml.Conduit.Words-    HaskellWorks.Data.Xml.Decode-    HaskellWorks.Data.Xml.DecodeError-    HaskellWorks.Data.Xml.DecodeResult-    HaskellWorks.Data.Xml.Grammar-    HaskellWorks.Data.Xml.Index-    HaskellWorks.Data.Xml.Internal.ToIbBp64-    HaskellWorks.Data.Xml.Lens-    HaskellWorks.Data.Xml.Succinct-    HaskellWorks.Data.Xml.Succinct.Cursor-    HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParens-    HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml-    HaskellWorks.Data.Xml.Succinct.Cursor.Create-    HaskellWorks.Data.Xml.Succinct.Cursor.InterestBits-    HaskellWorks.Data.Xml.Succinct.Cursor.Internal-    HaskellWorks.Data.Xml.Succinct.Cursor.Load-    HaskellWorks.Data.Xml.Succinct.Cursor.Types-    HaskellWorks.Data.Xml.Succinct.Cursor.MMap-    HaskellWorks.Data.Xml.Succinct.Cursor.Token-    HaskellWorks.Data.Xml.Succinct.Index-    HaskellWorks.Data.Xml.RawDecode-    HaskellWorks.Data.Xml.RawValue-    HaskellWorks.Data.Xml.Token.Tokenize-    HaskellWorks.Data.Xml.Token.Types-    HaskellWorks.Data.Xml.Token-    HaskellWorks.Data.Xml.Type-    HaskellWorks.Data.Xml.Value+  import:             base, config+                    , ansi-wl-pprint+                    , array+                    , attoparsec+                    , base+                    , bytestring+                    , cereal+                    , containers+                    , deepseq+                    , ghc-prim+                    , hw-balancedparens+                    , hw-bits+                    , hw-parser+                    , hw-prim+                    , hw-rankselect+                    , hw-rankselect-base+                    , lens+                    , mmap+                    , mtl+                    , resourcet+                    , transformers+                    , vector+                    , word8+  exposed-modules:    HaskellWorks.Data.Xml+                      HaskellWorks.Data.Xml.Blank+                      HaskellWorks.Data.Xml.CharLike+                      HaskellWorks.Data.Xml.Decode+                      HaskellWorks.Data.Xml.DecodeError+                      HaskellWorks.Data.Xml.DecodeResult+                      HaskellWorks.Data.Xml.Grammar+                      HaskellWorks.Data.Xml.Index+                      HaskellWorks.Data.Xml.Internal.BalancedParens+                      HaskellWorks.Data.Xml.Internal.ByteString+                      HaskellWorks.Data.Xml.Internal.Blank+                      HaskellWorks.Data.Xml.Internal.List+                      HaskellWorks.Data.Xml.Internal.Tables+                      HaskellWorks.Data.Xml.Internal.ToIbBp64+                      HaskellWorks.Data.Xml.Internal.Words+                      HaskellWorks.Data.Xml.Lens+                      HaskellWorks.Data.Xml.Succinct+                      HaskellWorks.Data.Xml.Succinct.Cursor+                      HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParens+                      HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml+                      HaskellWorks.Data.Xml.Succinct.Cursor.Create+                      HaskellWorks.Data.Xml.Succinct.Cursor.InterestBits+                      HaskellWorks.Data.Xml.Succinct.Cursor.Internal+                      HaskellWorks.Data.Xml.Succinct.Cursor.Load+                      HaskellWorks.Data.Xml.Succinct.Cursor.Types+                      HaskellWorks.Data.Xml.Succinct.Cursor.MMap+                      HaskellWorks.Data.Xml.Succinct.Cursor.Token+                      HaskellWorks.Data.Xml.Succinct.Index+                      HaskellWorks.Data.Xml.RawDecode+                      HaskellWorks.Data.Xml.RawValue+                      HaskellWorks.Data.Xml.Token.Tokenize+                      HaskellWorks.Data.Xml.Token.Types+                      HaskellWorks.Data.Xml.Token+                      HaskellWorks.Data.Xml.Type+                      HaskellWorks.Data.Xml.Value   other-modules:      Paths_hw_xml   autogen-modules:    Paths_hw_xml   hs-source-dirs:     src@@ -128,6 +133,7 @@           , hw-bits           , hw-prim           , hw-rankselect+          , hw-xml           , lens           , mmap           , mtl@@ -151,57 +157,54 @@                         App.Show                         App.Naive   autogen-modules:      Paths_hw_xml-  build-depends:        hw-xml   hs-source-dirs:       app   ghc-options:          -threaded -rtsopts -with-rtsopts=-N -O2 -Wall -msse4.2  test-suite hw-xml-test-  import:   base, config-          , attoparsec-          , base-          , bytestring-          , hedgehog-          , hspec-          , hw-balancedparens-          , hw-bits-          , hw-hspec-hedgehog-          , hw-prim-          , hw-rankselect-          , hw-rankselect-base-          , vector+  import:             base, config+                    , attoparsec+                    , base+                    , bytestring+                    , hedgehog+                    , hspec+                    , hw-balancedparens+                    , hw-bits+                    , hw-hspec-hedgehog+                    , hw-prim+                    , hw-xml+                    , hw-rankselect+                    , hw-rankselect-base+                    , vector   type:               exitcode-stdio-1.0   main-is:            Spec.hs   hs-source-dirs:     test-  build-depends:      hw-xml   ghc-options:        -threaded -rtsopts -with-rtsopts=-N   default-language:   Haskell2010   build-tool-depends: hspec-discover:hspec-discover   autogen-modules:    Paths_hw_xml-  other-modules:-    HaskellWorks.Data.Xml.Conduit.BlankSpec-    HaskellWorks.Data.Xml.RawValueSpec-    HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParensSpec-    HaskellWorks.Data.Xml.Succinct.Cursor.InterestBitsSpec-    HaskellWorks.Data.Xml.Succinct.CursorSpec-    HaskellWorks.Data.Xml.Token.TokenizeSpec-    HaskellWorks.Data.Xml.TypeSpec-    Paths_hw_xml+  other-modules:      HaskellWorks.Data.Xml.Internal.BlankSpec+                      HaskellWorks.Data.Xml.RawValueSpec+                      HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParensSpec+                      HaskellWorks.Data.Xml.Succinct.Cursor.InterestBitsSpec+                      HaskellWorks.Data.Xml.Succinct.CursorSpec+                      HaskellWorks.Data.Xml.Token.TokenizeSpec+                      HaskellWorks.Data.Xml.TypeSpec+                      Paths_hw_xml  benchmark bench-  import:   base, config-          , bytestring-          , criterion-          , hw-balancedparens-          , hw-bits-          , hw-prim-          , mmap-          , resourcet-          , vector-  type:             exitcode-stdio-1.0-  main-is:          Main.hs-  other-modules:    Paths_hw_xml-  build-depends:    hw-xml-  autogen-modules:  Paths_hw_xml-  hs-source-dirs:   bench-  ghc-options:      -O2 -Wall -msse4.2-+  import:             base, config+                    , bytestring+                    , criterion+                    , hw-balancedparens+                    , hw-bits+                    , hw-prim+                    , mmap+                    , resourcet+                    , vector+  type:               exitcode-stdio-1.0+  main-is:            Main.hs+  other-modules:      Paths_hw_xml+  build-depends:      hw-xml+  autogen-modules:    Paths_hw_xml+  hs-source-dirs:     bench+  ghc-options:        -O2 -Wall -msse4.2

@@ -5,12 +5,14 @@   ( blankXml   ) where -import Data.ByteString                     as BS+import Data.ByteString                      (ByteString) import Data.Word import Data.Word8-import HaskellWorks.Data.Xml.Conduit.Words-import Prelude                             as P+import HaskellWorks.Data.Xml.Internal.Words+import Prelude +import qualified Data.ByteString as BS+ type ExpectedChar = Word8  data BlankState@@ -35,66 +37,66 @@ blankXml as = fst (BS.unfoldrN (BS.length as) go (InXml, as))   where go :: (BlankState, ByteString) -> Maybe (Word8, (BlankState, ByteString))         go (InXml, bs) = case BS.uncons bs of-          Just (!c, !cs) | isMetaStart c cs         -> Just (_bracketleft , (InMeta       , cs))-          Just (!c, !cs) | isEndTag c cs            -> Just (_space       , (InCloseTag   , cs))-          Just (!c, !cs) | isTextStart c            -> Just (_t           , (InText       , cs))-          Just (!c, !cs) | c == _less               -> Just (_less        , (InTag        , cs))-          Just (!c, !cs) | isSpace c                -> Just (c            , (InXml        , cs))-          Just ( _, !cs)                            -> Just (_space       , (InXml        , cs))-          Nothing                                   -> Nothing+          Just (!c, !cs) | isMetaStart c cs -> Just (_bracketleft , (InMeta       , cs))+          Just (!c, !cs) | isEndTag c cs    -> Just (_space       , (InCloseTag   , cs))+          Just (!c, !cs) | isTextStart c    -> Just (_t           , (InText       , cs))+          Just (!c, !cs) | c == _less       -> Just (_less        , (InTag        , cs))+          Just (!c, !cs) | isSpace c        -> Just (c            , (InXml        , cs))+          Just ( _, !cs)                    -> Just (_space       , (InXml        , cs))+          Nothing                           -> Nothing         go (InTag, bs) = case BS.uncons bs of-          Just (!c, !cs) | isSpace c                -> Just (_parenleft   , (InAttrList   , cs))-          Just (!c, !cs) | isTagClose c cs          -> Just (_space       , (InClose      , cs))-          Just (!c, !cs) | c == _greater            -> Just (_space       , (InXml        , cs))-          Just (!c, !cs) | isSpace c                -> Just (c            , (InTag        , cs))-          Just ( _, !cs)                            -> Just (_space       , (InTag        , cs))-          Nothing                                   -> Nothing+          Just (!c, !cs) | isSpace c       -> Just (_parenleft   , (InAttrList   , cs))+          Just (!c, !cs) | isTagClose c cs -> Just (_space       , (InClose      , cs))+          Just (!c, !cs) | c == _greater   -> Just (_space       , (InXml        , cs))+          Just (!c, !cs) | isSpace c       -> Just (c            , (InTag        , cs))+          Just ( _, !cs)                   -> Just (_space       , (InTag        , cs))+          Nothing                          -> Nothing         go (InCloseTag, bs) = case BS.uncons bs of-          Just (!c, !cs) | c == _greater            -> Just (_greater     , (InXml        , cs))-          Just ( _, !cs)                            -> Just (_space       , (InCloseTag   , cs))-          Nothing                                   -> Nothing+          Just (!c, !cs) | c == _greater -> Just (_greater     , (InXml        , cs))+          Just ( _, !cs)                 -> Just (_space       , (InCloseTag   , cs))+          Nothing                        -> Nothing         go (InAttrList, bs) = case BS.uncons bs of-          Just (!c, !cs) | c == _greater            -> Just (_parenright  , (InXml        , cs))-          Just (!c, !cs) | isTagClose c cs          -> Just (_parenright  , (InClose      , cs))-          Just (!c, !cs) | isNameStartChar c        -> Just (_a           , (InIdent      , cs))-          Just (!c, !cs) | isQuote c                -> Just (_v           , (InString c   , cs))-          Just (!c, !cs) | isSpace c                -> Just (c            , (InAttrList   , cs))-          Just ( _, !cs)                            -> Just (_space       , (InAttrList   , cs))-          Nothing                                   -> Nothing+          Just (!c, !cs) | c == _greater     -> Just (_parenright  , (InXml        , cs))+          Just (!c, !cs) | isTagClose c cs   -> Just (_parenright  , (InClose      , cs))+          Just (!c, !cs) | isNameStartChar c -> Just (_a           , (InIdent      , cs))+          Just (!c, !cs) | isQuote c         -> Just (_v           , (InString c   , cs))+          Just (!c, !cs) | isSpace c         -> Just (c            , (InAttrList   , cs))+          Just ( _, !cs)                     -> Just (_space       , (InAttrList   , cs))+          Nothing                            -> Nothing         go (InClose, bs) = case BS.uncons bs of-          Just (_, !cs)                             -> Just (_greater     , (InXml        , cs))-          Nothing                                   -> Nothing+          Just (_, !cs) -> Just (_greater     , (InXml        , cs))+          Nothing       -> Nothing         go (InIdent, bs) = case BS.uncons bs of-          Just (!c, !cs) | isNameChar c             -> Just (_space       , (InIdent      , cs))-          Just (!c, !cs) | isSpace c                -> Just (_space       , (InAttrList   , cs))-          Just (!c, !cs) | c == _equal              -> Just (_space       , (InAttrList   , cs))-          Just (!c, !cs) | isSpace c                -> Just (c            , (InAttrList   , cs))-          Just ( _, !cs)                            -> Just (_space       , (InAttrList   , cs))-          Nothing                                   -> Nothing+          Just (!c, !cs) | isNameChar c -> Just (_space       , (InIdent      , cs))+          Just (!c, !cs) | isSpace c    -> Just (_space       , (InAttrList   , cs))+          Just (!c, !cs) | c == _equal  -> Just (_space       , (InAttrList   , cs))+          Just (!c, !cs) | isSpace c    -> Just (c            , (InAttrList   , cs))+          Just ( _, !cs)                -> Just (_space       , (InAttrList   , cs))+          Nothing                       -> Nothing         go (InString q, bs) = case BS.uncons bs of-          Just (!c, !cs) | c == q                   -> Just (_space       , (InAttrList   , cs))-          Just (!c, !cs) | isSpace c                -> Just (c            , (InString q   , cs))-          Just ( _, !cs)                            -> Just (_space       , (InString q   , cs))-          Nothing                                   -> Nothing+          Just (!c, !cs) | c == q    -> Just (_space       , (InAttrList   , cs))+          Just (!c, !cs) | isSpace c -> Just (c            , (InString q   , cs))+          Just ( _, !cs)             -> Just (_space       , (InString q   , cs))+          Nothing                    -> Nothing         go (InText, bs) = case BS.uncons bs of-          Just (!c, !cs) | isEndTag c cs            -> Just (_space       , (InCloseTag   , cs))-          Just ( _, !cs) | headIs (== _less) cs     -> Just (_space       , (InXml        , cs))-          Just (!c, !cs) | isSpace c                -> Just (c            , (InText       , cs))-          Just ( _, !cs)                            -> Just (_space       , (InText       , cs))-          Nothing                                   -> Nothing+          Just (!c, !cs) | isEndTag c cs        -> Just (_space       , (InCloseTag   , cs))+          Just ( _, !cs) | headIs (== _less) cs -> Just (_space       , (InXml        , cs))+          Just (!c, !cs) | isSpace c            -> Just (c            , (InText       , cs))+          Just ( _, !cs)                        -> Just (_space       , (InText       , cs))+          Nothing                               -> Nothing         go (InMeta, bs) = case BS.uncons bs of-          Just (!c, !cs) | c == _exclam             -> Just (_space       , (InMeta       , cs))-          Just (!c, !cs) | c == _hyphen             -> Just (_space       , (InRem 0      , cs))-          Just (!c, !cs) | c == _bracketleft        -> Just (_space       , (InCdataTag   , cs))-          Just (!c, !cs) | c == _greater            -> Just (_bracketright, (InXml        , cs))-          Just (!c, !cs) | isSpace c                -> Just (c            , (InBang 1     , cs))-          Just ( _, !cs)                            -> Just (_space       , (InBang 1     , cs))-          Nothing                                   -> Nothing+          Just (!c, !cs) | c == _exclam      -> Just (_space       , (InMeta       , cs))+          Just (!c, !cs) | c == _hyphen      -> Just (_space       , (InRem 0      , cs))+          Just (!c, !cs) | c == _bracketleft -> Just (_space       , (InCdataTag   , cs))+          Just (!c, !cs) | c == _greater     -> Just (_bracketright, (InXml        , cs))+          Just (!c, !cs) | isSpace c         -> Just (c            , (InBang 1     , cs))+          Just ( _, !cs)                     -> Just (_space       , (InBang 1     , cs))+          Nothing                            -> Nothing         go (InCdataTag, bs) = case BS.uncons bs of-          Just (!c, !cs) | c == _bracketleft        -> Just (_space       , (InCdata 0    , cs))-          Just (!c, !cs) | isSpace c                -> Just (c            , (InCdataTag   , cs))-          Just ( _, !cs)                            -> Just (_space       , (InCdataTag   , cs))-          Nothing                                   -> Nothing+          Just (!c, !cs) | c == _bracketleft -> Just (_space       , (InCdata 0    , cs))+          Just (!c, !cs) | isSpace c         -> Just (c            , (InCdataTag   , cs))+          Just ( _, !cs)                     -> Just (_space       , (InCdataTag   , cs))+          Nothing                            -> Nothing         go (InCdata n, bs) = case BS.uncons bs of           Just (!c, !cs) | c == _greater && n >= 2  -> Just (_bracketright, (InXml        , cs))           Just (!c, !cs) | isCdataEnd c cs && n > 0 -> Just (_space       , (InCdata (n+1), cs))@@ -103,18 +105,18 @@           Just ( _, !cs)                            -> Just (_space       , (InCdata 0    , cs))           Nothing                                   -> Nothing         go (InRem n, bs) = case BS.uncons bs of-          Just (!c, !cs) | c == _greater && n >= 2  -> Just (_bracketright, (InXml        , cs))-          Just (!c, !cs) | c == _hyphen             -> Just (_space       , (InRem (n+1)  , cs))-          Just (!c, !cs) | isSpace c                -> Just (c            , (InRem 0      , cs))-          Just ( _, !cs)                            -> Just (_space       , (InRem 0      , cs))-          Nothing                                   -> Nothing+          Just (!c, !cs) | c == _greater && n >= 2 -> Just (_bracketright, (InXml        , cs))+          Just (!c, !cs) | c == _hyphen            -> Just (_space       , (InRem (n+1)  , cs))+          Just (!c, !cs) | isSpace c               -> Just (c            , (InRem 0      , cs))+          Just ( _, !cs)                           -> Just (_space       , (InRem 0      , cs))+          Nothing                                  -> Nothing         go (InBang n, bs) = case BS.uncons bs of-          Just (!c, !cs) | c == _less               -> Just (_bracketleft , (InBang (n+1) , cs))-          Just (!c, !cs) | c == _greater && n == 1  -> Just (_bracketright, (InXml        , cs))-          Just (!c, !cs) | c == _greater            -> Just (_bracketright, (InBang (n-1) , cs))-          Just (!c, !cs) | isSpace c                -> Just (c            , (InBang n     , cs))-          Just ( _, !cs)                            -> Just (_space       , (InBang n     , cs))-          Nothing                                   -> Nothing+          Just (!c, !cs) | c == _less              -> Just (_bracketleft , (InBang (n+1) , cs))+          Just (!c, !cs) | c == _greater && n == 1 -> Just (_bracketright, (InXml        , cs))+          Just (!c, !cs) | c == _greater           -> Just (_bracketright, (InBang (n-1) , cs))+          Just (!c, !cs) | isSpace c               -> Just (c            , (InBang n     , cs))+          Just ( _, !cs)                           -> Just (_space       , (InBang n     , cs))+          Nothing                                  -> Nothing  isEndTag :: Word8 -> ByteString -> Bool isEndTag c cs = c == _less && headIs (== _slash) cs

@@ -1,142 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes        #-}--module HaskellWorks.Data.Xml.Conduit-  ( blankedXmlToInterestBits-  , byteStringToBits-  , blankedXmlToBalancedParens2-  , compressWordAsBit-  , interestingWord8s-  , isInterestingWord8-  ) where--import Data.ByteString                as BS-import Data.Word-import Data.Word8-import HaskellWorks.Data.AtIndex      ((!!!))-import HaskellWorks.Data.Bits.BitWise-import Prelude                        as P--import qualified Data.Bits            as BITS-import qualified Data.Vector.Storable as DVS--interestingWord8s :: DVS.Vector Word8-interestingWord8s = DVS.constructN 256 go-  where go :: DVS.Vector Word8 -> Word8-        go v = if     w == _bracketleft-                  ||  w == _braceleft-                  ||  w == _parenleft-                  ||  w == _bracketleft-                  ||  w == _less-                  ||  w == _a-                  ||  w == _v-                  ||  w == _t-              then 1-              else 0-          where w :: Word8-                w = fromIntegral (DVS.length v)-{-# NOINLINE interestingWord8s #-}--isInterestingWord8 :: Word8 -> Word8-isInterestingWord8 b = fromIntegral (interestingWord8s !!! fromIntegral b)-{-# INLINABLE isInterestingWord8 #-}--blankedXmlToInterestBits :: [BS.ByteString] -> [BS.ByteString]-blankedXmlToInterestBits = blankedXmlToInterestBits' ""--blankedXmlToInterestBits' :: BS.ByteString -> [BS.ByteString] -> [BS.ByteString]-blankedXmlToInterestBits' rs is = case is of-  (bs:bss) -> do-    let cs = if BS.length rs /= 0 then BS.concat [rs, bs] else bs-    let lencs = BS.length cs-    let q = lencs `quot` 8-    let (ds, es) = BS.splitAt (q * 8) cs-    let (fs, _) = BS.unfoldrN q gen ds-    fs:blankedXmlToInterestBits' es bss-  [] -> do-    let lenrs = BS.length rs-    let q = lenrs + 7 `quot` 8-    [fst (BS.unfoldrN q gen rs)]-  where gen :: ByteString -> Maybe (Word8, ByteString)-        gen as = if BS.length as == 0-          then Nothing-          else Just ( BS.foldr' (\b m -> isInterestingWord8 b .|. (m .<. 1)) 0 (BS.take 8 as)-                    , BS.drop 8 as-                    )--repartitionMod8 :: BS.ByteString -> BS.ByteString -> (BS.ByteString, BS.ByteString)-repartitionMod8 aBS bBS = (BS.take cLen abBS, BS.drop cLen abBS)-  where abBS = BS.concat [aBS, bBS]-        abLen = BS.length abBS-        cLen = (abLen `div` 8) * 8--compressWordAsBit :: [BS.ByteString] -> [BS.ByteString]-compressWordAsBit = compressWordAsBit' BS.empty--compressWordAsBit' :: BS.ByteString -> [BS.ByteString] -> [BS.ByteString]-compressWordAsBit' aBS iBS = case iBS of-  (bBS:bBSs) -> do-    let (cBS, dBS) = repartitionMod8 aBS bBS-    let (cs, _) = BS.unfoldrN (BS.length cBS + 7 `div` 8) gen cBS-    cs:compressWordAsBit' dBS bBSs-  [] -> do-    let (cs, _) = BS.unfoldrN (BS.length aBS + 7 `div` 8) gen aBS-    [cs]-  where gen :: ByteString -> Maybe (Word8, ByteString)-        gen xs = if BS.length xs == 0-          then Nothing-          else Just ( BS.foldr' (\b m -> ((b .&. 1) .|. (m .<. 1))) 0 (BS.take 8 xs)-                    , BS.drop 8 xs-                    )--blankedXmlToBalancedParens2 :: [BS.ByteString] -> [BS.ByteString]-blankedXmlToBalancedParens2 is = case is of-  (bs:bss) -> do-    let (cs, _) = BS.unfoldrN (BS.length bs * 2) gen (Nothing, bs)-    cs:blankedXmlToBalancedParens2 bss-  [] -> []-  where gen :: (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString))-        gen (Just True  , bs) = Just (0xFF, (Nothing, bs))-        gen (Just False , bs) = Just (0x00, (Nothing, bs))-        gen (Nothing    , bs) = case BS.uncons bs of-          Just (c, cs) -> case balancedParensOf c of-            MiniN  -> gen         (Nothing    , cs)-            MiniT  -> Just (0xFF, (Nothing    , cs))-            MiniF  -> Just (0x00, (Nothing    , cs))-            MiniTF -> Just (0xFF, (Just False , cs))-          Nothing   -> Nothing--data MiniBP = MiniN | MiniT | MiniF | MiniTF--balancedParensOf :: Word8 -> MiniBP-balancedParensOf c = case c of-    d | d == _less         -> MiniT-    d | d == _greater      -> MiniF-    d | d == _bracketleft  -> MiniT-    d | d == _bracketright -> MiniF-    d | d == _parenleft    -> MiniT-    d | d == _parenright   -> MiniF-    d | d == _t            -> MiniTF-    d | d == _a            -> MiniTF-    d | d == _v            -> MiniTF-    _                      -> MiniN--yieldBitsOfWord8 :: Word8 -> [Bool]-yieldBitsOfWord8 w =-  [ (w .&. BITS.bit 0) /= 0-  , (w .&. BITS.bit 1) /= 0-  , (w .&. BITS.bit 2) /= 0-  , (w .&. BITS.bit 3) /= 0-  , (w .&. BITS.bit 4) /= 0-  , (w .&. BITS.bit 5) /= 0-  , (w .&. BITS.bit 6) /= 0-  , (w .&. BITS.bit 7) /= 0-  ]--yieldBitsofWord8s :: [Word8] -> [Bool]-yieldBitsofWord8s = P.foldr ((++) . yieldBitsOfWord8) []--byteStringToBits :: [BS.ByteString] -> [Bool]-byteStringToBits is = case is of-  (bs:bss) -> yieldBitsofWord8s (BS.unpack bs) ++ byteStringToBits bss-  []       -> []

@@ -1,151 +0,0 @@-{-# OPTIONS_GHC-funbox-strict-fields #-}-{-# LANGUAGE BangPatterns      #-}-{-# LANGUAGE OverloadedStrings #-}--module HaskellWorks.Data.Xml.Conduit.Blank-  ( blankXml-  , BlankData(..)-  ) where--import Data.ByteString                     as BS-import Data.Monoid                         ((<>))-import Data.Word-import Data.Word8-import HaskellWorks.Data.Xml.Conduit.Words-import Prelude                             as P--type ExpectedChar      = Word8--data BlankState-  = InXml-  | InTag-  | InAttrList-  | InCloseTag-  | InClose-  | InBang !Int-  | InString !ExpectedChar-  | InText-  | InMeta-  | InCdataTag-  | InCdata !Int-  | InRem !Int-  | InIdent--data BlankData = BlankData-  { blankState :: !BlankState-  , blankA     :: !Word8-  , blankB     :: !Word8-  , blankC     :: !ByteString-  }--blankXml :: [BS.ByteString] -> [BS.ByteString]-blankXml = blankXmlPlan1 BS.empty InXml--blankXmlPlan1 :: BS.ByteString -> BlankState -> [BS.ByteString] -> [BS.ByteString]-blankXmlPlan1 as lastState is = case is of-  (bs:bss) -> do-    let cs = as <> bs-    case BS.uncons cs of-      Just (d, ds) -> case BS.uncons ds of-        Just (e, es) -> blankXmlRun False d e es lastState bss-        Nothing      -> blankXmlPlan1 cs lastState bss-      Nothing -> blankXmlPlan1 cs lastState bss-  [] -> [BS.map (const _space) as]--blankXmlPlan2 :: Word8 -> Word8 -> BlankState -> [BS.ByteString] -> [BS.ByteString]-blankXmlPlan2 a b lastState is = case is of-  (cs:css) -> blankXmlRun False a b cs lastState css-  []       -> blankXmlRun True a b (BS.pack [_space, _space]) lastState []--blankXmlRun :: Bool -> Word8 -> Word8 -> BS.ByteString -> BlankState -> [BS.ByteString] -> [BS.ByteString]-blankXmlRun done a b cs lastState is = do-  let (!ds, Just (BlankData !nextState _ _ _)) = unfoldrN (BS.length cs) blankByteString (BlankData lastState a b cs)-  let (yy, zz) = case BS.unsnoc cs of-        Just (ys, z) -> case BS.unsnoc ys of-          Just (_, y) -> (y, z)-          Nothing     -> (b, z)-        Nothing -> (a, b)-  if done-    then [ds]-    else ds:blankXmlPlan2 yy zz nextState is--mkNext :: Word8 -> BlankState -> Word8 -> BS.ByteString -> Maybe (Word8, BlankData)-mkNext w s a bs = case BS.uncons bs of-  Just (b, cs) -> Just (w, BlankData s a b cs)-  Nothing      -> error "This should never happen"-{-# INLINE mkNext #-}--blankByteString :: BlankData -> Maybe (Word8, BlankData)-blankByteString (BlankData  InXml        a b cs) | isMetaStart a b         = mkNext _bracketleft   InMeta          b cs-blankByteString (BlankData  InXml        a b cs) | isEndTag    a b         = mkNext _space         InCloseTag      b cs-blankByteString (BlankData  InXml        a b cs) | isTextStart a           = mkNext _t             InText          b cs-blankByteString (BlankData  InXml        a b cs) | a == _less              = mkNext _less          InTag           b cs-blankByteString (BlankData  InXml        a b cs) | isSpace a               = mkNext a              InXml           b cs-blankByteString (BlankData  InXml        _ b cs) = mkNext _space         InXml           b cs-blankByteString (BlankData  InTag        a b cs) | isSpace a               = mkNext _parenleft     InAttrList      b cs-blankByteString (BlankData  InTag        a b cs) | isTagClose a b          = mkNext _space         InClose         b cs-blankByteString (BlankData  InTag        a b cs) | a == _greater           = mkNext _space         InXml           b cs-blankByteString (BlankData  InTag        a b cs) | isSpace a               = mkNext a              InTag           b cs-blankByteString (BlankData  InTag        _ b cs) = mkNext _space         InTag           b cs-blankByteString (BlankData  InCloseTag   a b cs) | a == _greater           = mkNext _greater       InXml           b cs-blankByteString (BlankData  InCloseTag   a b cs) | isSpace a               = mkNext a              InCloseTag      b cs-blankByteString (BlankData  InCloseTag   _ b cs) = mkNext _space         InCloseTag      b cs-blankByteString (BlankData  InAttrList   a b cs) | a == _greater           = mkNext _parenright    InXml           b cs-blankByteString (BlankData  InAttrList   a b cs) | isTagClose a b          = mkNext _parenright    InClose         b cs-blankByteString (BlankData  InAttrList   a b cs) | isNameStartChar a       = mkNext _a             InIdent         b cs-blankByteString (BlankData  InAttrList   a b cs) | isQuote a               = mkNext _v             (InString a)    b cs-blankByteString (BlankData  InAttrList   a b cs) | isSpace a               = mkNext a              InAttrList      b cs-blankByteString (BlankData  InAttrList   _ b cs) = mkNext _space         InAttrList      b cs-blankByteString (BlankData  InClose      _ b cs) = mkNext _greater       InXml           b cs-blankByteString (BlankData  InIdent      a b cs) | isNameChar a            = mkNext _space         InIdent         b cs-blankByteString (BlankData  InIdent      a b cs) | isSpace a               = mkNext _space         InAttrList      b cs-blankByteString (BlankData  InIdent      a b cs) | a == _equal             = mkNext _space         InAttrList      b cs-blankByteString (BlankData  InIdent      a b cs) | isSpace a               = mkNext a              InAttrList      b cs-blankByteString (BlankData  InIdent      _ b cs) = mkNext _space         InAttrList      b cs-blankByteString (BlankData (InString q ) a b cs) | a == q                  = mkNext _space         InAttrList      b cs-blankByteString (BlankData (InString q ) a b cs) | isSpace a               = mkNext a              (InString q)    b cs-blankByteString (BlankData (InString q ) _ b cs) = mkNext _space         (InString q)    b cs-blankByteString (BlankData  InText       a b cs) | isEndTag a b            = mkNext _space         InCloseTag      b cs-blankByteString (BlankData  InText       _ b cs) | b == _less              = mkNext _space         InXml           b cs-blankByteString (BlankData  InText       a b cs) | isSpace a               = mkNext a              InText          b cs-blankByteString (BlankData  InText       _ b cs) = mkNext _space         InText          b cs-blankByteString (BlankData  InMeta       a b cs) | a == _exclam            = mkNext _space         InMeta          b cs-blankByteString (BlankData  InMeta       a b cs) | a == _hyphen            = mkNext _space         (InRem 0)       b cs-blankByteString (BlankData  InMeta       a b cs) | a == _bracketleft       = mkNext _space         InCdataTag      b cs-blankByteString (BlankData  InMeta       a b cs) | a == _greater           = mkNext _bracketright  InXml           b cs-blankByteString (BlankData  InMeta       a b cs) | isSpace a               = mkNext a              (InBang 1)      b cs-blankByteString (BlankData  InMeta       _ b cs) = mkNext _space         (InBang 1)      b cs-blankByteString (BlankData  InCdataTag   a b cs) | a == _bracketleft       = mkNext _space         (InCdata 0)     b cs-blankByteString (BlankData  InCdataTag   a b cs) | isSpace a               = mkNext a              InCdataTag      b cs-blankByteString (BlankData  InCdataTag   _ b cs) = mkNext _space         InCdataTag      b cs-blankByteString (BlankData (InCdata n  ) a b cs) | a == _greater && n >= 2 = mkNext _bracketright  InXml           b cs-blankByteString (BlankData (InCdata n  ) a b cs) | isCdataEnd a b && n > 0 = mkNext _space         (InCdata (n+1)) b cs-blankByteString (BlankData (InCdata n  ) a b cs) | a == _bracketright      = mkNext _space         (InCdata (n+1)) b cs-blankByteString (BlankData (InCdata _  ) a b cs) | isSpace a               = mkNext a              (InCdata 0)     b cs-blankByteString (BlankData (InCdata _  ) _ b cs) = mkNext _space         (InCdata 0)     b cs-blankByteString (BlankData (InRem n    ) a b cs) | a == _greater && n >= 2 = mkNext _bracketright  InXml           b cs-blankByteString (BlankData (InRem n    ) a b cs) | a == _hyphen            = mkNext _space         (InRem (n+1))   b cs-blankByteString (BlankData (InRem _    ) a b cs) | isSpace a               = mkNext a              (InRem 0)       b cs-blankByteString (BlankData (InRem _    ) _ b cs) = mkNext _space         (InRem 0)       b cs-blankByteString (BlankData (InBang n   ) a b cs) | a == _less              = mkNext _bracketleft   (InBang (n+1))  b cs-blankByteString (BlankData (InBang n   ) a b cs) | a == _greater && n == 1 = mkNext _bracketright  InXml           b cs-blankByteString (BlankData (InBang n   ) a b cs) | a == _greater           = mkNext _bracketright  (InBang (n-1))  b cs-blankByteString (BlankData (InBang n   ) a b cs) | isSpace a               = mkNext a              (InBang n)      b cs-blankByteString (BlankData (InBang n   ) _ b cs) = mkNext _space         (InBang n)      b cs-{-# INLINE blankByteString #-}--isEndTag :: Word8 -> Word8 -> Bool-isEndTag a b = a == _less && b == _slash-{-# INLINE isEndTag #-}--isTagClose :: Word8 -> Word8 -> Bool-isTagClose a b = a == _slash || ((a == _slash || a == _question) && b == _greater)-{-# INLINE isTagClose #-}--isMetaStart :: Word8 -> Word8 -> Bool-isMetaStart a b = a == _less && b == _exclam-{-# INLINE isMetaStart #-}--isCdataEnd :: Word8 -> Word8 -> Bool-isCdataEnd a b = a == _bracketright && b == _greater-{-# INLINE isCdataEnd #-}

@@ -1,36 +0,0 @@-module HaskellWorks.Data.Xml.Conduit.Words where--import Data.Word-import Data.Word8--isLeadingDigit :: Word8 -> Bool-isLeadingDigit w = w == _hyphen || (w >= _0 && w <= _9)--isTrailingDigit :: Word8 -> Bool-isTrailingDigit w = w == _plus || w == _hyphen || (w >= _0 && w <= _9) || w == _period || w == _E || w == _e--isAlphabetic :: Word8 -> Bool-isAlphabetic w = (w >= _A && w <= _Z) || (w >= _a && w <= _z)--isQuote :: Word8 -> Bool-isQuote w = w == _quotedbl || w == _quotesingle--isNameStartChar :: Word8 -> Bool-isNameStartChar w = w == _underscore || w == _colon || isAlphabetic w-                 || w `isIn` (0xc0, 0xd6)-                 || w `isIn` (0xd8, 0xf6)-                 || w `isIn` (0xf8, 0xff)--isNameChar :: Word8 -> Bool-isNameChar w = isNameStartChar w || w == _hyphen || w == _period-            || w == 0xb7 || w `isIn` (0, 9)--isXml :: Word8 -> Bool-isXml w = w == _less || w == _greater--isTextStart :: Word8 -> Bool-isTextStart w = not (isSpace w) && w /= _less && w /= _greater--isIn :: Word8 -> (Word8, Word8) -> Bool-isIn w (s, e) = w >= s && w <= e-{-# INLINE isIn #-}

@@ -4,7 +4,7 @@ import Control.Lens import Control.Monad import Data.Foldable-import Data.Monoid                        ((<>))+import Data.Semigroup                     ((<>)) import HaskellWorks.Data.Xml.DecodeError import HaskellWorks.Data.Xml.DecodeResult import HaskellWorks.Data.Xml.Value

@@ -22,7 +22,7 @@   | XmlElementTypeCData   | XmlElementTypeMeta String -parseXmlString :: (P.Parser t Word8, IsString t) => T.Parser t String+parseXmlString :: (P.Parser t Word8) => T.Parser t String parseXmlString = do   q <- satisfyChar (=='"') <|> satisfyChar (=='\'')   many (satisfyChar (/= q))@@ -36,10 +36,10 @@   doc     = const XmlElementTypeDocument <$> string "?xml"   element = XmlElementTypeElement        <$> parseXmlToken -parseXmlToken :: (P.Parser t Word8, IsString t) => T.Parser t String+parseXmlToken :: (P.Parser t Word8) => T.Parser t String parseXmlToken = many $ satisfyChar isNameChar <?> "invalid string character" -parseXmlAttributeName :: (P.Parser t Word8, IsString t) => T.Parser t String+parseXmlAttributeName :: (P.Parser t Word8) => T.Parser t String parseXmlAttributeName = parseXmlToken  isNameStartChar :: Char -> Bool

@@ -0,0 +1,42 @@+module HaskellWorks.Data.Xml.Internal.BalancedParens+  ( blankedXmlToBalancedParens+  ) where++import Data.ByteString (ByteString)+import Data.Word+import Data.Word8++import qualified Data.ByteString as BS++data MiniBP = MiniN | MiniT | MiniF | MiniTF++blankedXmlToBalancedParens :: [ByteString] -> [ByteString]+blankedXmlToBalancedParens is = case is of+  (bs:bss) -> do+    let (cs, _) = BS.unfoldrN (BS.length bs * 2) gen (Nothing, bs)+    cs:blankedXmlToBalancedParens bss+  [] -> []+  where gen :: (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString))+        gen (Just True  , bs) = Just (0xFF, (Nothing, bs))+        gen (Just False , bs) = Just (0x00, (Nothing, bs))+        gen (Nothing    , bs) = case BS.uncons bs of+          Just (c, cs) -> case balancedParensOf c of+            MiniN  -> gen         (Nothing    , cs)+            MiniT  -> Just (0xFF, (Nothing    , cs))+            MiniF  -> Just (0x00, (Nothing    , cs))+            MiniTF -> Just (0xFF, (Just False , cs))+          Nothing   -> Nothing++balancedParensOf :: Word8 -> MiniBP+balancedParensOf c = case c of+    d | d == _less         -> MiniT+    d | d == _greater      -> MiniF+    d | d == _bracketleft  -> MiniT+    d | d == _bracketright -> MiniF+    d | d == _parenleft    -> MiniT+    d | d == _parenright   -> MiniF+    d | d == _t            -> MiniTF+    d | d == _a            -> MiniTF+    d | d == _v            -> MiniTF+    _                      -> MiniN+

@@ -0,0 +1,153 @@+{-# OPTIONS_GHC-funbox-strict-fields #-}+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Xml.Internal.Blank+  ( blankXml+  , BlankData(..)+  ) where++import Data.ByteString                      (ByteString)+import Data.Semigroup                       ((<>))+import Data.Word+import Data.Word8+import HaskellWorks.Data.Xml.Internal.Words+import Prelude++import qualified Data.ByteString as BS++type ExpectedChar      = Word8++data BlankState+  = InXml+  | InTag+  | InAttrList+  | InCloseTag+  | InClose+  | InBang !Int+  | InString !ExpectedChar+  | InText+  | InMeta+  | InCdataTag+  | InCdata !Int+  | InRem !Int+  | InIdent++data BlankData = BlankData+  { blankState :: !BlankState+  , blankA     :: !Word8+  , blankB     :: !Word8+  , blankC     :: !ByteString+  }++blankXml :: [ByteString] -> [ByteString]+blankXml = blankXmlPlan1 BS.empty InXml++blankXmlPlan1 :: ByteString -> BlankState -> [ByteString] -> [ByteString]+blankXmlPlan1 as lastState is = case is of+  (bs:bss) -> do+    let cs = as <> bs+    case BS.uncons cs of+      Just (d, ds) -> case BS.uncons ds of+        Just (e, es) -> blankXmlRun False d e es lastState bss+        Nothing      -> blankXmlPlan1 cs lastState bss+      Nothing -> blankXmlPlan1 cs lastState bss+  [] -> [BS.map (const _space) as]++blankXmlPlan2 :: Word8 -> Word8 -> BlankState -> [ByteString] -> [ByteString]+blankXmlPlan2 a b lastState is = case is of+  (cs:css) -> blankXmlRun False a b cs lastState css+  []       -> blankXmlRun True a b (BS.pack [_space, _space]) lastState []++blankXmlRun :: Bool -> Word8 -> Word8 -> ByteString -> BlankState -> [ByteString] -> [ByteString]+blankXmlRun done a b cs lastState is = do+  let (!ds, Just (BlankData !nextState _ _ _)) = BS.unfoldrN (BS.length cs) blankByteString (BlankData lastState a b cs)+  let (yy, zz) = case BS.unsnoc cs of+        Just (ys, z) -> case BS.unsnoc ys of+          Just (_, y) -> (y, z)+          Nothing     -> (b, z)+        Nothing -> (a, b)+  if done+    then [ds]+    else ds:blankXmlPlan2 yy zz nextState is++mkNext :: Word8 -> BlankState -> Word8 -> ByteString -> Maybe (Word8, BlankData)+mkNext w s a bs = case BS.uncons bs of+  Just (b, cs) -> Just (w, BlankData s a b cs)+  Nothing      -> error "This should never happen"+{-# INLINE mkNext #-}++blankByteString :: BlankData -> Maybe (Word8, BlankData)+blankByteString (BlankData  InXml        a b cs) | isMetaStart a b         = mkNext _bracketleft   InMeta          b cs+blankByteString (BlankData  InXml        a b cs) | isEndTag    a b         = mkNext _space         InCloseTag      b cs+blankByteString (BlankData  InXml        a b cs) | isTextStart a           = mkNext _t             InText          b cs+blankByteString (BlankData  InXml        a b cs) | a == _less              = mkNext _less          InTag           b cs+blankByteString (BlankData  InXml        a b cs) | isSpace a               = mkNext a              InXml           b cs+blankByteString (BlankData  InXml        _ b cs) = mkNext _space         InXml           b cs+blankByteString (BlankData  InTag        a b cs) | isSpace a               = mkNext _parenleft     InAttrList      b cs+blankByteString (BlankData  InTag        a b cs) | isTagClose a b          = mkNext _space         InClose         b cs+blankByteString (BlankData  InTag        a b cs) | a == _greater           = mkNext _space         InXml           b cs+blankByteString (BlankData  InTag        a b cs) | isSpace a               = mkNext a              InTag           b cs+blankByteString (BlankData  InTag        _ b cs) = mkNext _space         InTag           b cs+blankByteString (BlankData  InCloseTag   a b cs) | a == _greater           = mkNext _greater       InXml           b cs+blankByteString (BlankData  InCloseTag   a b cs) | isSpace a               = mkNext a              InCloseTag      b cs+blankByteString (BlankData  InCloseTag   _ b cs) = mkNext _space         InCloseTag      b cs+blankByteString (BlankData  InAttrList   a b cs) | a == _greater           = mkNext _parenright    InXml           b cs+blankByteString (BlankData  InAttrList   a b cs) | isTagClose a b          = mkNext _parenright    InClose         b cs+blankByteString (BlankData  InAttrList   a b cs) | isNameStartChar a       = mkNext _a             InIdent         b cs+blankByteString (BlankData  InAttrList   a b cs) | isQuote a               = mkNext _v             (InString a)    b cs+blankByteString (BlankData  InAttrList   a b cs) | isSpace a               = mkNext a              InAttrList      b cs+blankByteString (BlankData  InAttrList   _ b cs) = mkNext _space         InAttrList      b cs+blankByteString (BlankData  InClose      _ b cs) = mkNext _greater       InXml           b cs+blankByteString (BlankData  InIdent      a b cs) | isNameChar a            = mkNext _space         InIdent         b cs+blankByteString (BlankData  InIdent      a b cs) | isSpace a               = mkNext _space         InAttrList      b cs+blankByteString (BlankData  InIdent      a b cs) | a == _equal             = mkNext _space         InAttrList      b cs+blankByteString (BlankData  InIdent      a b cs) | isSpace a               = mkNext a              InAttrList      b cs+blankByteString (BlankData  InIdent      _ b cs) = mkNext _space         InAttrList      b cs+blankByteString (BlankData (InString q ) a b cs) | a == q                  = mkNext _space         InAttrList      b cs+blankByteString (BlankData (InString q ) a b cs) | isSpace a               = mkNext a              (InString q)    b cs+blankByteString (BlankData (InString q ) _ b cs) = mkNext _space         (InString q)    b cs+blankByteString (BlankData  InText       a b cs) | isEndTag a b            = mkNext _space         InCloseTag      b cs+blankByteString (BlankData  InText       _ b cs) | b == _less              = mkNext _space         InXml           b cs+blankByteString (BlankData  InText       a b cs) | isSpace a               = mkNext a              InText          b cs+blankByteString (BlankData  InText       _ b cs) = mkNext _space         InText          b cs+blankByteString (BlankData  InMeta       a b cs) | a == _exclam            = mkNext _space         InMeta          b cs+blankByteString (BlankData  InMeta       a b cs) | a == _hyphen            = mkNext _space         (InRem 0)       b cs+blankByteString (BlankData  InMeta       a b cs) | a == _bracketleft       = mkNext _space         InCdataTag      b cs+blankByteString (BlankData  InMeta       a b cs) | a == _greater           = mkNext _bracketright  InXml           b cs+blankByteString (BlankData  InMeta       a b cs) | isSpace a               = mkNext a              (InBang 1)      b cs+blankByteString (BlankData  InMeta       _ b cs) = mkNext _space         (InBang 1)      b cs+blankByteString (BlankData  InCdataTag   a b cs) | a == _bracketleft       = mkNext _space         (InCdata 0)     b cs+blankByteString (BlankData  InCdataTag   a b cs) | isSpace a               = mkNext a              InCdataTag      b cs+blankByteString (BlankData  InCdataTag   _ b cs) = mkNext _space         InCdataTag      b cs+blankByteString (BlankData (InCdata n  ) a b cs) | a == _greater && n >= 2 = mkNext _bracketright  InXml           b cs+blankByteString (BlankData (InCdata n  ) a b cs) | isCdataEnd a b && n > 0 = mkNext _space         (InCdata (n+1)) b cs+blankByteString (BlankData (InCdata n  ) a b cs) | a == _bracketright      = mkNext _space         (InCdata (n+1)) b cs+blankByteString (BlankData (InCdata _  ) a b cs) | isSpace a               = mkNext a              (InCdata 0)     b cs+blankByteString (BlankData (InCdata _  ) _ b cs) = mkNext _space         (InCdata 0)     b cs+blankByteString (BlankData (InRem n    ) a b cs) | a == _greater && n >= 2 = mkNext _bracketright  InXml           b cs+blankByteString (BlankData (InRem n    ) a b cs) | a == _hyphen            = mkNext _space         (InRem (n+1))   b cs+blankByteString (BlankData (InRem _    ) a b cs) | isSpace a               = mkNext a              (InRem 0)       b cs+blankByteString (BlankData (InRem _    ) _ b cs) = mkNext _space         (InRem 0)       b cs+blankByteString (BlankData (InBang n   ) a b cs) | a == _less              = mkNext _bracketleft   (InBang (n+1))  b cs+blankByteString (BlankData (InBang n   ) a b cs) | a == _greater && n == 1 = mkNext _bracketright  InXml           b cs+blankByteString (BlankData (InBang n   ) a b cs) | a == _greater           = mkNext _bracketright  (InBang (n-1))  b cs+blankByteString (BlankData (InBang n   ) a b cs) | isSpace a               = mkNext a              (InBang n)      b cs+blankByteString (BlankData (InBang n   ) _ b cs) = mkNext _space         (InBang n)      b cs+{-# INLINE blankByteString #-}++isEndTag :: Word8 -> Word8 -> Bool+isEndTag a b = a == _less && b == _slash+{-# INLINE isEndTag #-}++isTagClose :: Word8 -> Word8 -> Bool+isTagClose a b = a == _slash || ((a == _slash || a == _question) && b == _greater)+{-# INLINE isTagClose #-}++isMetaStart :: Word8 -> Word8 -> Bool+isMetaStart a b = a == _less && b == _exclam+{-# INLINE isMetaStart #-}++isCdataEnd :: Word8 -> Word8 -> Bool+isCdataEnd a b = a == _bracketright && b == _greater+{-# INLINE isCdataEnd #-}

@@ -0,0 +1,14 @@+module HaskellWorks.Data.Xml.Internal.ByteString+  ( repartitionMod8+  ) where++import Data.ByteString (ByteString)++import qualified Data.ByteString as BS++repartitionMod8 :: ByteString -> ByteString -> (ByteString, ByteString)+repartitionMod8 aBS bBS = (BS.take cLen abBS, BS.drop cLen abBS)+  where abBS = BS.concat [aBS, bBS]+        abLen = BS.length abBS+        cLen = (abLen `div` 8) * 8+{-# INLINE repartitionMod8 #-}

@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}++module HaskellWorks.Data.Xml.Internal.List+  ( blankedXmlToInterestBits+  , compressWordAsBit+  ) where++import Data.ByteString                           (ByteString)+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Xml.Internal.ByteString+import HaskellWorks.Data.Xml.Internal.Tables+import Prelude++import qualified Data.ByteString as BS++blankedXmlToInterestBits :: [ByteString] -> [ByteString]+blankedXmlToInterestBits = blankedXmlToInterestBits' ""++blankedXmlToInterestBits' :: ByteString -> [ByteString] -> [ByteString]+blankedXmlToInterestBits' rs is = case is of+  (bs:bss) -> do+    let cs = if BS.length rs /= 0 then BS.concat [rs, bs] else bs+    let lencs = BS.length cs+    let q = lencs `quot` 8+    let (ds, es) = BS.splitAt (q * 8) cs+    let (fs, _) = BS.unfoldrN q gen ds+    fs:blankedXmlToInterestBits' es bss+  [] -> do+    let lenrs = BS.length rs+    let q = lenrs + 7 `quot` 8+    [fst (BS.unfoldrN q gen rs)]+  where gen :: ByteString -> Maybe (Word8, ByteString)+        gen as = if BS.length as == 0+          then Nothing+          else Just ( BS.foldr' (\b m -> isInterestingWord8 b .|. (m .<. 1)) 0 (BS.take 8 as)+                    , BS.drop 8 as+                    )++compressWordAsBit :: [ByteString] -> [ByteString]+compressWordAsBit = compressWordAsBit' BS.empty++compressWordAsBit' :: ByteString -> [ByteString] -> [ByteString]+compressWordAsBit' aBS iBS = case iBS of+  (bBS:bBSs) -> do+    let (cBS, dBS) = repartitionMod8 aBS bBS+    let (cs, _) = BS.unfoldrN (BS.length cBS + 7 `div` 8) gen cBS+    cs:compressWordAsBit' dBS bBSs+  [] -> do+    let (cs, _) = BS.unfoldrN (BS.length aBS + 7 `div` 8) gen aBS+    [cs]+  where gen :: ByteString -> Maybe (Word8, ByteString)+        gen xs = if BS.length xs == 0+          then Nothing+          else Just ( BS.foldr' (\b m -> ((b .&. 1) .|. (m .<. 1))) 0 (BS.take 8 xs)+                    , BS.drop 8 xs+                    )

@@ -0,0 +1,32 @@+module HaskellWorks.Data.Xml.Internal.Tables+  ( interestingWord8s+  , isInterestingWord8+  ) where++import Data.Word+import Data.Word8+import HaskellWorks.Data.AtIndex ((!!!))+import Prelude                   as P++import qualified Data.Vector.Storable as DVS++interestingWord8s :: DVS.Vector Word8+interestingWord8s = DVS.constructN 256 go+  where go :: DVS.Vector Word8 -> Word8+        go v = if     w == _bracketleft+                  ||  w == _braceleft+                  ||  w == _parenleft+                  ||  w == _bracketleft+                  ||  w == _less+                  ||  w == _a+                  ||  w == _v+                  ||  w == _t+              then 1+              else 0+          where w :: Word8+                w = fromIntegral (DVS.length v)+{-# NOINLINE interestingWord8s #-}++isInterestingWord8 :: Word8 -> Word8+isInterestingWord8 b = fromIntegral (interestingWord8s !!! fromIntegral b)+{-# INLINABLE isInterestingWord8 #-}

@@ -6,39 +6,19 @@ module HaskellWorks.Data.Xml.Internal.ToIbBp64   ( toBalancedParens64   , toInterestBits64-  , toBalancedParens64'-  , toInterestBits64'   , toIbBp64   ) where -import Control.Applicative-import Data.Word-import HaskellWorks.Data.Xml.Conduit-import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml   (BlankedXml (..))-import HaskellWorks.Data.Xml.Succinct.Cursor.InterestBits (blankedXmlToInterestBits, genInterestForever)--import qualified Data.ByteString      as BS-import qualified Data.Vector.Storable as DVS--genBitWordsForever :: BS.ByteString -> Maybe (Word8, BS.ByteString)-genBitWordsForever bs = BS.uncons bs <|> Just (0, bs)-{-# INLINABLE genBitWordsForever #-}--toBalancedParens64 :: BlankedXml -> DVS.Vector Word64-toBalancedParens64 (BlankedXml bj) = DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)-  where interestBS    = BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 bj))-        newLen        = (BS.length interestBS + 7) `div` 8 * 8--toBalancedParens64' :: BlankedXml -> [BS.ByteString]-toBalancedParens64' (BlankedXml bj) = compressWordAsBit (blankedXmlToBalancedParens2 bj)+import Data.ByteString                                  (ByteString)+import HaskellWorks.Data.Xml.Internal.BalancedParens+import HaskellWorks.Data.Xml.Internal.List+import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml (BlankedXml (..)) -toInterestBits64 :: BlankedXml -> DVS.Vector Word64-toInterestBits64 (BlankedXml bj) = DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS)-    where interestBS    = BS.concat (blankedXmlToInterestBits bj)-          newLen        = (BS.length interestBS + 7) `div` 8 * 8+toBalancedParens64 :: BlankedXml -> [ByteString]+toBalancedParens64 (BlankedXml bj) = compressWordAsBit (blankedXmlToBalancedParens bj) -toInterestBits64' :: BlankedXml -> [BS.ByteString]-toInterestBits64' (BlankedXml bj) = blankedXmlToInterestBits bj+toInterestBits64 :: BlankedXml -> [ByteString]+toInterestBits64 (BlankedXml bj) = blankedXmlToInterestBits bj -toIbBp64 :: BlankedXml -> [(BS.ByteString, BS.ByteString)]-toIbBp64 bj = zip (toInterestBits64' bj) (toBalancedParens64' bj)+toIbBp64 :: BlankedXml -> [(ByteString, ByteString)]+toIbBp64 bj = zip (toInterestBits64 bj) (toBalancedParens64 bj)

@@ -0,0 +1,36 @@+module HaskellWorks.Data.Xml.Internal.Words where++import Data.Word+import Data.Word8++isLeadingDigit :: Word8 -> Bool+isLeadingDigit w = w == _hyphen || (w >= _0 && w <= _9)++isTrailingDigit :: Word8 -> Bool+isTrailingDigit w = w == _plus || w == _hyphen || (w >= _0 && w <= _9) || w == _period || w == _E || w == _e++isAlphabetic :: Word8 -> Bool+isAlphabetic w = (w >= _A && w <= _Z) || (w >= _a && w <= _z)++isQuote :: Word8 -> Bool+isQuote w = w == _quotedbl || w == _quotesingle++isNameStartChar :: Word8 -> Bool+isNameStartChar w = w == _underscore || w == _colon || isAlphabetic w+                 || w `isIn` (0xc0, 0xd6)+                 || w `isIn` (0xd8, 0xf6)+                 || w `isIn` (0xf8, 0xff)++isNameChar :: Word8 -> Bool+isNameChar w = isNameStartChar w || w == _hyphen || w == _period+            || w == 0xb7 || w `isIn` (0, 9)++isXml :: Word8 -> Bool+isXml w = w == _less || w == _greater++isTextStart :: Word8 -> Bool+isTextStart w = not (isSpace w) && w /= _less && w /= _greater++isIn :: Word8 -> (Word8, Word8) -> Bool+isIn w (s, e) = w >= s && w <= e+{-# INLINE isIn #-}

@@ -11,7 +11,8 @@ import Control.Applicative import Data.Word import HaskellWorks.Data.BalancedParens                 as BP-import HaskellWorks.Data.Xml.Conduit+import HaskellWorks.Data.Xml.Internal.BalancedParens+import HaskellWorks.Data.Xml.Internal.List import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml  import qualified Data.ByteString      as BS@@ -28,20 +29,20 @@  instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word8))) where   fromBlankedXml bj    = XmlBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))-    where interestBS    = BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 (getBlankedXml bj)))+    where interestBS    = BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml bj)))           newLen        = (BS.length interestBS + 7) `div` 8 * 8  instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word16))) where   fromBlankedXml bj    = XmlBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))-    where interestBS    = BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 (getBlankedXml bj)))+    where interestBS    = BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml bj)))           newLen        = (BS.length interestBS + 7) `div` 8 * 8  instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word32))) where   fromBlankedXml bj    = XmlBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))-    where interestBS    = BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 (getBlankedXml bj)))+    where interestBS    = BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml bj)))           newLen        = (BS.length interestBS + 7) `div` 8 * 8  instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word64))) where   fromBlankedXml bj    = XmlBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))-    where interestBS    = BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 (getBlankedXml bj)))+    where interestBS    = BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml bj)))           newLen        = (BS.length interestBS + 7) `div` 8 * 8

@@ -9,7 +9,7 @@   ) where  import GHC.Generics-import HaskellWorks.Data.Xml.Conduit.Blank+import HaskellWorks.Data.Xml.Internal.Blank  import qualified Data.ByteString              as BS import qualified Data.ByteString.Lazy         as LBS

@@ -17,7 +17,7 @@ import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.FromByteString import HaskellWorks.Data.RankSelect.Poppy512-import HaskellWorks.Data.Xml.Conduit+import HaskellWorks.Data.Xml.Internal.List import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml  import qualified Data.ByteString      as BS

@@ -11,7 +11,6 @@   ) where  import Control.DeepSeq                                    (NFData (..))-import Data.ByteString.Internal                           as BSI import Data.String import Data.Word import Foreign.ForeignPtr@@ -30,6 +29,7 @@  import qualified Data.ByteString                                      as BS import qualified Data.ByteString.Char8                                as BSC+import qualified Data.ByteString.Internal                             as BSI import qualified Data.Vector.Storable                                 as DVS import qualified HaskellWorks.Data.BalancedParens                     as BP import qualified HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParens as CBP

@@ -3,7 +3,7 @@   ( xmlTokenAt   ) where -import Data.ByteString.Internal                       as BSI+import Data.ByteString                                (ByteString) import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Drop import HaskellWorks.Data.Positioning

@@ -19,7 +19,7 @@   ) where  import Control.Lens-import Data.Monoid                     ((<>))+import Data.Semigroup                  ((<>)) import HaskellWorks.Data.Xml.RawDecode import HaskellWorks.Data.Xml.RawValue @@ -66,8 +66,8 @@   rawDecode (RawError     msg       ) = XmlError      msg  mkXmlElement :: String -> [RawValue] -> Value-mkXmlElement n (RawAttrList as:cs)  = XmlElement n (mkAttrs as) (rawDecode <$> cs)-mkXmlElement n cs                   = XmlElement n []           (rawDecode <$> cs)+mkXmlElement n (RawAttrList as:cs) = XmlElement n (mkAttrs as) (rawDecode <$> cs)+mkXmlElement n cs                  = XmlElement n []           (rawDecode <$> cs)  mkAttrs :: [RawValue] -> [(String, String)] mkAttrs (RawAttrName n:RawAttrValue v:cs) = (n, v):mkAttrs cs

@@ -1,121 +0,0 @@-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.Xml.Conduit.BlankSpec (spec) where--import Data.Char-import Data.Semigroup                      ((<>))-import HaskellWorks.Data.ByteString-import HaskellWorks.Data.Xml.Conduit.Blank-import HaskellWorks.Hspec.Hedgehog-import Hedgehog-import Test.Hspec--import qualified Data.ByteString as BS-import qualified Hedgehog.Gen    as G-import qualified Hedgehog.Range  as R--{-# ANN module ("HLint: ignore Redundant do" :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}--whenBlankedXmlShouldBe :: BS.ByteString -> BS.ByteString -> Spec-whenBlankedXmlShouldBe original expected = do-  it (show original <> " when blanked xml should be " <> show expected) $ requireTest $ do-    BS.concat (blankXml [original]) === expected--repeatBS :: Int -> BS.ByteString -> BS.ByteString-repeatBS n bs | n > 0   = bs <> repeatBS (n - 1) bs-repeatBS  _ _ = BS.empty--noSpaces :: BS.ByteString -> BS.ByteString-noSpaces = BS.filter (/= fromIntegral (ord ' '))--data Annotated a b = Annotated a b deriving Show--instance Eq a => Eq (Annotated a b) where-  (Annotated a _) == (Annotated b _) = a == b--spec :: Spec-spec = describe "HaskellWorks.Data.Xml.Conduit.BlankSpec" $ do-  describe "Can blank XML" $ do-    "<b/>"                                    `whenBlankedXmlShouldBe` "<  >"-    "<b></b>"                                 `whenBlankedXmlShouldBe` "<     >"-    "<b>text</b>"                             `whenBlankedXmlShouldBe` "<  t      >"-    "<b>  text  </b>"                         `whenBlankedXmlShouldBe` "<    t        >"-    "<b />"                                   `whenBlankedXmlShouldBe` "< ()>"-    "<foo bar='buzz' />"                      `whenBlankedXmlShouldBe` "<   (a   v      )>"-    "<foo xsd:bar='buzz' />"                  `whenBlankedXmlShouldBe` "<   (a       v      )>"-    "<foo bar=\"buzz\" />"                    `whenBlankedXmlShouldBe` "<   (a   v      )>"-    "<e a='x' b='y'/>"                        `whenBlankedXmlShouldBe` "< (a v   a v  )>"-    "<e a='x' b='y'>text</e>"                 `whenBlankedXmlShouldBe` "< (a v   a v  )t      >"-    "<e a = 'x' b = 'y' />"                   `whenBlankedXmlShouldBe` "< (a   v   a   v   )>"-    "<a x='y'><b/></a>"                       `whenBlankedXmlShouldBe` "< (a v  )<  >   >"-    "<a x='y'><b>test</b></a>"                `whenBlankedXmlShouldBe` "< (a v  )<  t      >   >"-    "<test> text <b>bold</b> </test>"         `whenBlankedXmlShouldBe` "<      t    <  t      >       >"-    "<test> text <b>bold</b> uuu</test>"      `whenBlankedXmlShouldBe` "<      t    <  t      > t        >"-    "<person fstName=\"alexey\" />"           `whenBlankedXmlShouldBe` "<      (a       v        )>"-    "<e> <!-- comment --> </e>"               `whenBlankedXmlShouldBe` "<   [              ]    >"-    "<e> <!-- a --- z --> </e>"               `whenBlankedXmlShouldBe` "<   [              ]    >"--    "<e> <!-- <b>a</b> --> </e>"              `whenBlankedXmlShouldBe` "<   [               ]    >"-    "<?xml version='1.0' encoding='UTF-8' ?>" `whenBlankedXmlShouldBe` "<    (a       v     a        v       )>"--    "<!DOCTYPE greeting [\-      \<!ELEMENT greeting (#PCDATA)>]>"       `whenBlankedXmlShouldBe` "[                   [                           ] ]"--    "<a><![CDATA[<hi>Hello,\-    \ world!</hi>]]></b>"                     `whenBlankedXmlShouldBe` "<  [                                ]   >"--    "<a><![CDATA[ [ ]]]]></b>"                `whenBlankedXmlShouldBe` "<  [               ]   >"-    "<a><c>00</c><s/></a>"                    `whenBlankedXmlShouldBe` "<  <  t    ><  >   >"-    "<a><c>0</c><s/></a>"                     `whenBlankedXmlShouldBe` "<  <  t   ><  >   >"--  it "Can blank across chunk boundaries with basic tags" $ requireTest $ do-    let inputOriginalPrefix = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<statistics>\n  <attack>"-    let inputOriginalSuffix = "\n  </attack>\n  <attack></attack>\n  <attack></attack>\n  <attack></attack>\n  <attack></attack>\n</statistics>\n"-    let inputOriginal = inputOriginalPrefix <> inputOriginalSuffix-    let inputOriginalChunked = chunkedBy 16 inputOriginal-    let inputOriginalBlanked = blankXml inputOriginalChunked--    n <- forAll $ G.int (R.linear 0 16)--    let inputShifted = inputOriginalPrefix <> repeatBS n " " <> inputOriginalSuffix-    let inputShiftedChunked = chunkedBy 16 inputShifted-    let inputShiftedBlanked = blankXml inputShiftedChunked--    noSpaces (BS.concat inputShiftedBlanked) === noSpaces (BS.concat inputOriginalBlanked)-  it "Can blank across chunk boundaries with auto-close tags" $ requireTest $ do-    let inputOriginalPrefix = "<?xml version=\"1.0\" encoding=\"UTF-8\"?><statistics><attack>"-    let inputOriginalSuffix = "<inner/></attack><attack></attack></statistics>\n"-    let inputOriginal = inputOriginalPrefix <> inputOriginalSuffix-    let inputOriginalChunked = chunkedBy 16 inputOriginal-    let inputOriginalBlanked = blankXml inputOriginalChunked--    n <- forAll $ G.int (R.linear 0 16)--    let inputShifted = inputOriginalPrefix <> repeatBS n " " <> inputOriginalSuffix-    let inputShiftedChunked = chunkedBy 16 inputShifted-    let inputShiftedBlanked = blankXml inputShiftedChunked--    -- putStrLn $ show (BS.concat inputShiftedBlanked) <> " vs " <> show (BS.concat inputOriginalBlanked)-    let actual    = Annotated (noSpaces (BS.concat inputShiftedBlanked )) (inputShiftedBlanked, n)-    let expected  = Annotated (noSpaces (BS.concat inputOriginalBlanked)) (inputOriginalBlanked, n)--    actual === expected-  it "Can blank across chunk boundaries with auto-close tags" $ requireTest $ do-    let inputOriginalPrefix = "<?xml version=\"1.0\" encoding=\"UTF-8\"?><statistics><attack>"-    let inputOriginalSuffix = "<inner/></attack><attack></attack></statistics>\n"-    let inputOriginal = inputOriginalPrefix <> inputOriginalSuffix-    let inputOriginalChunked = chunkedBy 16 inputOriginal-    let inputOriginalBlanked = blankXml inputOriginalChunked--    let n = 15-    let inputShifted = inputOriginalPrefix <> repeatBS n " " <> inputOriginalSuffix-    let inputShiftedChunked = chunkedBy 16 inputShifted-    let inputShiftedBlanked = blankXml inputShiftedChunked--    -- putStrLn $ show (BS.concat inputShiftedBlanked) <> " vs " <> show (BS.concat inputOriginalBlanked)-    let actual    = Annotated (noSpaces (BS.concat inputShiftedBlanked )) (inputShiftedBlanked, n)-    let expected  = Annotated (noSpaces (BS.concat inputOriginalBlanked)) (inputOriginalBlanked, n)--    actual === expected

@@ -0,0 +1,121 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Xml.Internal.BlankSpec (spec) where++import Data.Char+import Data.Semigroup                       ((<>))+import HaskellWorks.Data.ByteString+import HaskellWorks.Data.Xml.Internal.Blank+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString as BS+import qualified Hedgehog.Gen    as G+import qualified Hedgehog.Range  as R++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}++whenBlankedXmlShouldBe :: BS.ByteString -> BS.ByteString -> Spec+whenBlankedXmlShouldBe original expected = do+  it (show original <> " when blanked xml should be " <> show expected) $ requireTest $ do+    BS.concat (blankXml [original]) === expected++repeatBS :: Int -> BS.ByteString -> BS.ByteString+repeatBS n bs | n > 0   = bs <> repeatBS (n - 1) bs+repeatBS  _ _ = BS.empty++noSpaces :: BS.ByteString -> BS.ByteString+noSpaces = BS.filter (/= fromIntegral (ord ' '))++data Annotated a b = Annotated a b deriving Show++instance Eq a => Eq (Annotated a b) where+  (Annotated a _) == (Annotated b _) = a == b++spec :: Spec+spec = describe "HaskellWorks.Data.Xml.Internal.BlankSpec" $ do+  describe "Can blank XML" $ do+    "<b/>"                                    `whenBlankedXmlShouldBe` "<  >"+    "<b></b>"                                 `whenBlankedXmlShouldBe` "<     >"+    "<b>text</b>"                             `whenBlankedXmlShouldBe` "<  t      >"+    "<b>  text  </b>"                         `whenBlankedXmlShouldBe` "<    t        >"+    "<b />"                                   `whenBlankedXmlShouldBe` "< ()>"+    "<foo bar='buzz' />"                      `whenBlankedXmlShouldBe` "<   (a   v      )>"+    "<foo xsd:bar='buzz' />"                  `whenBlankedXmlShouldBe` "<   (a       v      )>"+    "<foo bar=\"buzz\" />"                    `whenBlankedXmlShouldBe` "<   (a   v      )>"+    "<e a='x' b='y'/>"                        `whenBlankedXmlShouldBe` "< (a v   a v  )>"+    "<e a='x' b='y'>text</e>"                 `whenBlankedXmlShouldBe` "< (a v   a v  )t      >"+    "<e a = 'x' b = 'y' />"                   `whenBlankedXmlShouldBe` "< (a   v   a   v   )>"+    "<a x='y'><b/></a>"                       `whenBlankedXmlShouldBe` "< (a v  )<  >   >"+    "<a x='y'><b>test</b></a>"                `whenBlankedXmlShouldBe` "< (a v  )<  t      >   >"+    "<test> text <b>bold</b> </test>"         `whenBlankedXmlShouldBe` "<      t    <  t      >       >"+    "<test> text <b>bold</b> uuu</test>"      `whenBlankedXmlShouldBe` "<      t    <  t      > t        >"+    "<person fstName=\"alexey\" />"           `whenBlankedXmlShouldBe` "<      (a       v        )>"+    "<e> <!-- comment --> </e>"               `whenBlankedXmlShouldBe` "<   [              ]    >"+    "<e> <!-- a --- z --> </e>"               `whenBlankedXmlShouldBe` "<   [              ]    >"++    "<e> <!-- <b>a</b> --> </e>"              `whenBlankedXmlShouldBe` "<   [               ]    >"+    "<?xml version='1.0' encoding='UTF-8' ?>" `whenBlankedXmlShouldBe` "<    (a       v     a        v       )>"++    "<!DOCTYPE greeting [\+      \<!ELEMENT greeting (#PCDATA)>]>"       `whenBlankedXmlShouldBe` "[                   [                           ] ]"++    "<a><![CDATA[<hi>Hello,\+    \ world!</hi>]]></b>"                     `whenBlankedXmlShouldBe` "<  [                                ]   >"++    "<a><![CDATA[ [ ]]]]></b>"                `whenBlankedXmlShouldBe` "<  [               ]   >"+    "<a><c>00</c><s/></a>"                    `whenBlankedXmlShouldBe` "<  <  t    ><  >   >"+    "<a><c>0</c><s/></a>"                     `whenBlankedXmlShouldBe` "<  <  t   ><  >   >"++  it "Can blank across chunk boundaries with basic tags" $ requireTest $ do+    let inputOriginalPrefix = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<statistics>\n  <attack>"+    let inputOriginalSuffix = "\n  </attack>\n  <attack></attack>\n  <attack></attack>\n  <attack></attack>\n  <attack></attack>\n</statistics>\n"+    let inputOriginal = inputOriginalPrefix <> inputOriginalSuffix+    let inputOriginalChunked = chunkedBy 16 inputOriginal+    let inputOriginalBlanked = blankXml inputOriginalChunked++    n <- forAll $ G.int (R.linear 0 16)++    let inputShifted = inputOriginalPrefix <> repeatBS n " " <> inputOriginalSuffix+    let inputShiftedChunked = chunkedBy 16 inputShifted+    let inputShiftedBlanked = blankXml inputShiftedChunked++    noSpaces (BS.concat inputShiftedBlanked) === noSpaces (BS.concat inputOriginalBlanked)+  it "Can blank across chunk boundaries with auto-close tags" $ requireTest $ do+    let inputOriginalPrefix = "<?xml version=\"1.0\" encoding=\"UTF-8\"?><statistics><attack>"+    let inputOriginalSuffix = "<inner/></attack><attack></attack></statistics>\n"+    let inputOriginal = inputOriginalPrefix <> inputOriginalSuffix+    let inputOriginalChunked = chunkedBy 16 inputOriginal+    let inputOriginalBlanked = blankXml inputOriginalChunked++    n <- forAll $ G.int (R.linear 0 16)++    let inputShifted = inputOriginalPrefix <> repeatBS n " " <> inputOriginalSuffix+    let inputShiftedChunked = chunkedBy 16 inputShifted+    let inputShiftedBlanked = blankXml inputShiftedChunked++    -- putStrLn $ show (BS.concat inputShiftedBlanked) <> " vs " <> show (BS.concat inputOriginalBlanked)+    let actual    = Annotated (noSpaces (BS.concat inputShiftedBlanked )) (inputShiftedBlanked, n)+    let expected  = Annotated (noSpaces (BS.concat inputOriginalBlanked)) (inputOriginalBlanked, n)++    actual === expected+  it "Can blank across chunk boundaries with auto-close tags" $ requireTest $ do+    let inputOriginalPrefix = "<?xml version=\"1.0\" encoding=\"UTF-8\"?><statistics><attack>"+    let inputOriginalSuffix = "<inner/></attack><attack></attack></statistics>\n"+    let inputOriginal = inputOriginalPrefix <> inputOriginalSuffix+    let inputOriginalChunked = chunkedBy 16 inputOriginal+    let inputOriginalBlanked = blankXml inputOriginalChunked++    let n = 15+    let inputShifted = inputOriginalPrefix <> repeatBS n " " <> inputOriginalSuffix+    let inputShiftedChunked = chunkedBy 16 inputShifted+    let inputShiftedBlanked = blankXml inputShiftedChunked++    -- putStrLn $ show (BS.concat inputShiftedBlanked) <> " vs " <> show (BS.concat inputOriginalBlanked)+    let actual    = Annotated (noSpaces (BS.concat inputShiftedBlanked )) (inputShiftedBlanked, n)+    let expected  = Annotated (noSpaces (BS.concat inputOriginalBlanked)) (inputOriginalBlanked, n)++    actual === expected

@@ -1,14 +1,17 @@ {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE OverloadedStrings #-} -module HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParensSpec(spec) where+module HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParensSpec+  ( spec+  ) where  import Data.Monoid                                      ((<>)) import Data.String import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.ByteString-import HaskellWorks.Data.Xml.Conduit-import HaskellWorks.Data.Xml.Conduit.Blank+import HaskellWorks.Data.Xml.Internal.BalancedParens+import HaskellWorks.Data.Xml.Internal.Blank+import HaskellWorks.Data.Xml.Internal.List import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml import HaskellWorks.Hspec.Hedgehog import Hedgehog@@ -22,14 +25,14 @@ spec = describe "HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParensSpec" $ do   it "Blanking XML should work 1" $ requireTest $ do     let blankedXml = BlankedXml ["<t<t>>"]-    let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 (getBlankedXml blankedXml)))+    let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml blankedXml)))     bp === fromString "11011000"   it "Blanking XML should work 2" $ requireTest $ do     let blankedXml = BlankedXml           [ "<><><><><><><><>"           , "<><><><><><><><>"           ]-    let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 (getBlankedXml blankedXml)))+    let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml blankedXml)))     bp === fromString           "1010101010101010\           \1010101010101010"@@ -46,12 +49,12 @@     unchunkedInput === BS.concat chunkedInput    it "Blanking XML should work 3" $ requireTest $ do-    let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 chunkedBlank))+    let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens chunkedBlank))     annotate $ "Good: " <> show chunkedBlank     bp === fromString "11101010 10001101 01010100"    it "Blanking XML should work 3" $ requireTest $do-    let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 chunkedBadBlank))+    let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens chunkedBadBlank))     annotate $ "Bad: " <> show chunkedBadBlank     bp === fromString "11101010 10001101 01010100" @@ -71,4 +74,4 @@ mkBlank csize bs = blankXml (chunkedBy csize bs)  mkBits :: [BS.ByteString] -> [BS.ByteString]-mkBits = compressWordAsBit . blankedXmlToBalancedParens2+mkBits = compressWordAsBit . blankedXmlToBalancedParens

@@ -2,13 +2,14 @@  module HaskellWorks.Data.Xml.Token.TokenizeSpec (spec) where -import Data.ByteString                      as BS+import Data.ByteString                      (ByteString) import HaskellWorks.Data.Xml.Token.Tokenize import HaskellWorks.Hspec.Hedgehog import Hedgehog import Test.Hspec  import qualified Data.Attoparsec.ByteString.Char8 as BC+import qualified Data.ByteString                  as BS  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} @@ -16,7 +17,7 @@ parseXmlToken' = BC.parseOnly parseXmlToken  spec :: Spec-spec = describe "Data.Conduit.Succinct.XmlSpec" $ do+spec = describe "HaskellWorks.Data.Xml.Token.TokenizeSpec" $ do   describe "When parsing single token at beginning of text" $ do     it "Empty Xml should produce no bits" $ requireTest $       parseXmlToken' "" === Left "not enough input"