bytestring-substring (empty) → 0.1
raw patch · 6 files changed
+389/−0 lines, 6 filesdep +basedep +bytestringdep +pipes
Dependencies added: base, bytestring, pipes, primitive
Files
- CHANGELOG.md +12/−0
- LICENSE +29/−0
- README.md +6/−0
- bytestring-substring.cabal +57/−0
- src/Data/ByteString/Substring.hs +174/−0
- src/Pipes/ByteString/Substring.hs +111/−0
+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Changelog++`bytestring-substring` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++0.0.0+=====++* Initially created.++[1]: https://pvp.haskell.org+[2]: https://github.com/chessai/bytestring-substring/releases
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2019, Andrew Martin+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,6 @@+# bytestring-substring++[](https://hackage.haskell.org/package/bytestring-substring)+[](LICENSE)++See README for more info
+ bytestring-substring.cabal view
@@ -0,0 +1,57 @@+cabal-version: 2.2+name:+ bytestring-substring+version:+ 0.1+synopsis:+ break bytestrings up into substrings+description:+ break bytestrings up into substrings,+ uses karprabin. support for pipes included+homepage:+ https://github.com/chessai/bytestring-substring+bug-reports:+ https://github.com/chessai/bytestring-substring/issues+license:+ BSD-3-Clause+license-file:+ LICENSE+author:+ Andrew Martin+maintainer:+ Andrew Martin <andrew.thaddeus@gmail.com>+ chessai <chessai1996@gmail.com>+copyright:+ © 2019 Andrew Martin+category:+ Data, Parsing+build-type:+ Simple+extra-doc-files:+ README.md+ , CHANGELOG.md+tested-with:+ GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3++library+ hs-source-dirs:+ src+ exposed-modules:+ Data.ByteString.Substring+ Pipes.ByteString.Substring+ build-depends:+ , base >= 4.10.1 && < 4.13+ , bytestring >= 0.10 && < 0.11+ , pipes >= 4.3 && < 4.4+ , primitive >= 0.6.4 && < 0.7+ ghc-options:+ -Wall+ -O2+ default-language:+ Haskell2010++source-repository head+ type:+ git+ location:+ https://github.com/chessai/bytestring-substring.git
+ src/Data/ByteString/Substring.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE BangPatterns #-}++module Data.ByteString.Substring+ ( breakSubstringLazy+ , prepareBreakSubstring+ , breakSubstringResume+ , KarpRabinState+ , KarpRabinResult(..)+ ) where++import Control.Monad.ST (RealWorld)+import Data.Bits+import Data.ByteString+import Data.ByteString.Unsafe+import Data.Int+import Data.Primitive.ByteArray+import Data.Word+import Prelude hiding (length,null)+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Lazy.Internal as LBI++breakSubstringLazy ::+ ByteString -- ^ needle, strict bytestring+ -> LB.ByteString -- ^ haystack, lazy bytestring+ -> (LB.ByteString,LB.ByteString)+breakSubstringLazy pat lb =+ let !lp = intToInt64 (length pat)+ !b0 = LB.toStrict (LB.take lp lb)+ !lb' = LB.drop lp lb+ !s = prepareBreakSubstring pat b0+ in case go s lb' of+ BreakBackwardDone pre post -> (if null b0 then pre else LBI.Chunk b0 pre,post)+ BreakBackwardBy !n -> let (bpre,bpost) = unsafeSplitAt (length b0 - n) b0 in+ (LB.fromStrict bpre,if null bpost then lb' else LBI.Chunk bpost lb')+ where+ go :: KarpRabinState -> LB.ByteString -> BreakBackward+ go _ LBI.Empty = BreakBackwardDone LBI.Empty LBI.Empty+ go s1 (LBI.Chunk !c cs) = case breakSubstringResume s1 c of+ KarpRabinResultMore s2 -> case go s2 cs of+ BreakBackwardBy n -> if n <= length c+ then let (ca,cb) = unsafeSplitAt (length c - n) c in+ BreakBackwardDone+ (if null ca then LBI.Empty else LBI.Chunk ca LBI.Empty)+ (if null cb then LBI.Empty else LBI.Chunk cb cs)+ else BreakBackwardBy (n - length c)+ BreakBackwardDone cs' cs'' -> BreakBackwardDone (LBI.Chunk c cs') cs''+ KarpRabinResultDone ix _ -> if ix < 0+ then BreakBackwardBy (negate ix)+ else let (ca,cb) = unsafeSplitAt ix c in+ BreakBackwardDone+ (if null ca then LBI.Empty else LBI.Chunk ca LBI.Empty)+ (LBI.Chunk cb cs)++prepareBreakSubstring ::+ ByteString -- ^ needle+ -> ByteString -- ^ first n characters in haystack, where n is length of needle+ -> KarpRabinState+prepareBreakSubstring pat b0 =+ let !lp = intToInt64 (length pat)+ !log2BufSize = finiteBitSize (0 :: Int) - countLeadingZeros (length pat)+ !bufSize = 2 ^ log2BufSize+ !buf = unsafePerformIO (newBuffer bufSize b0)+ !m = 2891336453 ^ length pat+ !hp = rollingHash pat+ !hs0 = rollingHash b0+ in (KarpRabinState hp m pat hs0 log2BufSize (bufSize - 1) buf lp)++rollingHash :: ByteString -> Word32+rollingHash = foldl' (\h b -> h * 2891336453 + word8ToWord32 b) 0++data BreakBackward+ = BreakBackwardDone LB.ByteString LB.ByteString+ | BreakBackwardBy !Int+ -- ^ The int in here should always be positive++intToInt64 :: Int -> Int64+intToInt64 = fromIntegral++int64ToInt :: Int64 -> Int+int64ToInt = fromIntegral++word8ToWord32 :: Word8 -> Word32+word8ToWord32 = fromIntegral++breakSubstringResume :: KarpRabinState -> ByteString -> KarpRabinResult+breakSubstringResume (KarpRabinState hp m pat hs0 log2BufSize bufMask buf i64Start) chunk =+ unsafePerformIO (search hs0 i64Start)+ where+ k = 2891336453 :: Word32+ readByteArrayMod :: Int -> IO Word8+ readByteArrayMod ix = readByteArray buf (ix .&. bufMask)+ writeByteArrayMod :: Int -> Word8 -> IO ()+ writeByteArrayMod ix = writeByteArray buf (ix .&. bufMask)+ search :: Word32 -> Int64 -> IO KarpRabinResult+ search !hs !i64 = do+ let !i = int64ToInt (i64 - i64Start)+ keepGoing :: IO KarpRabinResult+ keepGoing = do+ oldVal <- readByteArrayMod (int64ToInt (i64 - intToInt64 (length pat)))+ let w8 :: Word8+ !w8 = unsafeIndex chunk i+ !hs' = hs * k + fromIntegral w8 - m * fromIntegral oldVal+ writeByteArrayMod (int64ToInt i64) w8+ search hs' (i64 + 1)+ if hp == hs+ then do+ b <- mutableByteArrayEqByteString+ (bufMask .&. (int64ToInt i64 - length pat))+ bufMask buf pat+ if b+ then return (KarpRabinResultDone (i - length pat) (i64 - fromIntegral (length pat)))+ else keepGoing+ else if length chunk <= i+ then return (KarpRabinResultMore (KarpRabinState hp m pat hs log2BufSize bufMask buf i64))+ else keepGoing++unsafeSplitAt :: Int -> ByteString -> (ByteString,ByteString)+unsafeSplitAt i s = (unsafeTake i s, unsafeDrop i s)++-- | You must provide a size equal to or larger than the+-- ByteString length+newBuffer :: Int -> ByteString -> IO (MutableByteArray RealWorld)+newBuffer sz bs = do+ arr <- newByteArray sz+ copyIntoBuffer bs arr+ return arr++copyIntoBuffer :: ByteString -> MutableByteArray RealWorld -> IO ()+copyIntoBuffer bs arr = go 0+ where+ go :: Int -> IO ()+ go ix = if ix < length bs+ then do+ let !w = unsafeIndex bs ix+ writeByteArray arr ix w+ go (ix + 1)+ else return ()++mutableByteArrayEqByteString :: Int -> Int -> MutableByteArray RealWorld -> ByteString -> IO Bool+mutableByteArrayEqByteString arrIx bufMask arr bs = go 0+ where+ readByteArrayMod :: Int -> IO Word8+ readByteArrayMod ix = readByteArray arr (ix .&. bufMask)+ go :: Int -> IO Bool+ go i = if i < length bs+ then do+ w1 <- readByteArrayMod (arrIx + i)+ let w2 = unsafeIndex bs i+ if w1 == w2 then go (i + 1) else return False+ else return True++data KarpRabinState = KarpRabinState+ !Word32 -- pattern fingerprint+ !Word32 -- constant k exponentiated+ !ByteString -- pattern+ !Word32 -- current fingerprint+ !Int -- log base 2 of buffer size+ !Int -- mask+ !(MutableByteArray RealWorld) -- current buffer, contains end of previous bytestring+ !Int64 -- total number of bytes consumed, also works as buffer index+ -- after doing some modular arithmetic++data KarpRabinResult+ = KarpRabinResultDone !Int !Int64+ -- ^ The first number is the index into the current chunk.+ -- The second number is the total number of characters+ -- that were consumed. Note that since these both refer+ -- to the index of the beginning of the match, the first+ -- one is allowed to be negative, but the second is not.+ -- The third item is the bytes preceeding the match location.+ -- This is provided to help streaming providers that may have+ -- already discarded the old data.+ | KarpRabinResultMore !KarpRabinState
+ src/Pipes/ByteString/Substring.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Pipes.ByteString.Substring+ ( consumeBreakSubstring+ , consumeBreakSubstringLeftovers+ , consumeDropExactLeftovers+ , consumeDropWhileLeftovers+ ) where++import Data.ByteString (ByteString)+import Data.ByteString.Builder (Builder)+import Data.ByteString.Substring+import Data.Int+import Data.Maybe+import Pipes+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as LB+import qualified Data.List as L++consumeBreakSubstring :: Monad m => ByteString -> Consumer' ByteString m (Builder,ByteString)+consumeBreakSubstring = consumeBreakSubstringLeftovers B.empty++consumeBreakSubstringLeftovers :: Monad m => ByteString -> ByteString -> Consumer' ByteString m (Builder,ByteString)+consumeBreakSubstringLeftovers leftovers0 pat = do+ (b0, leftovers) <- takeStrictLeftovers leftovers0 (B.length pat)+ let !s = prepareBreakSubstring pat b0+ go s mempty (LB.fromStrict b0) leftovers+ where+ go :: Monad m+ => KarpRabinState+ -> Builder+ -> LB.ByteString -- Buffer for chunks we cannot yet append to the builder+ -> ByteString+ -> Consumer' ByteString m (Builder,ByteString)+ go s1 bb heldChunk chunk = case breakSubstringResume s1 chunk of+ KarpRabinResultDone ix _ -> return $ if ix < 0+ then let (a,b) = LB.splitAt (LB.length heldChunk + intToInt64 ix) heldChunk in+ (bb <> BB.lazyByteString a, LB.toStrict b <> chunk)+ else let (a,b) = B.splitAt ix chunk in+ (bb <> BB.lazyByteString heldChunk <> BB.byteString a, b)+ KarpRabinResultMore s2 -> do+ let appendedHeldChunk = heldChunk <> LB.fromStrict chunk+ (confirmedChunk,nextHeldChunk) = LB.splitAt (LB.length appendedHeldChunk - intToInt64 (B.length pat)) appendedHeldChunk+ nextChunk <- await+ go s2 (bb <> BB.lazyByteString confirmedChunk) nextHeldChunk nextChunk++-- | If we get back a Left, then the chunks did not match what we expected.+-- The tuple contains the number of characters that did match and the+-- beginning of the failure to match.+-- If we get back a Right, it has the leftovers from the chunk that+-- completed the match.+consumeDropExactLeftovers :: Monad m => ByteString -> ByteString -> Consumer' ByteString m (Either (Int,ByteString) ByteString)+consumeDropExactLeftovers leftovers0 preface = go 0 leftovers0+ where+ go :: Monad m => Int -> ByteString -> Consumer' ByteString m (Either (Int,ByteString) ByteString)+ go ix chunk = if lenRemainingPreface > lenChunk+ then do+ let (p1,_) = B.splitAt lenChunk remainingPreface+ if p1 == chunk+ then await >>= go (ix + lenChunk)+ else do+ let ixDifferentByte = findDifferentByte p1 chunk+ return (Left (ixDifferentByte + ix,B.drop ixDifferentByte chunk))+ else do+ let (c1,c2) = B.splitAt lenRemainingPreface chunk+ if c1 == remainingPreface+ then return (Right c2)+ else do+ let ixDifferentByte = findDifferentByte c1 remainingPreface+ return (Left (ixDifferentByte + ix,B.drop ixDifferentByte chunk))+ where+ remainingPreface = B.drop ix preface+ lenRemainingPreface = B.length remainingPreface+ lenChunk = B.length chunk++consumeDropWhileLeftovers :: Monad m => ByteString -> (Char -> Bool) -> Consumer' ByteString m ByteString+consumeDropWhileLeftovers leftovers0 predicate = go leftovers0+ where+ go :: Monad m => ByteString -> Consumer' ByteString m ByteString+ go chunk = do+ let remaining = BC.dropWhile predicate chunk+ if B.null remaining+ then await >>= go+ else return remaining++-- | This is extremely inefficient. Returns -10000 if all bytes match.+findDifferentByte :: ByteString -> ByteString -> Int+findDifferentByte a b = fromMaybe (-10000) (L.elemIndex False (B.zipWith (==) a b))++-- | In the returned tuple, the first element is the bytestring prior to+-- the index. The second item is the leftover bytes in the chunk.+takeStrictLeftovers :: Monad m => ByteString -> Int -> Consumer' ByteString m (ByteString,ByteString)+takeStrictLeftovers leftovers0 total = if total < 1+ then return (B.empty,leftovers0)+ else go 0 mempty leftovers0+ where+ go :: Monad m => Int -> Builder -> ByteString -> Consumer' ByteString m (ByteString,ByteString)+ go i1 bb bs = do+ let i2 = i1 + B.length bs+ if i2 < total+ then await >>= go i2 (bb <> BB.byteString bs)+ else do+ let (a,b) = B.splitAt (B.length bs - (i2 - total)) bs+ return (LB.toStrict $ BB.toLazyByteString $ bb <> BB.byteString a, b)++intToInt64 :: Int -> Int64+intToInt64 = fromIntegral